Mercurial > emacs
annotate lisp/url/url-history.el @ 65888:6706ae85af7d
Add arch tagline
author | Miles Bader <miles@gnu.org> |
---|---|
date | Fri, 07 Oct 2005 06:46:05 +0000 |
parents | 875dcc490074 |
children | 40f77d1e999e 532e0a9335a9 |
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 | |
41 "*Controls whether to keep a list of all the URLS being visited. | |
42 If non-nil, url 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." |
45 :type 'boolean | |
46 :group 'url-history) | |
47 | |
48 (defcustom url-history-file nil | |
49 "*The global history file for the URL package. | |
50 This file contains a list of all the URLs you have visited. This file | |
51 is parsed at startup and used to provide URL completion." | |
52 :type '(choice (const :tag "Default" :value nil) file) | |
53 :group 'url-history) | |
54 | |
55 (defcustom url-history-save-interval 3600 | |
56 "*The number of seconds between automatic saves of the history list. | |
57 Default is 1 hour. Note that if you change this variable outside of | |
58 the `customize' interface after `url-do-setup' has been run, you need | |
59 to run the `url-history-setup-save-timer' function manually." | |
60 :set (function (lambda (var val) | |
61 (set-default var val) | |
62 (and (featurep 'url) | |
63 (fboundp 'url-history-setup-save-timer) | |
64 (let ((def (symbol-function | |
65 'url-history-setup-save-timer))) | |
66 (not (and (listp def) (eq 'autoload (car def))))) | |
67 (url-history-setup-save-timer)))) | |
68 :type 'integer | |
69 :group 'url-history) | |
70 | |
71 (defvar url-history-timer nil) | |
72 | |
73 (defvar url-history-list nil | |
74 "List of urls visited this session.") | |
75 | |
76 (defvar url-history-changed-since-last-save nil | |
77 "Whether the history list has changed since the last save operation.") | |
78 | |
79 (defvar url-history-hash-table nil | |
80 "Hash table for global history completion.") | |
81 | |
82 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
83 |
54695 | 84 ;;;###autoload |
85 (defun url-history-setup-save-timer () | |
86 "Reset the history list timer." | |
87 (interactive) | |
63416
ed3a1f593d3c
(url-completion-function): Follow error conventions.
Juanma Barranquero <lekktu@gmail.com>
parents:
60258
diff
changeset
|
88 (ignore-errors |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
89 (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
|
90 ((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
|
91 (setq url-history-timer nil) |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
92 (if url-history-save-interval |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
93 (setq url-history-timer |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
94 (cond |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
95 ((fboundp 'run-at-time) |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
96 (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
|
97 url-history-save-interval |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
98 'url-history-save-history)) |
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
99 ((fboundp 'start-itimer) |
54695 | 100 (start-itimer "url-history-saver" 'url-history-save-history |
101 url-history-save-interval | |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
102 url-history-save-interval)))))) |
54695 | 103 |
104 ;;;###autoload | |
105 (defun url-history-parse-history (&optional fname) | |
106 "Parse a history file stored in FNAME." | |
107 ;; Parse out the mosaic global history file for completions, etc. | |
108 (or fname (setq fname (expand-file-name url-history-file))) | |
109 (cond | |
110 ((not (file-exists-p fname)) | |
111 (message "%s does not exist." fname)) | |
112 ((not (file-readable-p fname)) | |
113 (message "%s is unreadable." fname)) | |
114 (t | |
115 (condition-case nil | |
116 (load fname nil t) | |
117 (error (message "Could not load %s" fname))))) | |
118 (if (not url-history-hash-table) | |
119 (setq url-history-hash-table (make-hash-table :size 31 :test 'equal)))) | |
120 | |
121 (defun url-history-update-url (url time) | |
122 (setq url-history-changed-since-last-save t) | |
123 (puthash (if (vectorp url) (url-recreate-url url) url) time url-history-hash-table)) | |
124 | |
125 ;;;###autoload | |
126 (defun url-history-save-history (&optional fname) | |
127 "Write the global history file into `url-history-file'. | |
128 The type of data written is determined by what is in the file to begin | |
129 with. If the type of storage cannot be determined, then prompt the | |
130 user for what type to save as." | |
131 (interactive) | |
132 (or fname (setq fname (expand-file-name url-history-file))) | |
133 (cond | |
134 ((not url-history-changed-since-last-save) nil) | |
135 ((not (file-writable-p fname)) | |
136 (message "%s is unwritable." fname)) | |
137 (t | |
138 (let ((make-backup-files nil) | |
139 (version-control nil) | |
140 (require-final-newline t)) | |
141 (save-excursion | |
142 (set-buffer (get-buffer-create " *url-tmp*")) | |
143 (erase-buffer) | |
144 (let ((count 0)) | |
145 (maphash (function | |
146 (lambda (key value) | |
147 (while (string-match "[\r\n]+" key) | |
148 (setq key (concat (substring key 0 (match-beginning 0)) | |
149 (substring key (match-end 0) nil)))) | |
150 (setq count (1+ count)) | |
151 (insert "(puthash \"" key "\"" | |
152 (if (not (stringp value)) " '" "") | |
153 (prin1-to-string value) | |
154 " url-history-hash-table)\n"))) | |
155 url-history-hash-table) | |
156 (goto-char (point-min)) | |
157 (insert (format | |
158 "(setq url-history-hash-table (make-hash-table :size %d :test 'equal))\n" | |
159 (/ count 4))) | |
160 (goto-char (point-max)) | |
161 (insert "\n") | |
162 (write-file fname)) | |
163 (kill-buffer (current-buffer)))))) | |
164 (setq url-history-changed-since-last-save nil)) | |
165 | |
166 (defun url-have-visited-url (url) | |
167 (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
|
168 (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
|
169 (gethash url url-history-hash-table nil))) |
54695 | 170 |
171 (defun url-completion-function (string predicate function) | |
172 (url-do-setup) | |
173 (cond | |
174 ((eq function nil) | |
175 (let ((list nil)) | |
176 (maphash (function (lambda (key val) | |
177 (setq list (cons (cons key val) | |
178 list)))) | |
179 url-history-hash-table) | |
180 (try-completion string (nreverse list) predicate))) | |
181 ((eq function t) | |
182 (let ((stub (concat "^" (regexp-quote string))) | |
183 (retval nil)) | |
184 (maphash | |
185 (function | |
186 (lambda (url time) | |
187 (if (string-match stub url) | |
188 (setq retval (cons url retval))))) | |
189 url-history-hash-table) | |
190 retval)) | |
191 ((eq function 'lambda) | |
192 (and url-history-hash-table | |
193 (gethash string url-history-hash-table) | |
194 t)) | |
195 (t | |
63416
ed3a1f593d3c
(url-completion-function): Follow error conventions.
Juanma Barranquero <lekktu@gmail.com>
parents:
60258
diff
changeset
|
196 (error "url-completion-function very confused")))) |
54695 | 197 |
198 (provide 'url-history) | |
54699 | 199 |
54797
c70e18f19b9c
(url-history-setup-save-timer): Avoid warnings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
200 ;; 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
|
201 ;;; url-history.el ends here |