Mercurial > hg > xemacs-beta
comparison lisp/w3/w3-hot.el @ 2:ac2d302a0011 r19-15b2
Import from CVS: tag r19-15b2
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:46:35 +0200 |
parents | 376386a54a3c |
children | 9ee227acff29 |
comparison
equal
deleted
inserted
replaced
1:c0c6a60d29db | 2:ac2d302a0011 |
---|---|
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 1 ;;; w3-hot.el --- Main functions for emacs-w3 on all platforms/versions |
2 ;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com) | 2 ;; Author: wmperry |
3 ;; Created: 1996/07/26 05:22:59 | |
4 ;; Version: 1.5 | |
5 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia | |
6 | |
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) | |
3 ;;; | 9 ;;; |
4 ;;; This file is not part of GNU Emacs, but the same permissions apply. | 10 ;;; This file is not part of GNU Emacs, but the same permissions apply. |
5 ;;; | 11 ;;; |
6 ;;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;;; GNU Emacs is free software; you can redistribute it and/or modify |
7 ;;; it under the terms of the GNU General Public License as published by | 13 ;;; it under the terms of the GNU General Public License as published by |
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
34 ;;; Hotlist Handling Code | 40 ;;; Hotlist Handling Code |
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 41 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
36 (defvar w3-html-bookmarks nil) | 42 (defvar w3-html-bookmarks nil) |
37 | 43 |
44 (defun w3-hotlist-break-shit () | |
45 (let ((todo '(w3-hotlist-apropos | |
46 w3-hotlist-delete | |
47 w3-hotlist-rename-entry | |
48 w3-hotlist-append | |
49 w3-use-hotlist | |
50 w3-hotlist-add-document | |
51 w3-hotlist-add-document-at-point | |
52 )) | |
53 (cur nil)) | |
54 (while todo | |
55 (setq cur (car todo) | |
56 todo (cdr todo)) | |
57 (fset cur | |
58 (` | |
59 (lambda (&rest ignore) | |
60 (error "Sorry, `%s' does not work with html bookmarks" | |
61 (quote (, cur))))))))) | |
62 | |
38 (defun w3-read-html-bookmarks (fname) | 63 (defun w3-read-html-bookmarks (fname) |
39 "Import an HTML file into the Emacs-w3 format." | 64 "Import an HTML file into the Emacs-w3 format." |
40 (interactive "fBookmark file: ") | 65 (interactive "fBookmark file: ") |
41 (if (not (file-readable-p fname)) | 66 (if (not (file-readable-p fname)) |
42 (error "Can not read %s..." fname)) | 67 (error "Can not read %s..." fname)) |
47 (let* ((w3-debug-html nil) | 72 (let* ((w3-debug-html nil) |
48 (bkmarks nil) | 73 (bkmarks nil) |
49 (parse (w3-parse-buffer (current-buffer) t))) | 74 (parse (w3-parse-buffer (current-buffer) t))) |
50 (setq parse w3-last-parse-tree | 75 (setq parse w3-last-parse-tree |
51 bkmarks (nreverse (w3-grok-html-bookmarks parse)) | 76 bkmarks (nreverse (w3-grok-html-bookmarks parse)) |
52 w3-html-bookmarks bkmarks)))) | 77 w3-html-bookmarks bkmarks))) |
78 (w3-hotlist-break-shit)) | |
53 | 79 |
54 (eval-when-compile | 80 (eval-when-compile |
55 (defvar cur-stack nil) | 81 (defvar cur-stack nil) |
56 (defvar cur-title nil) | 82 (defvar cur-title nil) |
57 (defmacro push-new-menu () | 83 (defmacro push-new-menu () |
82 content (and (listp node) (nth 2 node))) | 108 content (and (listp node) (nth 2 node))) |
83 (cond | 109 (cond |
84 ((eq tag 'title) | 110 ((eq tag 'title) |
85 (setq cur-title (list (w3-normalize-spaces (car content)))) | 111 (setq cur-title (list (w3-normalize-spaces (car content)))) |
86 (w3-grok-html-bookmarks-internal content)) | 112 (w3-grok-html-bookmarks-internal content)) |
87 ((eq tag 'dl) | 113 ((memq tag '(dl ol ul)) |
88 (push-new-menu) | 114 (push-new-menu) |
89 (w3-grok-html-bookmarks-internal content) | 115 (w3-grok-html-bookmarks-internal content) |
90 (finish-submenu)) | 116 (finish-submenu)) |
91 ((and (eq tag 'dt) | 117 ((and (memq tag '(dt li)) |
92 (stringp (car content))) | 118 (stringp (car content))) |
93 (setq cur-title (cons (w3-normalize-spaces (car content)) | 119 (setq cur-title (cons (w3-normalize-spaces (car content)) |
94 cur-title))) | 120 cur-title))) |
95 ((and (eq tag 'a) | 121 ((and (eq tag 'a) |
96 (stringp (car-safe content)) | 122 (stringp (car-safe content)) |
229 (let ((x w3-hotlist)) | 255 (let ((x w3-hotlist)) |
230 (w3-parse-hotlist fname) | 256 (w3-parse-hotlist fname) |
231 (setq w3-hotlist (nconc x w3-hotlist)) | 257 (setq w3-hotlist (nconc x w3-hotlist)) |
232 (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)))) | 258 (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)))) |
233 | 259 |
260 (defun w3-hotlist-parse-old-mosaic-format () | |
261 (let (cur-link cur-alias) | |
262 (while (re-search-forward "^\n" nil t) (replace-match "")) | |
263 (goto-line 3) | |
264 (while (not (eobp)) | |
265 (re-search-forward "^[^ ]*" nil t) | |
266 (setq cur-link (buffer-substring (match-beginning 0) (match-end 0))) | |
267 (setq cur-alias (buffer-substring (progn | |
268 (forward-line 1) | |
269 (beginning-of-line) | |
270 (point)) | |
271 (progn | |
272 (end-of-line) | |
273 (point)))) | |
274 (if (not (equal cur-alias "")) | |
275 (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 | |
234 (defun w3-parse-hotlist (&optional fname) | 279 (defun w3-parse-hotlist (&optional fname) |
235 "Read in the hotlist specified by FNAME" | 280 "Read in the hotlist specified by FNAME" |
236 (if (not fname) (setq fname w3-hotlist-file)) | 281 (if (not fname) (setq fname w3-hotlist-file)) |
237 (setq w3-hotlist nil) | 282 (setq w3-hotlist nil) |
238 (if (not (file-exists-p fname)) | 283 (if (not (file-exists-p fname)) |
239 (message "%s does not exist!" fname) | 284 (message "%s does not exist!" fname) |
240 (let* ((old-buffer (current-buffer)) | 285 (let* ((old-buffer (current-buffer)) |
241 (buffer (get-buffer-create " *HOTW3*")) | 286 (buffer (get-buffer-create " *HOTW3*")) |
242 cur-link | 287 (case-fold-search t)) |
243 cur-alias) | |
244 (set-buffer buffer) | 288 (set-buffer buffer) |
245 (erase-buffer) | 289 (erase-buffer) |
246 (insert-file-contents fname) | 290 (insert-file-contents fname) |
247 (goto-char (point-min)) | 291 (goto-char (point-min)) |
248 (while (re-search-forward "^\n" nil t) (replace-match "")) | 292 (cond |
249 (goto-line 3) | 293 ((looking-at "ncsa-xmosaic-hotlist-format-1");; Old-style NCSA Mosaic |
250 (while (not (eobp)) | 294 (w3-hotlist-parse-old-mosaic-format)) |
251 (re-search-forward "^[^ ]*" nil t) | 295 ((or (looking-at "<!DOCTYPE") ; Some HTML style, including netscape |
252 (setq cur-link (buffer-substring (match-beginning 0) (match-end 0))) | 296 (re-search-forward "<a[ \n]+href" nil t)) |
253 (setq cur-alias (buffer-substring (progn | 297 (w3-read-html-bookmarks fname)) |
254 (forward-line 1) | 298 (t |
255 (beginning-of-line) | 299 (message "Cannot determine format of hotlist file: %s" fname))) |
256 (point)) | 300 (set-buffer-modified-p nil) |
257 (progn | |
258 (end-of-line) | |
259 (point)))) | |
260 (if (not (equal cur-alias "")) | |
261 (setq w3-hotlist (cons (list cur-alias cur-link) w3-hotlist)))) | |
262 (kill-buffer buffer) | 301 (kill-buffer buffer) |
263 (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)) | |
264 (set-buffer old-buffer)))) | 302 (set-buffer old-buffer)))) |
265 | 303 |
266 ;;;###autoload | 304 ;;;###autoload |
267 (defun w3-use-hotlist () | 305 (defun w3-use-hotlist () |
268 "Possibly go to a link in your W3/Mosaic hotlist. | 306 "Possibly go to a link in your W3/Mosaic hotlist. |
286 (or url (error "No link under point.")) | 324 (or url (error "No link under point.")) |
287 (setq title (get-text-property (point) 'title)) | 325 (setq title (get-text-property (point) 'title)) |
288 (if (and title | 326 (if (and title |
289 (marker-buffer (car title)) | 327 (marker-buffer (car title)) |
290 (marker-buffer (cdr title))) | 328 (marker-buffer (cdr title))) |
291 (setq title (buffer-substring (car title) (cdr title))) | 329 (setq title (buffer-substring-no-properties (car title) (cdr title))) |
292 (setq title "None")) | 330 (setq title "None")) |
293 (remove-text-properties 1 (length title)) | |
294 (w3-hotlist-add-document pref-arg title url) | 331 (w3-hotlist-add-document pref-arg title url) |
295 (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)))) | 332 (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)))) |
296 | 333 |
297 (defun w3-hotlist-add-document (pref-arg &optional the-title the-url) | 334 (defun w3-hotlist-add-document (pref-arg &optional the-title the-url) |
298 "Add this documents url to the hotlist" | 335 "Add this documents url to the hotlist" |