cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/hbmap.el

   1 ;;; hbmap.el --- Hyperbole button map maintenance for queries and lookups.
   2
   3 ;; Copyright (C) 1991-1995 Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   8 ;; Keywords: hypermedia, matching
   9
  10 ;; This file is part of GNU Hyperbole.
  11
  12 ;; GNU Hyperbole is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 3, or (at
  15 ;; your option) any later version.
  16
  17 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; 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 the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 ;;;
  32 ;;; Public variables
  33 ;;;
  34
  35 (defvar hbmap:filename "HYPB"
  36   "*Filename used for quick access button files.")
  37
  38 ;;;
  39 ;;; Public functions
  40 ;;;
  41
  42 (defun hbmap:dir-add (dir-name &optional no-save)
  43   "Adds DIR-NAME to map of all directories in which user has written buttons.
  44 Returns t iff DIR-NAME is not already in map, nil if it is, and some
  45 other value when cannot read or write map.
  46 Optional NO-SAVE disables saving of the map after an add."
  47   (hbmap:dir-operate (function (lambda (dir) (not (hbmap:dir-member dir))))
  48                      dir-name
  49                      '(progn (prin1 (list dir-name) buf) (terpri buf))
  50                      no-save))
  51
  52 (defun hbmap:dir-list ()
  53   "Returns list of all directories in which user has written buttons."
  54   (save-excursion
  55     (let ((buf (if (and (file-exists-p hbmap:dir-filename)
  56                         (not (file-readable-p hbmap:dir-filename)))
  57                    nil
  58                  (find-file-noselect hbmap:dir-filename)))
  59           (dirs))
  60       (if buf
  61           (progn (set-buffer buf)
  62                  (goto-char (point-min))
  63                  (condition-case ()
  64                      (while (setq dirs (cons (car (read (current-buffer)))
  65                                              dirs)))
  66                    (error t))
  67                  dirs)))))
  68
  69 (defun hbmap:dir-remove (dir-name &optional no-save)
  70   "Removes DIR-NAME from map of all dirs in which user has written buttons.
  71 Returns t iff DIR-NAME is in the map and is successfully removed, nil if it
  72 is not, and some other value when the map is not readable or writable.
  73 Optional NO-SAVE disables saving of the map after a removal."
  74 (hbmap:dir-operate 'hbmap:dir-member dir-name
  75                    '(delete-region (point) (progn (forward-line 1) (point)))
  76                    no-save))
  77
  78 (defun hbmap:dir-member (dir-name)
  79   "Returns t iff DIR-NAME is a member of user's Hyperbole map, else nil.
  80 If t, point is left at the start of the matching map entry.  If nil,
  81 point is left in a position appropriate for insertion of a new entry."
  82   (let ((obuf (current-buffer))
  83         (buf (and (file-exists-p hbmap:dir-filename)
  84                   (find-file-noselect hbmap:dir-filename)))
  85         (rtn))
  86     (if buf
  87         (progn (set-buffer buf) (widen) (goto-char 1)
  88                (if (search-forward (concat "\n(\"" dir-name "\"") nil t)
  89                    (progn (beginning-of-line) (setq rtn t))
  90                  (goto-char 1) (or (= (forward-line 1) 0) (insert "\n")))
  91                (set-buffer obuf)))
  92     rtn))
  93
  94 ;;;
  95 ;;; Private functions
  96 ;;;
  97
  98 (defun hbmap:dir-operate (pred dir-name form &optional no-save)
  99   "If PRED called on DIR-NAME is non-nil, evaluates FORM.
 100 Returns t if PRED evaluation is successful and nil when not, except when
 101 hbmap is not readable or writable, in which case returns a symbol indicating
 102 the error.  Optional NO-SAVE disables saving of the map after operation."
 103   (save-excursion
 104     (let ((buf (if (and (file-exists-p hbmap:dir-filename)
 105                         (not (file-readable-p hbmap:dir-filename)))
 106                    nil
 107                  (find-file-noselect hbmap:dir-filename))))
 108       (if buf
 109           (progn (set-buffer buf)
 110                  (if (funcall pred dir-name)
 111                      (progn
 112                        (setq buffer-read-only nil)
 113                        (eval form)
 114                        (if no-save t
 115                          (if (file-writable-p buffer-file-name)
 116                              (progn (save-buffer) t)
 117                            'hbmap-not-writable)))))
 118         'hbmap-not-readable))))
 119
 120 ;;;
 121 ;;; Private variables
 122 ;;;
 123
 124 (defvar hbmap:dir-user
 125   (if (memq system-type '(ms-windows windows-nt ms-dos))
 126       "c:/_hyperb/" "~/.hyperb/")
 127   "Per user directory in which to store top level Hyperbole map data.
 128 Must end with a directory separator.
 129 Hyperbole will try to create it whenever 'hyperb:init' is called.")
 130
 131 (defvar hbmap:dir-filename
 132   (expand-file-name  "HBMAP" hbmap:dir-user)
 133   "Name of a file that lists all dirs to which a user has written buttons.
 134 See also 'hbmap:dir-user'.
 135 If you change its value, you will be unable to search for buttons created by
 136 others who use a different value!")
 137
 138 (provide 'hbmap)
 139
 140 ;;; hbmap.el ends here