Mercurial > emacs
annotate lisp/url/url-history.el @ 81055:acfe3e8598d8
*** empty log message ***
author | Eli Zaretskii <eliz@gnu.org> |
---|---|
date | Wed, 23 May 2007 18:36:16 +0000 |
parents | e3694f1cb928 |
children | 8932997d0b62 b8d9a391daf3 |
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 |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
12 ;; the Free Software Foundation; either version 2, or (at your option) |
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 (eval-when-compile (require 'cl)) | |
32 (require 'url-parse) | |
33 (autoload 'url-do-setup "url") | |
34 | |
35 (defgroup url-history nil | |
63991
03160396e8bc
(url-history): Finish `defgroup' description with period.
Juanma Barranquero <lekktu@gmail.com>
parents:
63416
diff
changeset
|
36 "History variables in the URL package." |
54695 | 37 :prefix "url-history" |
38 :group 'url) | |
39 | |
40 (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
|
41 "*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
|
42 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
|
43 If set to t, then the list is saved to disk at the end of each Emacs |
54695 | 44 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
|
45 :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
|
46 (set-default var val) |
67240
fb7449e080a0
(url-history-track): Fix last change.
Kim F. Storm <storm@cua.dk>
parents:
67237
diff
changeset
|
47 (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
|
48 (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
|
49 :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
|
50 (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
|
51 (const :tag "within session" 'session)) |
54695 | 52 :group 'url-history) |
53 | |
54 (defcustom url-history-file nil | |
55 "*The global history file for the URL package. | |
56 This file contains a list of all the URLs you have visited. This file | |
57 is parsed at startup and used to provide URL completion." | |
58 :type '(choice (const :tag "Default" :value nil) file) | |
59 :group 'url-history) | |
60 | |
61 (defcustom url-history-save-interval 3600 | |
62 "*The number of seconds between automatic saves of the history list. | |
63 Default is 1 hour. Note that if you change this variable outside of | |
64 the `customize' interface after `url-do-setup' has been run, you need | |
65 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
|
66 :set #'(lambda (var val) |
e6faadb77218
(url-history-list): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents:
67240
diff
changeset
|
67 (set-default var val) |
e6faadb77218
(url-history-list): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents:
67240
diff
changeset
|
68 (if (bound-and-true-p url-setup-done) |
e6faadb77218
(url-history-list): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents:
67240
diff
changeset
|
69 (url-history-setup-save-timer))) |
54695 | 70 :type 'integer |
71 :group 'url-history) | |
72 | |
73 (defvar url-history-timer nil) | |
74 | |
75 (defvar url-history-changed-since-last-save nil | |
76 "Whether the history list has changed since the last save operation.") | |
77 | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
78 (defvar url-history-hash-table (make-hash-table :size 31 :test 'equal) |
54695 | 79 "Hash table for global history completion.") |
80 | |
81 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
82 |
54695 | 83 (defun url-history-setup-save-timer () |
84 "Reset the history list timer." | |
85 (interactive) | |
63416
ed3a1f593d3c
(url-completion-function): Follow error conventions.
Juanma Barranquero <lekktu@gmail.com>
parents:
60258
diff
changeset
|
86 (ignore-errors |
67310
e6faadb77218
(url-history-list): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents:
67240
diff
changeset
|
87 (cancel-timer url-history-timer)) |
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)) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
123 (ignore-errors (make-directory (file-name-directory fname)))) |
54695 | 124 (cond |
125 ((not url-history-changed-since-last-save) nil) | |
126 ((not (file-writable-p fname)) | |
127 (message "%s is unwritable." fname)) | |
128 (t | |
129 (let ((make-backup-files nil) | |
130 (version-control nil) | |
131 (require-final-newline t)) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
132 (with-current-buffer (get-buffer-create " *url-tmp*") |
54695 | 133 (erase-buffer) |
134 (let ((count 0)) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
135 (maphash (lambda (key value) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
136 (while (string-match "[\r\n]+" key) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
137 (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
|
138 (substring key (match-end 0) nil)))) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
139 (setq count (1+ count)) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
140 (insert "(puthash \"" key "\"" |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
141 (if (not (stringp value)) " '" "") |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
142 (prin1-to-string value) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
143 " url-history-hash-table)\n")) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
144 url-history-hash-table) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
145 ;; 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
|
146 ;; 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
|
147 ;; 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
|
148 ;; (goto-char (point-min)) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
149 ;; (insert (format |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
150 ;; "(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
|
151 ;; (/ count 4))) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
152 ;; (goto-char (point-max)) |
54695 | 153 (insert "\n") |
154 (write-file fname)) | |
155 (kill-buffer (current-buffer)))))) | |
156 (setq url-history-changed-since-last-save nil)) | |
157 | |
158 (defun url-have-visited-url (url) | |
159 (url-do-setup) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
160 (gethash url url-history-hash-table nil)) |
54695 | 161 |
162 (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
|
163 ;; 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
|
164 ;; 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
|
165 ;; completion table. |
54695 | 166 (url-do-setup) |
167 (cond | |
168 ((eq function nil) | |
169 (let ((list nil)) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
170 (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
|
171 url-history-hash-table) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
172 ;; Not sure why we bother reversing the list. --Stef |
54695 | 173 (try-completion string (nreverse list) predicate))) |
174 ((eq function t) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
175 (let ((stub (concat "\\`" (regexp-quote string))) |
54695 | 176 (retval nil)) |
177 (maphash | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
178 (lambda (url time) |
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
179 (if (string-match stub url) (push url retval))) |
54695 | 180 url-history-hash-table) |
181 retval)) | |
182 ((eq function 'lambda) | |
68056
2396bdbbc2bb
(url-history-hash-table): Initialize in declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68054
diff
changeset
|
183 (and (gethash string url-history-hash-table) t)) |
54695 | 184 (t |
63416
ed3a1f593d3c
(url-completion-function): Follow error conventions.
Juanma Barranquero <lekktu@gmail.com>
parents:
60258
diff
changeset
|
185 (error "url-completion-function very confused")))) |
54695 | 186 |
187 (provide 'url-history) | |
54699 | 188 |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
189 ;; 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
|
190 ;;; url-history.el ends here |