Mercurial > emacs
annotate lisp/url/url-history.el @ 87209:bc4976b7380e
Merge from gnus--devo--0
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-950
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sun, 09 Dec 2007 22:14:32 +0000 |
parents | 5befb2f1ec98 |
children | 949eabfded89 |
rev | line source |
---|---|
54695 | 1 ;;; url-history.el --- Global history tracking for URL package |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
2 |
64748
875dcc490074
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64084
diff
changeset
|
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2004, |
75347 | 4 ;; 2005, 2006, 2007 Free Software Foundation, Inc. |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
5 |
54695 | 6 ;; Keywords: comm, data, processes, hypermedia |
7 | |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
8 ;; This file is part of GNU Emacs. |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
9 ;; |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
11 ;; it under the terms of the GNU General Public License as published by |
78222
8932997d0b62
Switch license to GPLv3 or later.
Glenn Morris <rgm@gnu.org>
parents:
75347
diff
changeset
|
12 ;; the Free Software Foundation; either version 3, or (at your option) |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
13 ;; any later version. |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
14 ;; |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
15 ;; GNU Emacs is distributed in the hope that it will be useful, |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
18 ;; GNU General Public License for more details. |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
19 ;; |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
20 ;; You should have received a copy of the GNU General Public License |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
64084 | 22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
23 ;; Boston, MA 02110-1301, USA. | |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
24 |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
25 ;;; Commentary: |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
26 |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
27 ;;; Code: |
54695 | 28 |
29 ;; This can get a recursive require. | |
30 ;;(require 'url) | |
31 (require 'url-parse) | |
32 (autoload 'url-do-setup "url") | |
33 | |
34 (defgroup url-history nil | |
63991
03160396e8bc
(url-history): Finish `defgroup' description with period.
Juanma Barranquero <lekktu@gmail.com>
parents:
63416
diff
changeset
|
35 "History variables in the URL package." |
54695 | 36 :prefix "url-history" |
37 :group 'url) | |
38 | |
39 (defcustom url-history-track nil | |
67237
40f77d1e999e
(url-history-track): Call url-history-setup-save-timer in :set function.
Richard M. Stallman <rms@gnu.org>
parents:
64748
diff
changeset
|
40 "*Controls whether to keep a list of all the URLs being visited. |
40f77d1e999e
(url-history-track): Call url-history-setup-save-timer in :set function.
Richard M. Stallman <rms@gnu.org>
parents:
64748
diff
changeset
|
41 If non-nil, the URL package will keep track of all the URLs visited. |
63991
03160396e8bc
(url-history): Finish `defgroup' description with period.
Juanma Barranquero <lekktu@gmail.com>
parents:
63416
diff
changeset
|
42 If set to t, then the list is saved to disk at the end of each Emacs |
54695 | 43 session." |
67237
40f77d1e999e
(url-history-track): Call url-history-setup-save-timer in :set function.
Richard M. Stallman <rms@gnu.org>
parents:
64748
diff
changeset
|
44 :set #'(lambda (var val) |
40f77d1e999e
(url-history-track): Call url-history-setup-save-timer in :set function.
Richard M. Stallman <rms@gnu.org>
parents:
64748
diff
changeset
|
45 (set-default var val) |
67240
fb7449e080a0
(url-history-track): Fix last change.
Kim F. Storm <storm@cua.dk>
parents:
67237
diff
changeset
|
46 (and (bound-and-true-p url-setup-done) |
67237
40f77d1e999e
(url-history-track): Call url-history-setup-save-timer in :set function.
Richard M. Stallman <rms@gnu.org>
parents:
64748
diff
changeset
|
47 (url-history-setup-save-timer))) |
40f77d1e999e
(url-history-track): Call url-history-setup-save-timer in :set function.
Richard M. Stallman <rms@gnu.org>
parents:
64748
diff
changeset
|
48 :type '(choice (const :tag "off" nil) |
40f77d1e999e
(url-history-track): Call url-history-setup-save-timer in :set function.
Richard M. Stallman <rms@gnu.org>
parents:
64748
diff
changeset
|
49 (const :tag "on" t) |
40f77d1e999e
(url-history-track): Call url-history-setup-save-timer in :set function.
Richard M. Stallman <rms@gnu.org>
parents:
64748
diff
changeset
|
50 (const :tag "within session" 'session)) |
54695 | 51 :group 'url-history) |
52 | |
53 (defcustom url-history-file nil | |
54 "*The global history file for the URL package. | |
55 This file contains a list of all the URLs you have visited. This file | |
56 is parsed at startup and used to provide URL completion." | |
57 :type '(choice (const :tag "Default" :value nil) file) | |
58 :group 'url-history) | |
59 | |
60 (defcustom url-history-save-interval 3600 | |
61 "*The number of seconds between automatic saves of the history list. | |
62 Default is 1 hour. Note that if you change this variable outside of | |
63 the `customize' interface after `url-do-setup' has been run, you need | |
64 to run the `url-history-setup-save-timer' function manually." | |
67310
e6faadb77218
(url-history-list): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents:
67240
diff
changeset
|
65 :set #'(lambda (var val) |
e6faadb77218
(url-history-list): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents:
67240
diff
changeset
|
66 (set-default var val) |
e6faadb77218
(url-history-list): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents:
67240
diff
changeset
|
67 (if (bound-and-true-p url-setup-done) |
e6faadb77218
(url-history-list): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents:
67240
diff
changeset
|
68 (url-history-setup-save-timer))) |
54695 | 69 :type 'integer |
70 :group 'url-history) | |
71 | |
72 (defvar url-history-timer nil) | |
73 | |
74 (defvar url-history-changed-since-last-save nil | |
75 "Whether the history list has changed since the last save operation.") | |
76 | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
77 (defvar url-history-hash-table (make-hash-table :size 31 :test 'equal) |
54695 | 78 "Hash table for global history completion.") |
79 | |
80 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
81 |
54695 | 82 (defun url-history-setup-save-timer () |
83 "Reset the history list timer." | |
84 (interactive) | |
86949
5befb2f1ec98
(top-level): Don't require cl when compiling.
Glenn Morris <rgm@gnu.org>
parents:
78222
diff
changeset
|
85 (condition-case nil |
5befb2f1ec98
(top-level): Don't require cl when compiling.
Glenn Morris <rgm@gnu.org>
parents:
78222
diff
changeset
|
86 (cancel-timer url-history-timer) |
5befb2f1ec98
(top-level): Don't require cl when compiling.
Glenn Morris <rgm@gnu.org>
parents:
78222
diff
changeset
|
87 (error nil)) |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
88 (setq url-history-timer nil) |
67237
40f77d1e999e
(url-history-track): Call url-history-setup-save-timer in :set function.
Richard M. Stallman <rms@gnu.org>
parents:
64748
diff
changeset
|
89 (if (and (eq url-history-track t) url-history-save-interval) |
67310
e6faadb77218
(url-history-list): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents:
67240
diff
changeset
|
90 (setq url-history-timer (run-at-time url-history-save-interval |
e6faadb77218
(url-history-list): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents:
67240
diff
changeset
|
91 url-history-save-interval |
e6faadb77218
(url-history-list): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents:
67240
diff
changeset
|
92 'url-history-save-history)))) |
54695 | 93 |
94 (defun url-history-parse-history (&optional fname) | |
95 "Parse a history file stored in FNAME." | |
96 ;; Parse out the mosaic global history file for completions, etc. | |
97 (or fname (setq fname (expand-file-name url-history-file))) | |
98 (cond | |
99 ((not (file-exists-p fname)) | |
68054
30042a8370ce
(url-history-parse-history): Don't complain if the file is missing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67367
diff
changeset
|
100 ;; It's completely normal for this file not to exist, so don't complain. |
30042a8370ce
(url-history-parse-history): Don't complain if the file is missing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67367
diff
changeset
|
101 ;; (message "%s does not exist." fname) |
30042a8370ce
(url-history-parse-history): Don't complain if the file is missing.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67367
diff
changeset
|
102 ) |
54695 | 103 ((not (file-readable-p fname)) |
104 (message "%s is unreadable." fname)) | |
105 (t | |
106 (condition-case nil | |
107 (load fname nil t) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
108 (error (message "Could not load %s" fname)))))) |
54695 | 109 |
110 (defun url-history-update-url (url time) | |
111 (setq url-history-changed-since-last-save t) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
112 (puthash (if (vectorp url) (url-recreate-url url) url) time |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
113 url-history-hash-table)) |
54695 | 114 |
115 (defun url-history-save-history (&optional fname) | |
116 "Write the global history file into `url-history-file'. | |
117 The type of data written is determined by what is in the file to begin | |
118 with. If the type of storage cannot be determined, then prompt the | |
119 user for what type to save as." | |
120 (interactive) | |
121 (or fname (setq fname (expand-file-name url-history-file))) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
122 (unless (file-directory-p (file-name-directory fname)) |
86949
5befb2f1ec98
(top-level): Don't require cl when compiling.
Glenn Morris <rgm@gnu.org>
parents:
78222
diff
changeset
|
123 (condition-case nil |
5befb2f1ec98
(top-level): Don't require cl when compiling.
Glenn Morris <rgm@gnu.org>
parents:
78222
diff
changeset
|
124 (make-directory (file-name-directory fname)) |
5befb2f1ec98
(top-level): Don't require cl when compiling.
Glenn Morris <rgm@gnu.org>
parents:
78222
diff
changeset
|
125 (error nil))) |
54695 | 126 (cond |
127 ((not url-history-changed-since-last-save) nil) | |
128 ((not (file-writable-p fname)) | |
129 (message "%s is unwritable." fname)) | |
130 (t | |
131 (let ((make-backup-files nil) | |
132 (version-control nil) | |
133 (require-final-newline t)) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
134 (with-current-buffer (get-buffer-create " *url-tmp*") |
54695 | 135 (erase-buffer) |
136 (let ((count 0)) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
137 (maphash (lambda (key value) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
138 (while (string-match "[\r\n]+" key) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
139 (setq key (concat (substring key 0 (match-beginning 0)) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
140 (substring key (match-end 0) nil)))) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
141 (setq count (1+ count)) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
142 (insert "(puthash \"" key "\"" |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
143 (if (not (stringp value)) " '" "") |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
144 (prin1-to-string value) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
145 " url-history-hash-table)\n")) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
146 url-history-hash-table) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
147 ;; We used to add this in the file, but it just makes the code |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
148 ;; more complex with no benefit. Worse: it makes it harder to |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
149 ;; preserve preexisting history when loading the history file. |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
150 ;; (goto-char (point-min)) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
151 ;; (insert (format |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
152 ;; "(setq url-history-hash-table (make-hash-table :size %d :test 'equal))\n" |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
153 ;; (/ count 4))) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
154 ;; (goto-char (point-max)) |
54695 | 155 (insert "\n") |
156 (write-file fname)) | |
157 (kill-buffer (current-buffer)))))) | |
158 (setq url-history-changed-since-last-save nil)) | |
159 | |
160 (defun url-have-visited-url (url) | |
161 (url-do-setup) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
162 (gethash url url-history-hash-table nil)) |
54695 | 163 |
164 (defun url-completion-function (string predicate function) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
165 ;; Completion function to complete urls from the history. |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
166 ;; This is obsolete since we can now pass the hash-table directly as a |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
167 ;; completion table. |
54695 | 168 (url-do-setup) |
169 (cond | |
170 ((eq function nil) | |
171 (let ((list nil)) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
172 (maphash (lambda (key val) (push key list)) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
173 url-history-hash-table) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
174 ;; Not sure why we bother reversing the list. --Stef |
54695 | 175 (try-completion string (nreverse list) predicate))) |
176 ((eq function t) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
177 (let ((stub (concat "\\`" (regexp-quote string))) |
54695 | 178 (retval nil)) |
179 (maphash | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
180 (lambda (url time) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
181 (if (string-match stub url) (push url retval))) |
54695 | 182 url-history-hash-table) |
183 retval)) | |
184 ((eq function 'lambda) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
185 (and (gethash string url-history-hash-table) t)) |
54695 | 186 (t |
63416
ed3a1f593d3c
(url-completion-function): Follow error conventions.
Juanma Barranquero <lekktu@gmail.com>
parents:
60258
diff
changeset
|
187 (error "url-completion-function very confused")))) |
54695 | 188 |
189 (provide 'url-history) | |
54699 | 190 |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
191 ;; arch-tag: fbbbaf63-db36-4e88-bc9f-2939aa93afb2 |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
192 ;;; url-history.el ends here |