Mercurial > hg > xemacs-beta
view lisp/hyperbole/hbmap.el @ 183:e121b013d1f0 r20-3b18
Import from CVS: tag r20-3b18
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:54:23 +0200 |
parents | 4be1180a9e89 |
children |
line wrap: on
line source
;;!emacs ;; ;; FILE: hbmap.el ;; SUMMARY: Hyperbole button map maintenance for queries and lookups. ;; USAGE: GNU Emacs Lisp Library ;; KEYWORDS: hypermedia, matching ;; ;; AUTHOR: Bob Weiner ;; ORG: Brown U. ;; ;; ORIG-DATE: 6-Oct-91 at 06:34:05 ;; LAST-MOD: 17-Feb-97 at 15:30:16 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. ;; ;; Copyright (C) 1991-1995, Free Software Foundation, Inc. ;; Developed with support from Motorola Inc. ;; ;; DESCRIPTION: ;; DESCRIP-END. ;;; ************************************************************************ ;;; Public variables ;;; ************************************************************************ (defvar hbmap:filename "HYPB" "*Filename used for quick access button files.") ;;; ************************************************************************ ;;; Public functions ;;; ************************************************************************ (defun hbmap:dir-add (dir-name &optional no-save) "Adds DIR-NAME to map of all directories in which user has written buttons. Returns t iff DIR-NAME is not already in map, nil if it is, and some other value when cannot read or write map. Optional NO-SAVE disables saving of the map after an add." (hbmap:dir-operate (function (lambda (dir) (not (hbmap:dir-member dir)))) dir-name '(progn (prin1 (list dir-name) buf) (terpri buf)) no-save)) (defun hbmap:dir-list () "Returns list of all directories in which user has written buttons." (save-excursion (let ((buf (if (and (file-exists-p hbmap:dir-filename) (not (file-readable-p hbmap:dir-filename))) nil (find-file-noselect hbmap:dir-filename))) (dirs)) (if buf (progn (set-buffer buf) (goto-char (point-min)) (condition-case () (while (setq dirs (cons (car (read (current-buffer))) dirs))) (error t)) dirs))))) (defun hbmap:dir-remove (dir-name &optional no-save) "Removes DIR-NAME from map of all dirs in which user has written buttons. Returns t iff DIR-NAME is in the map and is successfully removed, nil if it is not, and some other value when the map is not readable or writable. Optional NO-SAVE disables saving of the map after a removal." (hbmap:dir-operate 'hbmap:dir-member dir-name '(delete-region (point) (progn (forward-line 1) (point))) no-save)) (defun hbmap:dir-member (dir-name) "Returns t iff DIR-NAME is a member of user's Hyperbole map, else nil. If t, point is left at the start of the matching map entry. If nil, point is left in a position appropriate for insertion of a new entry." (let ((obuf (current-buffer)) (buf (and (file-exists-p hbmap:dir-filename) (find-file-noselect hbmap:dir-filename))) (rtn)) (if buf (progn (set-buffer buf) (widen) (goto-char 1) (if (search-forward (concat "\n(\"" dir-name "\"") nil t) (progn (beginning-of-line) (setq rtn t)) (goto-char 1) (or (= (forward-line 1) 0) (insert "\n"))) (set-buffer obuf))) rtn)) ;;; ************************************************************************ ;;; Private functions ;;; ************************************************************************ (defun hbmap:dir-operate (pred dir-name form &optional no-save) "If PRED called on DIR-NAME is non-nil, evaluates FORM. Returns t if PRED evaluation is successful and nil when not, except when hbmap is not readable or writable, in which case returns a symbol indicating the error. Optional NO-SAVE disables saving of the map after operation." (save-excursion (let ((buf (if (and (file-exists-p hbmap:dir-filename) (not (file-readable-p hbmap:dir-filename))) nil (find-file-noselect hbmap:dir-filename)))) (if buf (progn (set-buffer buf) (if (funcall pred dir-name) (progn (setq buffer-read-only nil) (eval form) (if no-save t (if (file-writable-p buffer-file-name) (progn (save-buffer) t) 'hbmap-not-writable))))) 'hbmap-not-readable)))) ;;; ************************************************************************ ;;; Private variables ;;; ************************************************************************ (defvar hbmap:dir-user (if (and hyperb:microcruft-os-p (or (not (fboundp 'getenv)) (not (getenv "HOME")))) "c:/_hyperb/" "~/.hyperb/") "Per user directory in which to store top level Hyperbole map data. Must end with a directory separator. Hyperbole will try to create it whenever 'hyperb:init' is called.") (defvar hbmap:dir-filename (expand-file-name "HBMAP" hbmap:dir-user) "Name of a file that lists all dirs to which a user has written buttons. See also 'hbmap:dir-user'. If you change its value, you will be unable to search for buttons created by others who use a different value!") (provide 'hbmap)