| 1 | ;;; url-history.el --- Global history tracking for URL package |
| 2 | |
| 3 | ;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Keywords: comm, data, processes, hypermedia |
| 6 | |
| 7 | ;; This file is part of GNU Emacs. |
| 8 | ;; |
| 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 10 | ;; it under the terms of the GNU General Public License as published by |
| 11 | ;; the Free Software Foundation, either version 3 of the License, or |
| 12 | ;; (at your option) any later version. |
| 13 | |
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 17 | ;; GNU General Public License for more details. |
| 18 | |
| 19 | ;; You should have received a copy of the GNU General Public License |
| 20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 21 | |
| 22 | ;;; Commentary: |
| 23 | |
| 24 | ;;; Code: |
| 25 | |
| 26 | ;; This can get a recursive require. |
| 27 | ;;(require 'url) |
| 28 | (require 'url-parse) |
| 29 | (autoload 'url-do-setup "url") |
| 30 | |
| 31 | (defgroup url-history nil |
| 32 | "History variables in the URL package." |
| 33 | :prefix "url-history" |
| 34 | :group 'url) |
| 35 | |
| 36 | (defcustom url-history-track nil |
| 37 | "Controls whether to keep a list of all the URLs being visited. |
| 38 | If non-nil, the URL package will keep track of all the URLs visited. |
| 39 | If set to t, then the list is saved to disk at the end of each Emacs |
| 40 | session." |
| 41 | :set #'(lambda (var val) |
| 42 | (set-default var val) |
| 43 | (and (bound-and-true-p url-setup-done) |
| 44 | (url-history-setup-save-timer))) |
| 45 | :type '(choice (const :tag "off" nil) |
| 46 | (const :tag "on" t) |
| 47 | (const :tag "within session" 'session)) |
| 48 | :group 'url-history) |
| 49 | |
| 50 | (defcustom url-history-file nil |
| 51 | "The global history file for the URL package. |
| 52 | This file contains a list of all the URLs you have visited. This file |
| 53 | is parsed at startup and used to provide URL completion." |
| 54 | :type '(choice (const :tag "Default" :value nil) file) |
| 55 | :group 'url-history) |
| 56 | |
| 57 | (defcustom url-history-save-interval 3600 |
| 58 | "The number of seconds between automatic saves of the history list. |
| 59 | Default is 1 hour. Note that if you change this variable outside of |
| 60 | the `customize' interface after `url-do-setup' has been run, you need |
| 61 | to run the `url-history-setup-save-timer' function manually." |
| 62 | :set #'(lambda (var val) |
| 63 | (set-default var val) |
| 64 | (if (bound-and-true-p url-setup-done) |
| 65 | (url-history-setup-save-timer))) |
| 66 | :type 'integer |
| 67 | :group 'url-history) |
| 68 | |
| 69 | (defvar url-history-timer nil) |
| 70 | |
| 71 | (defvar url-history-changed-since-last-save nil |
| 72 | "Whether the history list has changed since the last save operation.") |
| 73 | |
| 74 | (defvar url-history-hash-table (make-hash-table :size 31 :test 'equal) |
| 75 | "Hash table for global history completion.") |
| 76 | |
| 77 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 78 | |
| 79 | (defun url-history-setup-save-timer () |
| 80 | "Reset the history list timer." |
| 81 | (interactive) |
| 82 | (condition-case nil |
| 83 | (cancel-timer url-history-timer) |
| 84 | (error nil)) |
| 85 | (setq url-history-timer nil) |
| 86 | (if (and (eq url-history-track t) url-history-save-interval) |
| 87 | (setq url-history-timer (run-at-time url-history-save-interval |
| 88 | url-history-save-interval |
| 89 | 'url-history-save-history)))) |
| 90 | |
| 91 | (defun url-history-parse-history (&optional fname) |
| 92 | "Parse a history file stored in FNAME." |
| 93 | ;; Parse out the mosaic global history file for completions, etc. |
| 94 | (or fname (setq fname (expand-file-name url-history-file))) |
| 95 | (cond |
| 96 | ((not (file-exists-p fname)) |
| 97 | ;; It's completely normal for this file not to exist, so don't complain. |
| 98 | ;; (message "%s does not exist." fname) |
| 99 | ) |
| 100 | ((not (file-readable-p fname)) |
| 101 | (message "%s is unreadable." fname)) |
| 102 | (t |
| 103 | (condition-case nil |
| 104 | (load fname nil t) |
| 105 | (error (message "Could not load %s" fname)))))) |
| 106 | |
| 107 | (defun url-history-update-url (url time) |
| 108 | (setq url-history-changed-since-last-save t) |
| 109 | (puthash (if (vectorp url) (url-recreate-url url) url) time |
| 110 | url-history-hash-table)) |
| 111 | |
| 112 | (autoload 'url-make-private-file "url-util") |
| 113 | |
| 114 | (defun url-history-save-history (&optional fname) |
| 115 | "Write the global history file into `url-history-file'. |
| 116 | The type of data written is determined by what is in the file to begin |
| 117 | with. If the type of storage cannot be determined, then prompt the |
| 118 | user for what type to save as." |
| 119 | (interactive) |
| 120 | (when url-history-changed-since-last-save |
| 121 | (or fname (setq fname (expand-file-name url-history-file))) |
| 122 | (if (condition-case nil |
| 123 | (progn |
| 124 | (url-make-private-file fname) |
| 125 | nil) |
| 126 | (error t)) |
| 127 | (message "Error accessing history file `%s'" fname) |
| 128 | (let ((make-backup-files nil) |
| 129 | (version-control nil) |
| 130 | (require-final-newline t) |
| 131 | (count 0)) |
| 132 | (with-temp-buffer |
| 133 | (maphash (lambda (key value) |
| 134 | (while (string-match "[\r\n]+" key) |
| 135 | (setq key (concat (substring key 0 (match-beginning 0)) |
| 136 | (substring key (match-end 0) nil)))) |
| 137 | (setq count (1+ count)) |
| 138 | (insert "(puthash \"" key "\"" |
| 139 | (if (not (stringp value)) " '" "") |
| 140 | (prin1-to-string value) |
| 141 | " url-history-hash-table)\n")) |
| 142 | url-history-hash-table) |
| 143 | ;; We used to add this in the file, but it just makes the code |
| 144 | ;; more complex with no benefit. Worse: it makes it harder to |
| 145 | ;; preserve preexisting history when loading the history file. |
| 146 | ;; (goto-char (point-min)) |
| 147 | ;; (insert (format |
| 148 | ;; "(setq url-history-hash-table (make-hash-table :size %d :test 'equal))\n" |
| 149 | ;; (/ count 4))) |
| 150 | ;; (goto-char (point-max)) |
| 151 | (insert "\n") |
| 152 | (write-file fname))) |
| 153 | (setq url-history-changed-since-last-save nil)))) |
| 154 | |
| 155 | (defun url-have-visited-url (url) |
| 156 | (url-do-setup) |
| 157 | (gethash url url-history-hash-table nil)) |
| 158 | |
| 159 | (defun url-completion-function (string predicate function) |
| 160 | ;; Completion function to complete urls from the history. |
| 161 | ;; This is obsolete since we can now pass the hash-table directly as a |
| 162 | ;; completion table. |
| 163 | (url-do-setup) |
| 164 | (cond |
| 165 | ((eq function nil) |
| 166 | (let ((list nil)) |
| 167 | (maphash (lambda (key val) (push key list)) |
| 168 | url-history-hash-table) |
| 169 | ;; Not sure why we bother reversing the list. --Stef |
| 170 | (try-completion string (nreverse list) predicate))) |
| 171 | ((eq function t) |
| 172 | (let ((stub (concat "\\`" (regexp-quote string))) |
| 173 | (retval nil)) |
| 174 | (maphash |
| 175 | (lambda (url time) |
| 176 | (if (string-match stub url) (push url retval))) |
| 177 | url-history-hash-table) |
| 178 | retval)) |
| 179 | ((eq function 'lambda) |
| 180 | (and (gethash string url-history-hash-table) t)) |
| 181 | (t |
| 182 | (error "url-completion-function very confused")))) |
| 183 | |
| 184 | (provide 'url-history) |
| 185 | |
| 186 | ;;; url-history.el ends here |