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

   1 ;;; w3-hotindex.el --- Keywords for the hotlist
   2 ;; Author: Laurent Martelli <martelli@iie.cnam.fr>
   3 ;; Created: 1997/12/31
   4 ;; Version: 0.1
   5 ;; TODO:
   6 ;;   patch w3-hot.el so that it removes hotindex entries.
   7 ;;   update w3-hotindex-key-list when removing entries.
   8 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   9 ;;; Structure for hotindexes
  10 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11 ;;; (
  12 ;;;  ("name of item1" "key1" "key2")
  13 ;;; )  ; end of hotlist
  14 ;;; Every "name of item" must be in the hotlist
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16
  17 (require 'w3-vars)
  18 (require 'w3-hot)
  19
  20 ;; --- non Hotindex specific definitions ---
  21 ;; It should probably go in an other file
  22 (defun member-nocase (elt list)
  23   "Returns non-nil if ELT is a string that belongs to LIST case insensitively.
  24 Actually, non-nil means the string as it is in LIST.
  25 It won't work great if there are some non-string objects in LIST. I mean,
  26 it will raise an error."
  27   (setq elt (downcase elt))
  28   (while (and list (not (string= elt (downcase (car list)))))
  29     (setq list (cdr list)))
  30   (car list))
  31 ;; --- end of non Hotindex specific definitions ---
  32
  33
  34 (defvar w3-hotindex ()
  35   "*The hotindex list. It must have the following format:
  36  ((NAME KEY1 KEY2 ...) ...)
  37  NAME is a string identifying the item. It must be in w3-hotlist.
  38  KEYn are strings which are keywords associated with the item.")
  39
  40 (defvar w3-hotindex-file (concat w3-configuration-directory "hotindex")
  41   "*The file where to save the HotIndex.")
  42
  43 (defvar w3-hotindex-key-list ()
  44   "A list of keys used in w3-hotindex")
  45
  46 (defun w3-hotindex-build-completion-key-list (key-list)
  47   "Build a list of keys suitable for use with completing-read."
  48   (mapcar (lambda (x) (list x))
  49           key-list))
  50
  51 (defun w3-hotindex-build-key-list (hotindex)
  52   "(w3-hotindex-build-key-list HOTINDEX)
  53 Returns a list of the keys appearing in HOTINDEX."
  54   (let (key-list key)
  55     (while hotindex
  56       ;; set key is to the list of keys of the current entry
  57       (setq key (cdr (car hotindex)))
  58       (while key
  59         (unless (member-nocase (car key) key-list)
  60           (setq key-list (cons (car key) key-list)))
  61         (setq key (cdr key)))
  62       (setq hotindex (cdr hotindex)))
  63     key-list))
  64
  65 ;;;###autoload
  66 (defun w3-hotindex-add-key (name keyword)
  67   "*Add a keyword to an item in w3-hotindex. Completion is done
  68 on the list of all keywords."
  69   (interactive (let ((completion-ignore-case t))
  70                  (list (completing-read "Entry: " w3-hotlist nil t)
  71                        (completing-read "Keyword: "
  72                                         (w3-hotindex-build-completion-key-list
  73                                          w3-hotindex-key-list)
  74                                         nil nil))))
  75   (let ((item (assoc name w3-hotindex)) key)
  76     (or item
  77         (progn  ;; if the item does not exist, we create it
  78           (setq item (list name))
  79           (setq w3-hotindex (cons item w3-hotindex))))
  80     ;; If that key is already there, do not add it again
  81     ;; (The comparison is case-insensitive)
  82     (setq key (cdr item))
  83     (message "existant keys = %S" key)
  84     (while (and key (not (string= (downcase (car key)) (downcase keyword))))
  85       (setq key (cdr key)))
  86     ;; leading and trailing spaces should be eliminated before this.
  87     ;; Is there a function doing this ????
  88     (if key
  89         (message "%s is already associated with this entry." keyword)
  90         (setcdr item (cons keyword (cdr item)))))
  91   (w3-hotindex-save nil)
  92   ;; rebuilds the list of keys
  93   ;; It would better to do this incrementally
  94   (setq w3-hotindex-key-list (w3-hotindex-build-key-list w3-hotindex)))
  95
  96 ;;;###autoload
  97 (defun w3-hotindex-rm-key (entry keyword)
  98   "*Remove a keyword from an item of w3-hotindex."
  99   (interactive (let ((entry nil)
 100                      (key-list nil)
 101                      (completion-ignore-case t))
 102                  (setq entry (completing-read "Entry: " w3-hotindex nil t))
 103                  (setq key-list (mapcar
 104                                  (lambda (x) (list x))
 105                                  (cdr (assoc entry w3-hotindex))))
 106                  (list entry
 107                        (completing-read "Keyword to remove: " key-list nil t))))
 108   (let ((item (delete keyword (assoc entry w3-hotindex))))
 109     ;; If there are no more keywords for this entry, remove it
 110     (if (null (cdr item))
 111         (setq w3-hotindex (delq item w3-hotindex))))
 112   (w3-hotindex-save nil)
 113   ;; rebuilds the list of keys
 114   ;; It would better to do this incrementally
 115   (setq w3-hotindex-key-list (w3-hotindex-build-key-list w3-hotindex))
 116   )
 117
 118 ;;;###autoload
 119 (defun w3-hotindex-rename-entry (old new)
 120   "Renames an entry in the HotIndex. Intended to be called from
 121 w3-hotlist-rename-entry. OLD should equal the entry to be renamed.
 122 Case is therefore important."
 123   (let ((entry (assoc old w3-hotindex)))
 124     (if entry
 125         (progn (setcar entry new)
 126                (w3-hotindex-save nil)))))
 127
 128 ;;;###autoload
 129 (defun w3-hotindex-delete-entry (title)
 130   "Deletes an entry in the HotIndex. Intended to be called from
 131 w3-hotlist-delete. OLD should equal the entry to be deleted.
 132 Case is therefore important."
 133   (let ((entry (assoc title w3-hotindex)))
 134     (if entry
 135         (progn (setq w3-hotindex (delq entry w3-hotindex))
 136                (setq w3-hotindex-key-list (w3-hotindex-build-key-list
 137                                            w3-hotindex-key-list))
 138                (w3-hotindex-save nil)))))
 139
 140 ;;;###autoload
 141 (defun w3-hotindex-query (key)
 142   "Query the HotIndex for KEY."
 143   (interactive (list (let ((completion-ignore-case t))
 144                  (completing-read "Key: " (w3-hotindex-build-completion-key-list
 145                                            w3-hotindex-key-list)
 146                                   nil t))))
 147   (let ((index w3-hotindex) result)
 148     (message "SEARCHING IN %S" index)
 149     (message "LOOKING FOR %S" key)
 150     (while index
 151       (if (member-nocase key (cdr (car index)))
 152           (progn
 153             (setq result (cons (assoc-ignore-case (caar index) w3-hotlist) result))
 154             (message "MATCH in %S" (car index))
 155             (message "ADDING %S" (assoc-ignore-case (caar index) w3-hotlist)))
 156         (message "no match in %S" (car index)))
 157       (setq index (cdr index)))
 158     (let ((w3-hotlist result)
 159           (w3-reuse-buffers 'no))
 160       (w3-hotlist-view))))
 161
 162 (defun w3-hotindex-save (filename)
 163   "*Save the index structure in filename. If filename is nil,
 164 save into w3-configuration-directory/hotindex."
 165   (interactive "i")
 166   (let ((output-buffer
 167          (find-file-noselect (or filename w3-hotindex-file)))
 168         output-marker)
 169     (save-excursion
 170       (set-buffer output-buffer)
 171       ;; Delete anything that is in the file
 172       (delete-region (point-min) (point-max))
 173       (setq output-marker (point-marker))
 174       (let ((print-readably t)
 175             (print-escape-newlines t)
 176             (standard-output output-marker))
 177         (princ ";; W3 HotIndex\n")
 178         (princ ";; ===========\n")
 179         (princ "(setq-default w3-hotindex '")
 180         (prin1 w3-hotindex)
 181         (princ ")\n;; ==================\n")
 182         (princ ";; End of W3 HotIndex\n")))
 183     (set-marker output-marker nil)
 184     (save-excursion
 185       (set-buffer output-buffer)
 186       (save-buffer))
 187     ))
 188
 189 (defun w3-hotindex-check ()
 190   "Checks that the entries of w3-hotindex are in w3-hotlist.
 191 Raises an error if some entries are unresolved."
 192   (let ((index w3-hotindex) unresolved)
 193     (while index
 194       (unless (assoc-ignore-case (caar index) w3-hotlist)
 195         (setq unresolved (cons (caar index) unresolved)))
 196       (setq index (cdr index)))
 197     (if unresolved
 198         (error "Unresolved entries found in w3-hotindex : %S" unresolved)))
 199   )
 200
 201 (defun w3-hotindex-load ()
 202   "Load the file containing the hotindex, and updates w3-hotindex-key-list."
 203   (interactive)
 204   (load w3-hotindex-file t)
 205   (w3-hotindex-check)
 206   (setq w3-hotindex-key-list (w3-hotindex-build-key-list w3-hotindex))
 207   )
 208
 209 (w3-hotlist-refresh)
 210 (w3-hotindex-load)
 211
 212 (provide 'w3-hotindex)