cgit.sxemacs.org Git - packages/blob - xemacs-packages/w3/lisp/w3-hot.el

   1 ;;; w3-hot.el --- Main functions for emacs-w3 on all platforms/versions
   2 ;; Author: $Author: fx $
   3 ;; Created: $Date: 2001/05/14 15:51:54 $
   4 ;; Version: $Revision: 1.4 $
   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>
   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 \f
  29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30 ;;; Structure for hotlists
  31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32 ;;; (
  33 ;;;  ("name of item1" . "http://foo.bar.com/")    ;; A single item in hotlist
  34 ;;;  ("name of item2" . (                         ;; A sublist
  35 ;;;                      ("name of item3" . "http://www.ack.com/")
  36 ;;;                     ))
  37 ;;; )  ; end of hotlist
  38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  39 (require 'w3-vars)
  40 (require 'w3-parse)
  41 (require 'url-parse)
  42 (eval-when-compile (require 'cl))
  43
  44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45 ;;; Hotlist Handling Code
  46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47 (defvar w3-html-bookmarks nil)
  48
  49 ;;;###autoload
  50 (defun w3-read-html-bookmarks (fname)
  51   "Import an HTML file into the Emacs-w3 format."
  52   (interactive "fBookmark file: ")
  53   (if (not (file-readable-p fname))
  54       (error "Can not read %s..." fname))
  55   (save-excursion
  56     (set-buffer (get-buffer-create " *bookmark-work*"))
  57     (erase-buffer)
  58     (insert-file-contents fname)
  59     (let* ((w3-debug-html nil)
  60            (bkmarks nil)
  61            (parse (w3-parse-buffer (current-buffer))))
  62       (setq parse w3-last-parse-tree
  63             bkmarks (nreverse (w3-grok-html-bookmarks parse))
  64             w3-hotlist bkmarks))))
  65
  66 (eval-when-compile
  67   (defsubst w3-hot-push-new-menu ()
  68     (declare (special cur-stack))
  69     (setq cur-stack (cons (list "") cur-stack)))
  70
  71   ;; This stores it in menu format
  72   '(defsubst w3-hot-push-new-item (title href)
  73     (declare (special cur-stack))
  74     (setcar cur-stack (cons (vector title (list 'w3-fetch href) t)
  75                             (car cur-stack))))
  76
  77   ;; This stores it in alist format
  78   (defsubst w3-hot-push-new-item (title href)
  79     (declare (special cur-stack))
  80     (setcar cur-stack (cons (cons title href) (car cur-stack))))
  81
  82   (defsubst w3-hot-finish-submenu ()
  83     (declare (special cur-stack cur-title))
  84     (let ((x (nreverse (car cur-stack)))
  85            (y (pop cur-title)))
  86        (while (string= y "")
  87          (setq y (pop cur-title)))
  88        (and x (setcar x y))
  89        (setq cur-stack (cdr cur-stack))
  90        (if cur-stack
  91            (setcar cur-stack (cons x (car cur-stack)))
  92          (setq cur-stack (list x)))))
  93   )
  94
  95 (defun w3-grok-html-bookmarks-internal (tree)
  96   (declare (special cur-stack cur-title))
  97   (let (node tag content args)
  98     (while tree
  99       (setq node (car tree)
 100             tree (cdr tree)
 101             tag (and (listp node) (nth 0 node))
 102             args (and (listp node) (nth 1 node))
 103             content (and (listp node) (nth 2 node)))
 104       (cond
 105        ((eq tag 'hr)
 106         (setq cur-title '("------")))
 107        ((eq tag 'title)
 108         (setq cur-title (list (w3-normalize-spaces (car content))))
 109         (w3-grok-html-bookmarks-internal content))
 110        ((memq tag '(dl ol ul))
 111         (w3-hot-push-new-menu)
 112         (w3-grok-html-bookmarks-internal content)
 113         (w3-hot-finish-submenu))
 114        ((and (memq tag '(dt li p))
 115              (stringp (car content)))
 116         (setq cur-title (cons (w3-normalize-spaces (car content))
 117                               cur-title)))
 118        ((and (eq tag 'a)
 119              (stringp (car-safe content))
 120              (cdr-safe (assq 'href args)))
 121         (w3-hot-push-new-item (w3-normalize-spaces (car-safe content))
 122                        (cdr-safe (assq 'href args))))
 123        (content
 124         (w3-grok-html-bookmarks-internal content))))))
 125
 126 (defun w3-grok-html-bookmarks (chunk)
 127   (let (
 128         cur-title
 129         cur-stack
 130         )
 131     (declare (special cur-title cur-stack))
 132     (w3-grok-html-bookmarks-internal chunk)
 133     (reverse (car cur-stack))))
 134
 135 (defun w3-hot-convert-to-alist-mapper (node)
 136   (declare (special prefix alist))
 137   (cond
 138    ((stringp node)
 139     ;; Top-level node... ignore
 140     )
 141    ((stringp (cdr node))
 142     ;; A real hyperlink, push it onto the alist
 143     (push (cons (if prefix (concat prefix " / " (car node)) (car node)) (cdr node)) alist))
 144    (t
 145     ;; A submenu, add to prefix and recurse
 146     (w3-hot-convert-to-alist-internal
 147      (cdr node) (if prefix (concat prefix " / " (car node)) (car node))))))
 148
 149 (defun w3-hot-convert-to-alist-internal (l &optional prefix)
 150   (mapc 'w3-hot-convert-to-alist-mapper l))
 151
 152 (defun w3-hot-convert-to-alist (l)
 153   (let ((alist nil))
 154     (w3-hot-convert-to-alist-internal l)
 155     alist))
 156
 157 (defun w3-delete-from-alist (x alist)
 158   ;; Remove X from ALIST, return new alist
 159   (if (eq (assoc x alist) (car alist)) (cdr alist)
 160     (delq (assoc x alist) alist)))
 161
 162 (defun w3-hotlist-parse-old-mosaic-format ()
 163   (let (cur-link cur-alias)
 164     (while (re-search-forward "^\n" nil t) (replace-match ""))
 165     (goto-line 3)
 166     (while (not (eobp))
 167       (re-search-forward "^[^ ]*" nil t)
 168       (setq cur-link (buffer-substring (match-beginning 0) (match-end 0)))
 169       (setq cur-alias (buffer-substring (progn
 170                                           (forward-line 1)
 171                                           (beginning-of-line)
 172                                           (point))
 173                                         (progn
 174                                           (end-of-line)
 175                                           (point))))
 176       (if (not (equal cur-alias ""))
 177           (setq w3-hotlist (cons (list cur-alias cur-link) w3-hotlist))))))
 178
 179 ;;;###autoload
 180 (defun w3-parse-hotlist (&optional fname)
 181   "Read in the hotlist specified by FNAME"
 182   (if (not fname) (setq fname w3-hotlist-file))
 183   (setq w3-hotlist nil)
 184   (if (not (file-exists-p fname))
 185       (message "%s does not exist!" fname)
 186     (let* ((old-buffer (current-buffer))
 187            (buffer (get-buffer-create " *HOTW3*"))
 188            (case-fold-search t))
 189       (set-buffer buffer)
 190       (erase-buffer)
 191       (insert-file-contents fname)
 192       (goto-char (point-min))
 193       (cond
 194        ((looking-at "ncsa-xmosaic-hotlist-format-1");; Old-style NCSA Mosaic
 195         (w3-hotlist-parse-old-mosaic-format))
 196        ((or (looking-at "<!DOCTYPE")    ; Some HTML style, including netscape
 197             (re-search-forward "<a[ \n]+href" nil t))
 198         (w3-read-html-bookmarks fname))
 199        (t
 200         (message "Cannot determine format of hotlist file: %s" fname)))
 201       (set-buffer-modified-p nil)
 202       (kill-buffer buffer)
 203       (set-buffer old-buffer))))
 204
 205 ;;;###autoload
 206 (defun w3-use-hotlist ()
 207   "Possibly go to a link in your W3/Mosaic hotlist.
 208 This is part of the emacs World Wide Web browser.  It will prompt for
 209 one of the items in your 'hotlist'.  A hotlist is a list of often
 210 visited or interesting items you have found on the World Wide Web."
 211   (interactive)
 212   (if (not w3-setup-done) (w3-do-setup))
 213   (if (not w3-hotlist) (message "No hotlist in memory!")
 214     (let* ((completion-ignore-case t)
 215            (hot-alist (w3-hot-convert-to-alist w3-hotlist))
 216            (url (cdr (assoc
 217                       (completing-read "Goto Document: " hot-alist nil t)
 218                       hot-alist))))
 219       (if (string= "" url) (error "No document specified!"))
 220       (w3-fetch url))))
 221
 222 ;;;###autoload
 223 (defun w3-hotlist-add-document-at-point (pref-arg)
 224   "Add the document pointed to by the hyperlink under point to the hotlist."
 225   (interactive "P")
 226   (let ((url (w3-view-this-url t))
 227         (widget (widget-at (point)))
 228         (title nil))
 229     (or url (error "No link under point."))
 230     (if (and (widget-get widget :from)
 231              (widget-get widget :to))
 232         (setq title (buffer-substring (widget-get widget :from)
 233                                       (widget-get widget :to))))
 234     (w3-hotlist-add-document pref-arg (or title url) url)))
 235
 236 ;;;###autoload
 237 (defun w3-hotlist-add-document (pref-arg &optional the-title the-url)
 238   "Add this documents url to the hotlist"
 239   (interactive "P")
 240   (error "Adding to hotlist not implemented yet."))
 241
 242 ;;;###autoload
 243 (defun w3-hotlist-delete ()
 244   "Deletes a document from your hotlist file"
 245   (interactive)
 246   (error "Deleting from hotlist not implemented yet."))
 247
 248 ;;;###autoload
 249 (defun w3-hotlist-refresh ()
 250   "Reload the default hotlist file into memory"
 251   (interactive)
 252   (w3-do-setup)
 253   (w3-parse-hotlist))
 254
 255 ;;;###autoload
 256 (defun w3-hotlist-apropos (regexp)
 257   "Show hotlist entries matching REGEXP."
 258   (interactive "sW3 Hotlist Apropos (regexp): ")
 259   (or w3-setup-done (w3-do-setup))
 260   (w3-fetch (concat "hotlist:search?regexp=" (url-hexify-string regexp))))
 261
 262 ;;;###autoload
 263 (defun w3-hotlist-view ()
 264   "Show the hotlist."
 265   (interactive)
 266   (w3-fetch "hotlist:view"))
 267
 268 (provide 'w3-hot)