Mercurial > emacs
annotate lisp/url/url-history.el @ 67892:e188efbb47ee
(Using Customize): New node.
author | Romain Francoise <romain@orebokech.com> |
---|---|
date | Thu, 29 Dec 2005 14:08:09 +0000 |
parents | 80952520899f |
children | 30042a8370ce 37d0562504bf |
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, |
875dcc490074
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64084
diff
changeset
|
4 ;; 2005 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 | |
78 (defvar url-history-hash-table nil | |
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 ;;;###autoload |
84 (defun url-history-setup-save-timer () | |
85 "Reset the history list timer." | |
86 (interactive) | |
63416
ed3a1f593d3c
(url-completion-function): Follow error conventions.
Juanma Barranquero <lekktu@gmail.com>
parents:
60258
diff
changeset
|
87 (ignore-errors |
67310
e6faadb77218
(url-history-list): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents:
67240
diff
changeset
|
88 (cancel-timer url-history-timer)) |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
89 (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
|
90 (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
|
91 (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
|
92 url-history-save-interval |
e6faadb77218
(url-history-list): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents:
67240
diff
changeset
|
93 'url-history-save-history)))) |
54695 | 94 |
95 ;;;###autoload | |
96 (defun url-history-parse-history (&optional fname) | |
97 "Parse a history file stored in FNAME." | |
98 ;; Parse out the mosaic global history file for completions, etc. | |
99 (or fname (setq fname (expand-file-name url-history-file))) | |
100 (cond | |
101 ((not (file-exists-p fname)) | |
102 (message "%s does not exist." fname)) | |
103 ((not (file-readable-p fname)) | |
104 (message "%s is unreadable." fname)) | |
105 (t | |
106 (condition-case nil | |
107 (load fname nil t) | |
108 (error (message "Could not load %s" fname))))) | |
109 (if (not url-history-hash-table) | |
110 (setq url-history-hash-table (make-hash-table :size 31 :test 'equal)))) | |
111 | |
112 (defun url-history-update-url (url time) | |
113 (setq url-history-changed-since-last-save t) | |
114 (puthash (if (vectorp url) (url-recreate-url url) url) time url-history-hash-table)) | |
115 | |
116 ;;;###autoload | |
117 (defun url-history-save-history (&optional fname) | |
118 "Write the global history file into `url-history-file'. | |
119 The type of data written is determined by what is in the file to begin | |
120 with. If the type of storage cannot be determined, then prompt the | |
121 user for what type to save as." | |
122 (interactive) | |
123 (or fname (setq fname (expand-file-name url-history-file))) | |
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)) | |
132 (save-excursion | |
133 (set-buffer (get-buffer-create " *url-tmp*")) | |
134 (erase-buffer) | |
135 (let ((count 0)) | |
136 (maphash (function | |
137 (lambda (key value) | |
138 (while (string-match "[\r\n]+" key) | |
139 (setq key (concat (substring key 0 (match-beginning 0)) | |
140 (substring key (match-end 0) nil)))) | |
141 (setq count (1+ count)) | |
142 (insert "(puthash \"" key "\"" | |
143 (if (not (stringp value)) " '" "") | |
144 (prin1-to-string value) | |
145 " url-history-hash-table)\n"))) | |
146 url-history-hash-table) | |
147 (goto-char (point-min)) | |
148 (insert (format | |
149 "(setq url-history-hash-table (make-hash-table :size %d :test 'equal))\n" | |
150 (/ count 4))) | |
151 (goto-char (point-max)) | |
152 (insert "\n") | |
153 (write-file fname)) | |
154 (kill-buffer (current-buffer)))))) | |
155 (setq url-history-changed-since-last-save nil)) | |
156 | |
157 (defun url-have-visited-url (url) | |
158 (url-do-setup) | |
60258
a94bedf417a1
(url-have-visited-url): Don't barf if url-history-hash-table is nil.
Eli Zaretskii <eliz@gnu.org>
parents:
57427
diff
changeset
|
159 (and url-history-hash-table |
a94bedf417a1
(url-have-visited-url): Don't barf if url-history-hash-table is nil.
Eli Zaretskii <eliz@gnu.org>
parents:
57427
diff
changeset
|
160 (gethash url url-history-hash-table nil))) |
54695 | 161 |
162 (defun url-completion-function (string predicate function) | |
163 (url-do-setup) | |
164 (cond | |
165 ((eq function nil) | |
166 (let ((list nil)) | |
167 (maphash (function (lambda (key val) | |
168 (setq list (cons (cons key val) | |
169 list)))) | |
170 url-history-hash-table) | |
171 (try-completion string (nreverse list) predicate))) | |
172 ((eq function t) | |
173 (let ((stub (concat "^" (regexp-quote string))) | |
174 (retval nil)) | |
175 (maphash | |
176 (function | |
177 (lambda (url time) | |
178 (if (string-match stub url) | |
179 (setq retval (cons url retval))))) | |
180 url-history-hash-table) | |
181 retval)) | |
182 ((eq function 'lambda) | |
183 (and url-history-hash-table | |
184 (gethash string url-history-hash-table) | |
185 t)) | |
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 |