Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-hot.el @ 80:1ce6082ce73f r20-0b90

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b90
author cvs
date Mon, 13 Aug 2007 09:06:37 +0200
parents 131b0175ea99
children 6a378aca36af
comparison
equal deleted inserted replaced
79:5b0a5bbffab6 80:1ce6082ce73f
1 ;;; w3-hot.el --- Main functions for emacs-w3 on all platforms/versions 1 ;;; w3-hot.el --- Main functions for emacs-w3 on all platforms/versions
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1996/07/26 05:22:59 3 ;; Created: 1996/12/31 15:39:34
4 ;; Version: 1.5 4 ;; Version: 1.10
5 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia 5 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996 Free Software Foundation, Inc.
9 ;;; 10 ;;;
10 ;;; This file is not part of GNU Emacs, but the same permissions apply. 11 ;;; This file is part of GNU Emacs.
11 ;;; 12 ;;;
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify 13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by 14 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2, or (at your option) 15 ;;; the Free Software Foundation; either version 2, or (at your option)
15 ;;; any later version. 16 ;;; any later version.
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details. 21 ;;; GNU General Public License for more details.
21 ;;; 22 ;;;
22 ;;; You should have received a copy of the GNU General Public License 23 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with GNU Emacs; see the file COPYING. If not, write to 24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;;; Boston, MA 02111-1307, USA.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 28
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;;; Structure for hotlists 30 ;;; Structure for hotlists
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
69 (set-buffer (get-buffer-create " *bookmark-work*")) 71 (set-buffer (get-buffer-create " *bookmark-work*"))
70 (erase-buffer) 72 (erase-buffer)
71 (insert-file-contents fname) 73 (insert-file-contents fname)
72 (let* ((w3-debug-html nil) 74 (let* ((w3-debug-html nil)
73 (bkmarks nil) 75 (bkmarks nil)
74 (parse (w3-parse-buffer (current-buffer) t))) 76 (parse (w3-parse-buffer (current-buffer))))
75 (setq parse w3-last-parse-tree 77 (setq parse w3-last-parse-tree
76 bkmarks (nreverse (w3-grok-html-bookmarks parse)) 78 bkmarks (nreverse (w3-grok-html-bookmarks parse))
77 w3-html-bookmarks bkmarks))) 79 w3-html-bookmarks bkmarks)))
78 (w3-hotlist-break-shit)) 80 (w3-hotlist-break-shit))
79 81
164 (rename-buffer "Hotlist"))))))) 166 (rename-buffer "Hotlist")))))))
165 167
166 (defun w3-hotlist-refresh () 168 (defun w3-hotlist-refresh ()
167 "Reload the default hotlist file into memory" 169 "Reload the default hotlist file into memory"
168 (interactive) 170 (interactive)
169 (w3-parse-hotlist) 171 (w3-parse-hotlist))
170 (if (fboundp 'w3-add-hotlist-menu) (w3-add-hotlist-menu)))
171 172
172 (defun w3-delete-from-alist (x alist) 173 (defun w3-delete-from-alist (x alist)
173 ;; Remove X from ALIST, return new alist 174 ;; Remove X from ALIST, return new alist
174 (if (eq (assoc x alist) (car alist)) (cdr alist) 175 (if (eq (assoc x alist) (car alist)) (cdr alist)
175 (delq (assoc x alist) alist))) 176 (delq (assoc x alist) alist)))
201 (beginning-of-line) 202 (beginning-of-line)
202 (delete-region (point) (progn (forward-line 2) (point))) 203 (delete-region (point) (progn (forward-line 2) (point)))
203 (write-file w3-hotlist-file) 204 (write-file w3-hotlist-file)
204 (setq w3-hotlist (w3-delete-from-alist title w3-hotlist)) 205 (setq w3-hotlist (w3-delete-from-alist title w3-hotlist))
205 (kill-buffer (current-buffer))) 206 (kill-buffer (current-buffer)))
206 (message "%s was not found in %s" title w3-hotlist-file)))))) 207 (message "%s was not found in %s" title w3-hotlist-file)))))))
207 (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)))
208 208
209 (defun w3-hotlist-rename-entry (title) 209 (defun w3-hotlist-rename-entry (title)
210 "Rename a hotlist item" 210 "Rename a hotlist item"
211 (interactive (list (let ((completion-ignore-case t)) 211 (interactive (list (let ((completion-ignore-case t))
212 (completing-read "Rename entry: " w3-hotlist nil t)))) 212 (completing-read "Rename entry: " w3-hotlist nil t))))
244 (kill-buffer (current-buffer)) 244 (kill-buffer (current-buffer))
245 (if (and w3-running-FSF19 (not (eq 'tty (device-type)))) 245 (if (and w3-running-FSF19 (not (eq 'tty (device-type))))
246 (progn 246 (progn
247 (delete-menu-item '("Go")) 247 (delete-menu-item '("Go"))
248 (w3-build-FSF19-menu)))) 248 (w3-build-FSF19-menu))))
249 (message "%s was not found in %s" title w3-hotlist-file)))) 249 (message "%s was not found in %s" title w3-hotlist-file)))))
250 (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)))
251 250
252 (defun w3-hotlist-append (fname) 251 (defun w3-hotlist-append (fname)
253 "Append a hotlist to the one in memory" 252 "Append a hotlist to the one in memory"
254 (interactive "fAppend hotlist file: ") 253 (interactive "fAppend hotlist file: ")
255 (let ((x w3-hotlist)) 254 (let ((x w3-hotlist))
256 (w3-parse-hotlist fname) 255 (w3-parse-hotlist fname)
257 (setq w3-hotlist (nconc x w3-hotlist)) 256 (setq w3-hotlist (nconc x w3-hotlist))))
258 (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu))))
259 257
260 (defun w3-hotlist-parse-old-mosaic-format () 258 (defun w3-hotlist-parse-old-mosaic-format ()
261 (let (cur-link cur-alias) 259 (let (cur-link cur-alias)
262 (while (re-search-forward "^\n" nil t) (replace-match "")) 260 (while (re-search-forward "^\n" nil t) (replace-match ""))
263 (goto-line 3) 261 (goto-line 3)
270 (point)) 268 (point))
271 (progn 269 (progn
272 (end-of-line) 270 (end-of-line)
273 (point)))) 271 (point))))
274 (if (not (equal cur-alias "")) 272 (if (not (equal cur-alias ""))
275 (setq w3-hotlist (cons (list cur-alias cur-link) w3-hotlist))) 273 (setq w3-hotlist (cons (list cur-alias cur-link) w3-hotlist))))))
276 (if (fboundp 'w3-add-hotlist-menu)
277 (funcall 'w3-add-hotlist-menu)))))
278 274
279 (defun w3-parse-hotlist (&optional fname) 275 (defun w3-parse-hotlist (&optional fname)
280 "Read in the hotlist specified by FNAME" 276 "Read in the hotlist specified by FNAME"
281 (if (not fname) (setq fname w3-hotlist-file)) 277 (if (not fname) (setq fname w3-hotlist-file))
282 (setq w3-hotlist nil) 278 (setq w3-hotlist nil)
326 (if (and title 322 (if (and title
327 (marker-buffer (car title)) 323 (marker-buffer (car title))
328 (marker-buffer (cdr title))) 324 (marker-buffer (cdr title)))
329 (setq title (buffer-substring-no-properties (car title) (cdr title))) 325 (setq title (buffer-substring-no-properties (car title) (cdr title)))
330 (setq title "None")) 326 (setq title "None"))
331 (w3-hotlist-add-document pref-arg title url) 327 (w3-hotlist-add-document pref-arg title url)))
332 (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu))))
333 328
334 (defun w3-hotlist-add-document (pref-arg &optional the-title the-url) 329 (defun w3-hotlist-add-document (pref-arg &optional the-title the-url)
335 "Add this documents url to the hotlist" 330 "Add this documents url to the hotlist"
336 (interactive "P") 331 (interactive "P")
337 (save-excursion 332 (save-excursion
356 (backward-char 1)) 351 (backward-char 1))
357 (progn 352 (progn
358 (insert-file-contents w3-hotlist-file) 353 (insert-file-contents w3-hotlist-file)
359 (goto-char (point-max)) 354 (goto-char (point-max))
360 (backward-char 1))) 355 (backward-char 1)))
361 (insert "\n" (url-hexify-string url) " " (current-time-string) 356 (insert "\n" url " " (current-time-string) "\n" title)
362 "\n" title)
363 (write-file w3-hotlist-file) 357 (write-file w3-hotlist-file)
364 (kill-buffer (current-buffer)))) 358 (kill-buffer (current-buffer)))))
365 (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)))
366 359
367 (provide 'w3-hot) 360 (provide 'w3-hot)