hbmap.el

;;; hbmap.el --- GNU Hyperbole button map maintenance for queries and lookups.  -*- lexical-binding: t; -*-
;;
;; Author:       Bob Weiner
;;
;; Orig-Date:     6-Oct-91 at 06:34:05
;; Last-Mod:      7-Oct-22 at 23:18:45 by Mats Lidell
;;
;; Copyright (C) 1991-2021  Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.

;;; Commentary:

;;; Code:
;;; ************************************************************************
;;; Public variables
;;; ************************************************************************

(defvar hbmap:filename "HYPB"
  "*Filename used for quick access button files.")

;;; ************************************************************************
;;; Public functions
;;; ************************************************************************

(defun hbmap:dir-add (dir-name &optional no-save)
  "Add 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 (lambda (dir) (not (hbmap:dir-member dir)))
		     dir-name
		     `(progn (prin1 (list ,dir-name) (current-buffer))
			     (terpri (current-buffer)))
		     no-save))

(defun hbmap:dir-list ()
  "Return list of all directories in which user has written buttons."
  (save-excursion
    (let ((buf (unless (and (file-exists-p hbmap:dir-filename)
			    (not (file-readable-p hbmap:dir-filename)))
		 (find-file-noselect hbmap:dir-filename)))
	  dirs)
      (when buf
	(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)
  "Remove 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)
  "Return 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, evaluate FORM.
Return t if PRED evaluation is successful and nil when not, except when
hbmap is not readable or writable, in which case return a symbol indicating
the error.  Optional NO-SAVE disables saving of the map after operation."
  (save-excursion
    (let ((buf (unless (and (file-exists-p hbmap:dir-filename)
			    (not (file-readable-p hbmap:dir-filename)))
		 (find-file-noselect hbmap:dir-filename))))
      (if buf
	  (progn (set-buffer buf)
		 (when (funcall pred dir-name)
		   (setq buffer-read-only nil)
		   (eval form)
		   (cond (no-save
			  t)
			 ((file-writable-p buffer-file-name)
			  (save-buffer)
			  t)
			 (t 'hbmap-not-writable))))
	'hbmap-not-readable))))

;;; ************************************************************************
;;; Private variables
;;; ************************************************************************

(defvar hbmap:dir-user
  (if (and hyperb:microsoft-os-p
	   (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)

;;; hbmap.el ends here