Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hbmap.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 4103f0995bd7
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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
12 ;; LAST-MOD: 24-Oct-95 at 18:32:30 by Bob Weiner
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
117 (if (memq system-type '(ms-windows windows-nt ms-dos))
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)