url-history.el 6.81 KB
Newer Older
Stefan Monnier's avatar
Stefan Monnier committed
1
;;; url-history.el --- Global history tracking for URL package
2

3
;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2005, 2006, 2007 Free Software Foundation, Inc.
5

Stefan Monnier's avatar
Stefan Monnier committed
6 7
;; Keywords: comm, data, processes, hypermedia

8 9 10 11
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
12
;; the Free Software Foundation; either version 3, or (at your option)
13 14 15 16 17 18 19 20 21
;; any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
22 23
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
24 25 26 27

;;; Commentary:

;;; Code:
Stefan Monnier's avatar
Stefan Monnier committed
28 29 30 31 32 33 34

;; This can get a recursive require.
;;(require 'url)
(require 'url-parse)
(autoload 'url-do-setup "url")

(defgroup url-history nil
35
  "History variables in the URL package."
Stefan Monnier's avatar
Stefan Monnier committed
36 37 38 39
  :prefix "url-history"
  :group 'url)

(defcustom url-history-track nil
40 41
  "*Controls whether to keep a list of all the URLs being visited.
If non-nil, the URL package will keep track of all the URLs visited.
42
If set to t, then the list is saved to disk at the end of each Emacs
Stefan Monnier's avatar
Stefan Monnier committed
43
session."
44 45
  :set #'(lambda (var val)
	   (set-default var val)
46
	   (and (bound-and-true-p url-setup-done)
47 48 49 50
		(url-history-setup-save-timer)))
  :type '(choice (const :tag "off" nil)
		 (const :tag "on" t)
		 (const :tag "within session" 'session))
Stefan Monnier's avatar
Stefan Monnier committed
51 52 53 54 55 56 57 58 59 60 61 62 63 64
  :group 'url-history)

(defcustom url-history-file nil
  "*The global history file for the URL package.
This file contains a list of all the URLs you have visited.  This file
is parsed at startup and used to provide URL completion."
  :type '(choice (const :tag "Default" :value nil) file)
  :group 'url-history)

(defcustom url-history-save-interval 3600
  "*The number of seconds between automatic saves of the history list.
Default is 1 hour.  Note that if you change this variable outside of
the `customize' interface after `url-do-setup' has been run, you need
to run the `url-history-setup-save-timer' function manually."
65 66 67 68
  :set #'(lambda (var val)
	   (set-default var val)
	   (if (bound-and-true-p url-setup-done)
	       (url-history-setup-save-timer)))
Stefan Monnier's avatar
Stefan Monnier committed
69 70 71 72 73 74 75 76
  :type 'integer
  :group 'url-history)

(defvar url-history-timer nil)

(defvar url-history-changed-since-last-save nil
  "Whether the history list has changed since the last save operation.")

77
(defvar url-history-hash-table (make-hash-table :size 31 :test 'equal)
Stefan Monnier's avatar
Stefan Monnier committed
78 79 80
  "Hash table for global history completion.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
81

Stefan Monnier's avatar
Stefan Monnier committed
82 83 84
(defun url-history-setup-save-timer ()
  "Reset the history list timer."
  (interactive)
85 86 87
  (condition-case nil
      (cancel-timer url-history-timer)
    (error nil))
88
  (setq url-history-timer nil)
89
  (if (and (eq url-history-track t) url-history-save-interval)
90 91 92
      (setq url-history-timer (run-at-time url-history-save-interval
					   url-history-save-interval
					   'url-history-save-history))))
Stefan Monnier's avatar
Stefan Monnier committed
93 94 95 96 97 98 99

(defun url-history-parse-history (&optional fname)
  "Parse a history file stored in FNAME."
  ;; Parse out the mosaic global history file for completions, etc.
  (or fname (setq fname (expand-file-name url-history-file)))
  (cond
   ((not (file-exists-p fname))
100 101 102
    ;; It's completely normal for this file not to exist, so don't complain.
    ;; (message "%s does not exist." fname)
    )
Stefan Monnier's avatar
Stefan Monnier committed
103 104 105 106 107
   ((not (file-readable-p fname))
    (message "%s is unreadable." fname))
   (t
    (condition-case nil
	(load fname nil t)
108
      (error (message "Could not load %s" fname))))))
Stefan Monnier's avatar
Stefan Monnier committed
109 110 111

(defun url-history-update-url (url time)
  (setq url-history-changed-since-last-save t)
112 113
  (puthash (if (vectorp url) (url-recreate-url url) url) time
           url-history-hash-table))
Stefan Monnier's avatar
Stefan Monnier committed
114

115 116
(autoload 'url-make-private-file "url-util")

Stefan Monnier's avatar
Stefan Monnier committed
117 118 119 120 121 122
(defun url-history-save-history (&optional fname)
  "Write the global history file into `url-history-file'.
The type of data written is determined by what is in the file to begin
with.  If the type of storage cannot be determined, then prompt the
user for what type to save as."
  (interactive)
123 124 125 126 127 128 129 130 131 132 133 134 135 136
  (when url-history-changed-since-last-save
    (or fname (setq fname (expand-file-name url-history-file)))
    (if (condition-case nil
            (progn
              (url-make-private-file fname)
              nil)
          (error t))
        (message "Error accessing history file `%s'" fname)
      (let ((make-backup-files nil)
            (version-control nil)
            (require-final-newline t)
            (count 0))
        (with-temp-buffer
          (maphash (lambda (key value)
137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
                     (while (string-match "[\r\n]+" key)
                       (setq key (concat (substring key 0 (match-beginning 0))
                                         (substring key (match-end 0) nil))))
                     (setq count (1+ count))
                     (insert "(puthash \"" key "\""
                             (if (not (stringp value)) " '" "")
                             (prin1-to-string value)
                             " url-history-hash-table)\n"))
                   url-history-hash-table)
          ;; We used to add this in the file, but it just makes the code
          ;; more complex with no benefit.  Worse: it makes it harder to
          ;; preserve preexisting history when loading the history file.
	  ;; (goto-char (point-min))
	  ;; (insert (format
	  ;;          "(setq url-history-hash-table (make-hash-table :size %d :test 'equal))\n"
	  ;;          (/ count 4)))
	  ;; (goto-char (point-max))
Stefan Monnier's avatar
Stefan Monnier committed
154
	  (insert "\n")
155 156
	  (write-file fname)))
      (setq url-history-changed-since-last-save nil))))
Stefan Monnier's avatar
Stefan Monnier committed
157 158 159

(defun url-have-visited-url (url)
  (url-do-setup)
160
  (gethash url url-history-hash-table nil))
Stefan Monnier's avatar
Stefan Monnier committed
161 162

(defun url-completion-function (string predicate function)
163 164 165
  ;; Completion function to complete urls from the history.
  ;; This is obsolete since we can now pass the hash-table directly as a
  ;; completion table.
Stefan Monnier's avatar
Stefan Monnier committed
166 167 168 169
  (url-do-setup)
  (cond
   ((eq function nil)
    (let ((list nil))
170 171 172
      (maphash (lambda (key val) (push key list))
               url-history-hash-table)
      ;; Not sure why we bother reversing the list.  --Stef
Stefan Monnier's avatar
Stefan Monnier committed
173 174
      (try-completion string (nreverse list) predicate)))
   ((eq function t)
175
    (let ((stub (concat "\\`" (regexp-quote string)))
Stefan Monnier's avatar
Stefan Monnier committed
176 177
	  (retval nil))
      (maphash
178 179
       (lambda (url time)
         (if (string-match stub url) (push url retval)))
Stefan Monnier's avatar
Stefan Monnier committed
180 181 182
       url-history-hash-table)
      retval))
   ((eq function 'lambda)
183
    (and (gethash string url-history-hash-table) t))
Stefan Monnier's avatar
Stefan Monnier committed
184
   (t
185
    (error "url-completion-function very confused"))))
Stefan Monnier's avatar
Stefan Monnier committed
186 187

(provide 'url-history)
Miles Bader's avatar
Miles Bader committed
188

189 190
;; arch-tag: fbbbaf63-db36-4e88-bc9f-2939aa93afb2
;;; url-history.el ends here