|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: hbmap.el
|
|
|
4 ;; SUMMARY: Hyperbole button map maintenance for queries and lookups.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: hypermedia, matching
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
|
9 ;; ORG: Brown U.
|
|
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 6-Oct-91 at 06:34:05
|
|
70
|
12 ;; LAST-MOD: 24-Oct-95 at 18:32:30 by Bob Weiner
|
|
0
|
13 ;;
|
|
|
14 ;; This file is part of Hyperbole.
|
|
|
15 ;; Available for use and distribution under the same terms as GNU Emacs.
|
|
|
16 ;;
|
|
|
17 ;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
|
|
|
18 ;; Developed with support from Motorola Inc.
|
|
|
19 ;;
|
|
|
20 ;; DESCRIPTION:
|
|
|
21 ;; DESCRIP-END.
|
|
|
22
|
|
|
23 ;;; ************************************************************************
|
|
|
24 ;;; Public variables
|
|
|
25 ;;; ************************************************************************
|
|
|
26
|
|
|
27 (defvar hbmap:filename "HYPB"
|
|
|
28 "*Filename used for quick access button files.")
|
|
|
29
|
|
|
30 ;;; ************************************************************************
|
|
|
31 ;;; Public functions
|
|
|
32 ;;; ************************************************************************
|
|
|
33
|
|
|
34 (defun hbmap:dir-add (dir-name &optional no-save)
|
|
|
35 "Adds DIR-NAME to map of all directories in which user has written buttons.
|
|
|
36 Returns t iff DIR-NAME is not already in map, nil if it is, and some
|
|
|
37 other value when cannot read or write map.
|
|
|
38 Optional NO-SAVE disables saving of the map after an add."
|
|
|
39 (hbmap:dir-operate (function (lambda (dir) (not (hbmap:dir-member dir))))
|
|
|
40 dir-name
|
|
|
41 '(progn (prin1 (list dir-name) buf) (terpri buf))
|
|
|
42 no-save))
|
|
|
43
|
|
|
44 (defun hbmap:dir-list ()
|
|
|
45 "Returns list of all directories in which user has written buttons."
|
|
|
46 (save-excursion
|
|
|
47 (let ((buf (if (and (file-exists-p hbmap:dir-filename)
|
|
|
48 (not (file-readable-p hbmap:dir-filename)))
|
|
|
49 nil
|
|
|
50 (find-file-noselect hbmap:dir-filename)))
|
|
|
51 (dirs))
|
|
|
52 (if buf
|
|
|
53 (progn (set-buffer buf)
|
|
|
54 (goto-char (point-min))
|
|
|
55 (condition-case ()
|
|
|
56 (while (setq dirs (cons (car (read (current-buffer)))
|
|
|
57 dirs)))
|
|
|
58 (error t))
|
|
|
59 dirs)))))
|
|
|
60
|
|
|
61 (defun hbmap:dir-remove (dir-name &optional no-save)
|
|
|
62 "Removes DIR-NAME from map of all dirs in which user has written buttons.
|
|
|
63 Returns t iff DIR-NAME is in the map and is successfully removed, nil if it
|
|
|
64 is not, and some other value when the map is not readable or writable.
|
|
|
65 Optional NO-SAVE disables saving of the map after a removal."
|
|
|
66 (hbmap:dir-operate 'hbmap:dir-member dir-name
|
|
|
67 '(delete-region (point) (progn (forward-line 1) (point)))
|
|
|
68 no-save))
|
|
|
69
|
|
|
70 (defun hbmap:dir-member (dir-name)
|
|
|
71 "Returns t iff DIR-NAME is a member of user's Hyperbole map, else nil.
|
|
|
72 If t, point is left at the start of the matching map entry. If nil,
|
|
|
73 point is left in a position appropriate for insertion of a new entry."
|
|
|
74 (let ((obuf (current-buffer))
|
|
|
75 (buf (and (file-exists-p hbmap:dir-filename)
|
|
|
76 (find-file-noselect hbmap:dir-filename)))
|
|
|
77 (rtn))
|
|
|
78 (if buf
|
|
|
79 (progn (set-buffer buf) (widen) (goto-char 1)
|
|
|
80 (if (search-forward (concat "\n(\"" dir-name "\"") nil t)
|
|
|
81 (progn (beginning-of-line) (setq rtn t))
|
|
|
82 (goto-char 1) (or (= (forward-line 1) 0) (insert "\n")))
|
|
|
83 (set-buffer obuf)))
|
|
|
84 rtn))
|
|
|
85
|
|
|
86 ;;; ************************************************************************
|
|
|
87 ;;; Private functions
|
|
|
88 ;;; ************************************************************************
|
|
|
89
|
|
|
90 (defun hbmap:dir-operate (pred dir-name form &optional no-save)
|
|
|
91 "If PRED called on DIR-NAME is non-nil, evaluates FORM.
|
|
|
92 Returns t if PRED evaluation is successful and nil when not, except when
|
|
|
93 hbmap is not readable or writable, in which case returns a symbol indicating
|
|
|
94 the error. Optional NO-SAVE disables saving of the map after operation."
|
|
|
95 (save-excursion
|
|
|
96 (let ((buf (if (and (file-exists-p hbmap:dir-filename)
|
|
|
97 (not (file-readable-p hbmap:dir-filename)))
|
|
|
98 nil
|
|
|
99 (find-file-noselect hbmap:dir-filename))))
|
|
|
100 (if buf
|
|
|
101 (progn (set-buffer buf)
|
|
|
102 (if (funcall pred dir-name)
|
|
|
103 (progn
|
|
|
104 (setq buffer-read-only nil)
|
|
|
105 (eval form)
|
|
|
106 (if no-save t
|
|
|
107 (if (file-writable-p buffer-file-name)
|
|
|
108 (progn (save-buffer) t)
|
|
|
109 'hbmap-not-writable)))))
|
|
|
110 'hbmap-not-readable))))
|
|
|
111
|
|
|
112 ;;; ************************************************************************
|
|
|
113 ;;; Private variables
|
|
|
114 ;;; ************************************************************************
|
|
|
115
|
|
|
116 (defvar hbmap:dir-user
|
|
70
|
117 (if (memq system-type '(ms-windows windows-nt ms-dos))
|
|
0
|
118 "c:/_hyperb/" "~/.hyperb/")
|
|
|
119 "Per user directory in which to store top level Hyperbole map data.
|
|
|
120 Must end with a directory separator.
|
|
|
121 Hyperbole will try to create it whenever 'hyperb:init' is called.")
|
|
|
122
|
|
|
123 (defvar hbmap:dir-filename
|
|
|
124 (expand-file-name "HBMAP" hbmap:dir-user)
|
|
|
125 "Name of a file that lists all dirs to which a user has written buttons.
|
|
|
126 See also 'hbmap:dir-user'.
|
|
|
127 If you change its value, you will be unable to search for buttons created by
|
|
|
128 others who use a different value!")
|
|
|
129
|
|
|
130 (provide 'hbmap)
|
