Mercurial > emacs
comparison lisp/url/url-history.el @ 54695:3fb37923e567
Initial revision
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Sun, 04 Apr 2004 01:21:46 +0000 |
parents | |
children | 7784ae10206d |
comparison
equal
deleted
inserted
replaced
54694:253149f265f2 | 54695:3fb37923e567 |
---|---|
1 ;;; url-history.el --- Global history tracking for URL package | |
2 ;; Author: $Author: fx $ | |
3 ;; Created: $Date: 2001/05/05 16:49:52 $ | |
4 ;; Version: $Revision: 1.6 $ | |
5 ;; Keywords: comm, data, processes, hypermedia | |
6 | |
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu> | |
9 ;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | |
10 ;;; | |
11 ;;; This file is part of GNU Emacs. | |
12 ;;; | |
13 ;;; GNU Emacs is free software; you can redistribute it and/or modify | |
14 ;;; it under the terms of the GNU General Public License as published by | |
15 ;;; the Free Software Foundation; either version 2, or (at your option) | |
16 ;;; any later version. | |
17 ;;; | |
18 ;;; GNU Emacs is distributed in the hope that it will be useful, | |
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 ;;; GNU General Public License for more details. | |
22 ;;; | |
23 ;;; You should have received a copy of the GNU General Public License | |
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the | |
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
26 ;;; Boston, MA 02111-1307, USA. | |
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
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 | |
36 "History variables in the URL package" | |
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. | |
43 If eq to `t', then the list is saved to disk at the end of each emacs | |
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
83 ;;;###autoload | |
84 (defun url-history-setup-save-timer () | |
85 "Reset the history list timer." | |
86 (interactive) | |
87 (cond | |
88 ((featurep 'itimer) | |
89 (ignore-errors (delete-itimer url-history-timer)) | |
90 (setq url-history-timer nil) | |
91 (if url-history-save-interval | |
92 (setq url-history-timer | |
93 (start-itimer "url-history-saver" 'url-history-save-history | |
94 url-history-save-interval | |
95 url-history-save-interval)))) | |
96 ((fboundp 'run-at-time) | |
97 (ignore-errors (cancel-timer url-history-timer)) | |
98 (setq url-history-timer nil) | |
99 (if url-history-save-interval | |
100 (setq url-history-timer | |
101 (run-at-time url-history-save-interval | |
102 url-history-save-interval | |
103 'url-history-save-history)))) | |
104 (t nil))) | |
105 | |
106 ;;;###autoload | |
107 (defun url-history-parse-history (&optional fname) | |
108 "Parse a history file stored in FNAME." | |
109 ;; Parse out the mosaic global history file for completions, etc. | |
110 (or fname (setq fname (expand-file-name url-history-file))) | |
111 (cond | |
112 ((not (file-exists-p fname)) | |
113 (message "%s does not exist." fname)) | |
114 ((not (file-readable-p fname)) | |
115 (message "%s is unreadable." fname)) | |
116 (t | |
117 (condition-case nil | |
118 (load fname nil t) | |
119 (error (message "Could not load %s" fname))))) | |
120 (if (not url-history-hash-table) | |
121 (setq url-history-hash-table (make-hash-table :size 31 :test 'equal)))) | |
122 | |
123 (defun url-history-update-url (url time) | |
124 (setq url-history-changed-since-last-save t) | |
125 (puthash (if (vectorp url) (url-recreate-url url) url) time url-history-hash-table)) | |
126 | |
127 ;;;###autoload | |
128 (defun url-history-save-history (&optional fname) | |
129 "Write the global history file into `url-history-file'. | |
130 The type of data written is determined by what is in the file to begin | |
131 with. If the type of storage cannot be determined, then prompt the | |
132 user for what type to save as." | |
133 (interactive) | |
134 (or fname (setq fname (expand-file-name url-history-file))) | |
135 (cond | |
136 ((not url-history-changed-since-last-save) nil) | |
137 ((not (file-writable-p fname)) | |
138 (message "%s is unwritable." fname)) | |
139 (t | |
140 (let ((make-backup-files nil) | |
141 (version-control nil) | |
142 (require-final-newline t)) | |
143 (save-excursion | |
144 (set-buffer (get-buffer-create " *url-tmp*")) | |
145 (erase-buffer) | |
146 (let ((count 0)) | |
147 (maphash (function | |
148 (lambda (key value) | |
149 (while (string-match "[\r\n]+" key) | |
150 (setq key (concat (substring key 0 (match-beginning 0)) | |
151 (substring key (match-end 0) nil)))) | |
152 (setq count (1+ count)) | |
153 (insert "(puthash \"" key "\"" | |
154 (if (not (stringp value)) " '" "") | |
155 (prin1-to-string value) | |
156 " url-history-hash-table)\n"))) | |
157 url-history-hash-table) | |
158 (goto-char (point-min)) | |
159 (insert (format | |
160 "(setq url-history-hash-table (make-hash-table :size %d :test 'equal))\n" | |
161 (/ count 4))) | |
162 (goto-char (point-max)) | |
163 (insert "\n") | |
164 (write-file fname)) | |
165 (kill-buffer (current-buffer)))))) | |
166 (setq url-history-changed-since-last-save nil)) | |
167 | |
168 (defun url-have-visited-url (url) | |
169 (url-do-setup) | |
170 (gethash url url-history-hash-table nil)) | |
171 | |
172 (defun url-completion-function (string predicate function) | |
173 (url-do-setup) | |
174 (cond | |
175 ((eq function nil) | |
176 (let ((list nil)) | |
177 (maphash (function (lambda (key val) | |
178 (setq list (cons (cons key val) | |
179 list)))) | |
180 url-history-hash-table) | |
181 (try-completion string (nreverse list) predicate))) | |
182 ((eq function t) | |
183 (let ((stub (concat "^" (regexp-quote string))) | |
184 (retval nil)) | |
185 (maphash | |
186 (function | |
187 (lambda (url time) | |
188 (if (string-match stub url) | |
189 (setq retval (cons url retval))))) | |
190 url-history-hash-table) | |
191 retval)) | |
192 ((eq function 'lambda) | |
193 (and url-history-hash-table | |
194 (gethash string url-history-hash-table) | |
195 t)) | |
196 (t | |
197 (error "url-completion-function very confused.")))) | |
198 | |
199 (provide 'url-history) |