Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-hot.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents e04119814345
children 1ce6082ce73f
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
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: 1997/03/11 15:04:05 3 ;; Created: 1996/07/26 05:22:59
4 ;; Version: 1.13 4 ;; Version: 1.5
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, 1997 Free Software Foundation, Inc.
10 ;;; 9 ;;;
11 ;;; This file is part of GNU Emacs. 10 ;;; This file is not part of GNU Emacs, but the same permissions apply.
12 ;;; 11 ;;;
13 ;;; 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
14 ;;; 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
15 ;;; the Free Software Foundation; either version 2, or (at your option) 14 ;;; the Free Software Foundation; either version 2, or (at your option)
16 ;;; any later version. 15 ;;; any later version.
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;;; GNU General Public License for more details. 20 ;;; GNU General Public License for more details.
22 ;;; 21 ;;;
23 ;;; You should have received a copy of the GNU General Public License 22 ;;; 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 23 ;;; along with GNU Emacs; see the file COPYING. If not, write to
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 ;;; Boston, MA 02111-1307, USA.
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 26
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;;; Structure for hotlists 28 ;;; Structure for hotlists
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
71 (set-buffer (get-buffer-create " *bookmark-work*")) 69 (set-buffer (get-buffer-create " *bookmark-work*"))
72 (erase-buffer) 70 (erase-buffer)
73 (insert-file-contents fname) 71 (insert-file-contents fname)
74 (let* ((w3-debug-html nil) 72 (let* ((w3-debug-html nil)
75 (bkmarks nil) 73 (bkmarks nil)
76 (parse (w3-parse-buffer (current-buffer)))) 74 (parse (w3-parse-buffer (current-buffer) t)))
77 (setq parse w3-last-parse-tree 75 (setq parse w3-last-parse-tree
78 bkmarks (nreverse (w3-grok-html-bookmarks parse)) 76 bkmarks (nreverse (w3-grok-html-bookmarks parse))
79 w3-html-bookmarks bkmarks))) 77 w3-html-bookmarks bkmarks)))
80 (w3-hotlist-break-shit)) 78 (w3-hotlist-break-shit))
81 79
158 (rename-buffer (concat "Hotlist during " regexp)))) 156 (rename-buffer (concat "Hotlist during " regexp))))
159 (unwind-protect 157 (unwind-protect
160 (progn 158 (progn
161 (w3-show-hotlist) 159 (w3-show-hotlist)
162 (rename-buffer (concat "Hotlist \"" regexp "\"")) 160 (rename-buffer (concat "Hotlist \"" regexp "\""))
163 (url-set-filename url-current-object (concat "hotlist/" regexp))) 161 (setq url-current-file (concat "hotlist/" regexp)))
164 (and save-buf (save-excursion 162 (and save-buf (save-excursion
165 (set-buffer save-buf) 163 (set-buffer save-buf)
166 (rename-buffer "Hotlist"))))))) 164 (rename-buffer "Hotlist")))))))
167 165
168 (defun w3-hotlist-refresh () 166 (defun w3-hotlist-refresh ()
169 "Reload the default hotlist file into memory" 167 "Reload the default hotlist file into memory"
170 (interactive) 168 (interactive)
171 (w3-parse-hotlist)) 169 (w3-parse-hotlist)
170 (if (fboundp 'w3-add-hotlist-menu) (w3-add-hotlist-menu)))
172 171
173 (defun w3-delete-from-alist (x alist) 172 (defun w3-delete-from-alist (x alist)
174 ;; Remove X from ALIST, return new alist 173 ;; Remove X from ALIST, return new alist
175 (if (eq (assoc x alist) (car alist)) (cdr alist) 174 (if (eq (assoc x alist) (car alist)) (cdr alist)
176 (delq (assoc x alist) alist))) 175 (delq (assoc x alist) alist)))
202 (beginning-of-line) 201 (beginning-of-line)
203 (delete-region (point) (progn (forward-line 2) (point))) 202 (delete-region (point) (progn (forward-line 2) (point)))
204 (write-file w3-hotlist-file) 203 (write-file w3-hotlist-file)
205 (setq w3-hotlist (w3-delete-from-alist title w3-hotlist)) 204 (setq w3-hotlist (w3-delete-from-alist title w3-hotlist))
206 (kill-buffer (current-buffer))) 205 (kill-buffer (current-buffer)))
207 (message "%s was not found in %s" title w3-hotlist-file))))))) 206 (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)))
250 251
251 (defun w3-hotlist-append (fname) 252 (defun w3-hotlist-append (fname)
252 "Append a hotlist to the one in memory" 253 "Append a hotlist to the one in memory"
253 (interactive "fAppend hotlist file: ") 254 (interactive "fAppend hotlist file: ")
254 (let ((x w3-hotlist)) 255 (let ((x w3-hotlist))
255 (w3-parse-hotlist fname) 256 (w3-parse-hotlist fname)
256 (setq w3-hotlist (nconc x w3-hotlist)))) 257 (setq w3-hotlist (nconc x w3-hotlist))
258 (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu))))
257 259
258 (defun w3-hotlist-parse-old-mosaic-format () 260 (defun w3-hotlist-parse-old-mosaic-format ()
259 (let (cur-link cur-alias) 261 (let (cur-link cur-alias)
260 (while (re-search-forward "^\n" nil t) (replace-match "")) 262 (while (re-search-forward "^\n" nil t) (replace-match ""))
261 (goto-line 3) 263 (goto-line 3)
268 (point)) 270 (point))
269 (progn 271 (progn
270 (end-of-line) 272 (end-of-line)
271 (point)))) 273 (point))))
272 (if (not (equal cur-alias "")) 274 (if (not (equal cur-alias ""))
273 (setq w3-hotlist (cons (list cur-alias cur-link) w3-hotlist)))))) 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)))))
274 278
275 (defun w3-parse-hotlist (&optional fname) 279 (defun w3-parse-hotlist (&optional fname)
276 "Read in the hotlist specified by FNAME" 280 "Read in the hotlist specified by FNAME"
277 (if (not fname) (setq fname w3-hotlist-file)) 281 (if (not fname) (setq fname w3-hotlist-file))
278 (setq w3-hotlist nil) 282 (setq w3-hotlist nil)
314 (w3-fetch url)))) 318 (w3-fetch url))))
315 319
316 (defun w3-hotlist-add-document-at-point (pref-arg) 320 (defun w3-hotlist-add-document-at-point (pref-arg)
317 "Add the document pointed to by the hyperlink under point to the hotlist." 321 "Add the document pointed to by the hyperlink under point to the hotlist."
318 (interactive "P") 322 (interactive "P")
319 (let ((url (w3-view-this-url t)) 323 (let ((url (w3-view-this-url t)) title)
320 (widget (widget-at (point)))
321 (title nil))
322 (or url (error "No link under point.")) 324 (or url (error "No link under point."))
323 (if (and (widget-get widget :from) 325 (setq title (get-text-property (point) 'title))
324 (widget-get widget :to)) 326 (if (and title
325 (setq title (buffer-substring (widget-get widget :from) 327 (marker-buffer (car title))
326 (widget-get widget :to)))) 328 (marker-buffer (cdr title)))
327 (w3-hotlist-add-document pref-arg (or title url) url))) 329 (setq title (buffer-substring-no-properties (car title) (cdr title)))
330 (setq title "None"))
331 (w3-hotlist-add-document pref-arg title url)
332 (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu))))
328 333
329 (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)
330 "Add this documents url to the hotlist" 335 "Add this documents url to the hotlist"
331 (interactive "P") 336 (interactive "P")
332 (save-excursion 337 (save-excursion
351 (backward-char 1)) 356 (backward-char 1))
352 (progn 357 (progn
353 (insert-file-contents w3-hotlist-file) 358 (insert-file-contents w3-hotlist-file)
354 (goto-char (point-max)) 359 (goto-char (point-max))
355 (backward-char 1))) 360 (backward-char 1)))
356 (insert "\n" url " " (current-time-string) "\n" title) 361 (insert "\n" (url-hexify-string url) " " (current-time-string)
362 "\n" title)
357 (write-file w3-hotlist-file) 363 (write-file w3-hotlist-file)
358 (kill-buffer (current-buffer))))) 364 (kill-buffer (current-buffer))))
365 (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)))
359 366
360 (provide 'w3-hot) 367 (provide 'w3-hot)