Mercurial > emacs
annotate lisp/url/url-history.el @ 58460:fbd266022300
(substitute-key-definition-key): Optimize. Don't
call indirect-function for nil defn (always signals error).
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Tue, 23 Nov 2004 15:23:57 +0000 |
parents | 01934125951e |
children | a94bedf417a1 47f53c5c9620 |
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 |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
3 ;; Copyright (c) 1996 - 1999,2004 Free Software Foundation, Inc. |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
4 |
54695 | 5 ;; Keywords: comm, data, processes, hypermedia |
6 | |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
7 ;; 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
|
8 ;; |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
9 ;; 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
|
10 ;; 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
|
11 ;; 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
|
12 ;; any later version. |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
13 ;; |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
14 ;; 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
|
15 ;; 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
|
16 ;; 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
|
17 ;; 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
|
18 ;; |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
19 ;; 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
|
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
22 ;; Boston, MA 02111-1307, USA. |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
23 |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
24 ;;; Commentary: |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
25 |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
26 ;;; Code: |
54695 | 27 |
28 ;; This can get a recursive require. | |
29 ;;(require 'url) | |
30 (eval-when-compile (require 'cl)) | |
31 (require 'url-parse) | |
32 (autoload 'url-do-setup "url") | |
33 | |
34 (defgroup url-history nil | |
35 "History variables in the URL package" | |
36 :prefix "url-history" | |
37 :group 'url) | |
38 | |
39 (defcustom url-history-track nil | |
40 "*Controls whether to keep a list of all the URLS being visited. | |
41 If non-nil, url will keep track of all the URLS visited. | |
42 If eq to `t', then the list is saved to disk at the end of each emacs | |
43 session." | |
44 :type 'boolean | |
45 :group 'url-history) | |
46 | |
47 (defcustom url-history-file nil | |
48 "*The global history file for the URL package. | |
49 This file contains a list of all the URLs you have visited. This file | |
50 is parsed at startup and used to provide URL completion." | |
51 :type '(choice (const :tag "Default" :value nil) file) | |
52 :group 'url-history) | |
53 | |
54 (defcustom url-history-save-interval 3600 | |
55 "*The number of seconds between automatic saves of the history list. | |
56 Default is 1 hour. Note that if you change this variable outside of | |
57 the `customize' interface after `url-do-setup' has been run, you need | |
58 to run the `url-history-setup-save-timer' function manually." | |
59 :set (function (lambda (var val) | |
60 (set-default var val) | |
61 (and (featurep 'url) | |
62 (fboundp 'url-history-setup-save-timer) | |
63 (let ((def (symbol-function | |
64 'url-history-setup-save-timer))) | |
65 (not (and (listp def) (eq 'autoload (car def))))) | |
66 (url-history-setup-save-timer)))) | |
67 :type 'integer | |
68 :group 'url-history) | |
69 | |
70 (defvar url-history-timer nil) | |
71 | |
72 (defvar url-history-list nil | |
73 "List of urls visited this session.") | |
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) | |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
87 (ignore-errors |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
88 (cond ((fboundp 'cancel-timer) (cancel-timer url-history-timer)) |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
89 ((fboundp 'delete-itimer) (delete-itimer url-history-timer)))) |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
90 (setq url-history-timer nil) |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
91 (if url-history-save-interval |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
92 (setq url-history-timer |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
93 (cond |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
94 ((fboundp 'run-at-time) |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
95 (run-at-time url-history-save-interval |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
96 url-history-save-interval |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
97 'url-history-save-history)) |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
98 ((fboundp 'start-itimer) |
54695 | 99 (start-itimer "url-history-saver" 'url-history-save-history |
100 url-history-save-interval | |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
101 url-history-save-interval)))))) |
54695 | 102 |
103 ;;;###autoload | |
104 (defun url-history-parse-history (&optional fname) | |
105 "Parse a history file stored in FNAME." | |
106 ;; Parse out the mosaic global history file for completions, etc. | |
107 (or fname (setq fname (expand-file-name url-history-file))) | |
108 (cond | |
109 ((not (file-exists-p fname)) | |
110 (message "%s does not exist." fname)) | |
111 ((not (file-readable-p fname)) | |
112 (message "%s is unreadable." fname)) | |
113 (t | |
114 (condition-case nil | |
115 (load fname nil t) | |
116 (error (message "Could not load %s" fname))))) | |
117 (if (not url-history-hash-table) | |
118 (setq url-history-hash-table (make-hash-table :size 31 :test 'equal)))) | |
119 | |
120 (defun url-history-update-url (url time) | |
121 (setq url-history-changed-since-last-save t) | |
122 (puthash (if (vectorp url) (url-recreate-url url) url) time url-history-hash-table)) | |
123 | |
124 ;;;###autoload | |
125 (defun url-history-save-history (&optional fname) | |
126 "Write the global history file into `url-history-file'. | |
127 The type of data written is determined by what is in the file to begin | |
128 with. If the type of storage cannot be determined, then prompt the | |
129 user for what type to save as." | |
130 (interactive) | |
131 (or fname (setq fname (expand-file-name url-history-file))) | |
132 (cond | |
133 ((not url-history-changed-since-last-save) nil) | |
134 ((not (file-writable-p fname)) | |
135 (message "%s is unwritable." fname)) | |
136 (t | |
137 (let ((make-backup-files nil) | |
138 (version-control nil) | |
139 (require-final-newline t)) | |
140 (save-excursion | |
141 (set-buffer (get-buffer-create " *url-tmp*")) | |
142 (erase-buffer) | |
143 (let ((count 0)) | |
144 (maphash (function | |
145 (lambda (key value) | |
146 (while (string-match "[\r\n]+" key) | |
147 (setq key (concat (substring key 0 (match-beginning 0)) | |
148 (substring key (match-end 0) nil)))) | |
149 (setq count (1+ count)) | |
150 (insert "(puthash \"" key "\"" | |
151 (if (not (stringp value)) " '" "") | |
152 (prin1-to-string value) | |
153 " url-history-hash-table)\n"))) | |
154 url-history-hash-table) | |
155 (goto-char (point-min)) | |
156 (insert (format | |
157 "(setq url-history-hash-table (make-hash-table :size %d :test 'equal))\n" | |
158 (/ count 4))) | |
159 (goto-char (point-max)) | |
160 (insert "\n") | |
161 (write-file fname)) | |
162 (kill-buffer (current-buffer)))))) | |
163 (setq url-history-changed-since-last-save nil)) | |
164 | |
165 (defun url-have-visited-url (url) | |
166 (url-do-setup) | |
167 (gethash url url-history-hash-table nil)) | |
168 | |
169 (defun url-completion-function (string predicate function) | |
170 (url-do-setup) | |
171 (cond | |
172 ((eq function nil) | |
173 (let ((list nil)) | |
174 (maphash (function (lambda (key val) | |
175 (setq list (cons (cons key val) | |
176 list)))) | |
177 url-history-hash-table) | |
178 (try-completion string (nreverse list) predicate))) | |
179 ((eq function t) | |
180 (let ((stub (concat "^" (regexp-quote string))) | |
181 (retval nil)) | |
182 (maphash | |
183 (function | |
184 (lambda (url time) | |
185 (if (string-match stub url) | |
186 (setq retval (cons url retval))))) | |
187 url-history-hash-table) | |
188 retval)) | |
189 ((eq function 'lambda) | |
190 (and url-history-hash-table | |
191 (gethash string url-history-hash-table) | |
192 t)) | |
193 (t | |
194 (error "url-completion-function very confused.")))) | |
195 | |
196 (provide 'url-history) | |
54699 | 197 |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
198 ;; 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
|
199 ;;; url-history.el ends here |