--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/hyperbole/hui-mini.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,507 @@
+;;!emacs
+;;
+;; FILE:         hui-mini.el
+;; SUMMARY:      One line command menus for Hyperbole
+;; USAGE:        GNU Emacs Lisp Library
+;; KEYWORDS:     hypermedia, mouse
+;;
+;; AUTHOR:       Bob Weiner
+;; ORG:          Brown U.
+;;
+;; ORIG-DATE:    15-Oct-91 at 20:13:17
+;; LAST-MOD:      3-Nov-95 at 04:02:02 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.
+
+;;; ************************************************************************
+;;; Other required Elisp libraries
+;;; ************************************************************************
+
+(require 'hypb)
+
+;;; ************************************************************************
+;;; Public variables
+;;; ************************************************************************
+
+(defvar hui:menu-select "\C-m"
+  "*Upper case char-string which selects the Hyperbole menu item at point.")
+(defvar hui:menu-quit   "Q"
+  "*Upper case char-string which quits selecting from a Hyperbole menu item.")
+(defvar hui:menu-abort  "\C-g"
+  "*Same function as 'hui:menu-quit'.")
+(defvar hui:menu-top    "\C-t"
+  "*Character which returns to top Hyperbole menu.")
+
+(defvar hui:menu-p nil
+  "Non-nil iff a current Hyperbole menu activation exists.")
+
+(defvar hui:menus nil
+  "Command menus for use with the default Hyperbole user interface.")
+(setq
+ hui:menus
+ (delq nil
+ (list (cons
+	'hyperbole
+	(append
+	 (let ((version (if (= (aref hyperb:version 0) ?0)
+			    (substring hyperb:version 1)
+			  hyperb:version)))
+	   (list (list (concat "Hy" version ">"))))
+	 (delq nil
+	       (list
+		'("Act"         hui:hbut-act
+		  "Activates button at point or prompts for explicit button.")
+		'("Butfile/"    (menu . butfile)
+		  "Quick access button files menus.")
+		'("Doc/"        (menu . doc)
+		  "Quick access to Hyperbole documentation.")
+		'("Ebut/"       (menu . ebut)
+		  "Explicit button commands.")
+		'("Gbut/"       (menu . gbut)
+		  "Global button commands.")
+		'("Hist"        (hhist:remove current-prefix-arg)
+		  "Jumps back to location prior to last Hyperbole button follow.")
+		'("Ibut/"       (menu . ibut)
+		  "Implicit button and button type commands.")
+		'("Msg/"        (menu . msg)
+		  "Mail and News messaging facilities.")
+		(if hyperb:kotl-p
+		    '("Otl/"        (menu . otl)
+		      "Autonumbered outlining and hyper-node facilities."))
+		'("Rolo/"       (menu . rolo)
+		  "Hierarchical, multi-file rolodex lookup and edit commands.")
+		'("Win/"       (menu . win)
+		  "Window configuration management command.")
+		))))
+       '(butfile .
+	 (("Butfile>")
+	  ("DirFile"      (find-file hbmap:filename)
+	   "Edits directory-specific button file.")
+	  ("Info"
+	   (id-info "(hyperbole.info)Button Files")
+	   "Displays manual section on button files.") 
+	  ("PersonalFile" (find-file
+			    (expand-file-name hbmap:filename hbmap:dir-user))
+	   "Edits user-specific button file.")
+	  ))
+       '(doc .
+	 (("Doc>")
+	  ("Demo"         (find-file-read-only
+			    (expand-file-name "DEMO" hyperb:dir))
+	   "Demonstrates Hyperbole features.")
+	  ("Files"        (find-file-read-only
+			    (expand-file-name "MANIFEST" hyperb:dir))
+	   "Summarizes Hyperbole system files.  Click on an entry to view it.")
+	  ("Glossary"
+	   (id-info "(hyperbole.info)Glossary")
+	   "Glossary of Hyperbole terms.")
+	  ("HypbCopy"  (id-info "(hyperbole.info)Top")
+	   "Displays general Hyperbole copyright and license details.")
+	  ("Info"      (id-info "(hyperbole.info)Top")
+	   "Online Info version of Hyperbole manual.")
+	  ("MailLists" (id-info "(hyperbole.info)Mail Lists")
+	   "Details on Hyperbole mail list subscriptions.")
+	  ("New"          (progn
+			    (hact 'link-to-regexp-match
+				  "\\*[ \t]+What's New" 2
+				  (expand-file-name "README" hyperb:dir))
+			    (setq buffer-read-only nil)
+			    (toggle-read-only))
+	   "Recent changes to Hyperbole.")
+	  ("SmartKy"      (find-file-read-only (hypb:mouse-help-file))
+	   "Summarizes Smart Key mouse or keyboard handling.")
+	  ("Types/"       (menu . types)
+	   "Provides documentation on Hyperbole types.")
+	 ))
+       '(ebut .
+	 (("EButton>")
+	  ("Act"    hui:hbut-act
+	    "Activates button at point or prompts for explicit button.")
+	  ("Create" hui:ebut-create)
+	  ("Delete" hui:ebut-delete)
+	  ("Edit"   hui:ebut-modify "Modifies any desired button attributes.")
+	  ("Help/"  (menu . ebut-help) "Summarizes button attributes.")
+	  ("Info"
+	   (id-info "(hyperbole.info)Explicit Buttons")
+	   "Displays manual section on explicit buttons.")
+	  ("Modify" hui:ebut-modify "Modifies any desired button attributes.")
+	  ("Rename" hui:ebut-rename "Relabels an explicit button.")
+	  ("Search" hui:ebut-search
+	   "Locates and displays personally created buttons in context.")
+	  ))
+       '(ebut-help .
+	 (("Help on>")
+	  ("BufferButs"   (hui:hbut-report -1)
+	   "Summarizes all explicit buttons in buffer.")
+	  ("CurrentBut"   (hui:hbut-report)
+	   "Summarizes only current button in buffer.")
+	  ("OrderedButs"  (hui:hbut-report 1)
+	   "Summarizes explicit buttons in lexicographically order.")
+	  ))
+       '(gbut .
+	 (("GButton>")
+	  ("Act"    gbut:act        "Activates global button by name.") 
+	  ("Create" hui:gbut-create "Adds a global button to gbut:file.")
+	  ("Edit"   hui:gbut-modify "Modifies global button attributes.")
+	  ("Help"   gbut:help       "Reports on a global button by name.") 
+	  ("Info"   (id-info "(hyperbole.info)Global Buttons")
+	   "Displays manual section on global buttons.")
+	  ("Modify" hui:gbut-modify "Modifies global button attributes.")
+	  ))
+       '(ibut .
+	 (("IButton>")
+	  ("Act"    hui:hbut-act    "Activates implicit button at point.") 
+	  ("DeleteIButType"   (hui:htype-delete 'ibtypes)
+	   "Deletes specified button type.")
+	  ("Help"   hui:hbut-help   "Reports on button's attributes.")
+	  ("Info"   (id-info "(hyperbole.info)Implicit Buttons")
+	   "Displays manual section on implicit buttons.")
+	  ("Types"  (hui:htype-help 'ibtypes 'no-sort)
+	   "Displays documentation for one or all implicit button types.")
+	  ))
+       '(msg .
+	 (("Msg>")
+	  ("Compose-Hypb-Mail"
+	   (hmail:compose "hyperbole@hub.ucsb.edu" '(hact 'hyp-config))
+	   "Send a message to the Hyperbole discussion list.")
+	  ("Edit-Hypb-List-Entry"
+	   (hmail:compose "hyperbole-request@hub.ucsb.edu"
+			  '(hact 'hyp-request))
+	   "Add, remove or change your entry on a the Hyperbole mail list.")
+	  ("Modify-Hypb-Announce-Entry"
+	   (hmail:compose "hyperbole-announce-request@hub.ucsb.edu"
+			  '(hact 'hyp-request))
+	   "Add, remove or change your entry on the Hyperbole Announce mail list.")
+	  ))
+       (if hyperb:kotl-p
+	   '(otl
+	     . (("Otl>")
+		("All"       kotl-mode:show-all "Expand all collapsed cells.") 
+		("Blanks"    kvspec:toggle-blank-lines
+		 "Toggle blank lines between cells on or off.")
+		("Create"    kfile:find   "Create or edit an outline file.")
+		("Downto"    kotl-mode:hide-sublevels
+		 "Hide all cells in outline deeper than a particular level.")
+		("Examp"   (find-file-read-only
+			      (expand-file-name
+			       "EXAMPLE.kotl" (concat hyperb:dir "kotl/")))
+		 "Display a self-descriptive example outline file.")
+		("Hide"      (progn (kotl-mode:is-p)
+				    (kotl-mode:hide-tree (kcell-view:label)))
+		 "Collapse tree rooted at point.")
+		("Info"
+		 (id-info "(hyperbole.info)Outliner")
+		 "Display manual section on Hyperbole outliner.")
+		("Kill"      kotl-mode:kill-tree
+		 "Kill ARG following trees starting from point.")
+		("Link"      klink:create
+		 "Create and insert an implicit link at point.")
+		("Overvw"  kotl-mode:overview
+		 "Show first line of each cell.")
+		("Show"      (progn (kotl-mode:is-p)
+				    (kotl-mode:show-tree (kcell-view:label)))
+		 "Expand tree rooted at point.")
+		("Top"       kotl-mode:top-cells
+		 "Hide all but top-level cells.") 
+		("Vspec"     kvspec:activate
+		 "Prompt for and activate a view specifiction.")
+		)))
+       '(rolo .
+	 (("Rolo>")
+	  ("Add"              rolo-add	  "Add a new rolo entry.")
+	  ("Display"          rolo-display-matches
+	   "Display last found rolodex matches again.")
+	  ("Edit"             rolo-edit   "Edit an existing rolo entry.")
+	  ("Info"             (id-info "(hyperbole.info)Rolodex")
+	   "Displays manual section on Hyperbole rolodex.")
+	  ("Kill"             rolo-kill   "Kill an existing rolo entry.")
+	  ("Mail"             rolo-mail-to "Mail to address following point.")
+	  ("Order"            rolo-sort   "Order rolo entries in a file.")
+	  ("RegexFind"        rolo-grep   "Find entries containing a regexp.")
+	  ("StringFind"       rolo-fgrep  "Find entries containing a string.")
+	  ("WordFind"         rolo-word   "Find entries containing words.")
+	  ("Yank"             rolo-yank
+	   "Find an entry containing a string and insert it at point.")
+	  ))
+       '(types .
+	 (("Types>")
+	  ("ActionTypes"      (hui:htype-help   'actypes)
+	   "Displays documentation for one or all action types.")
+	  ("IButTypes"        (hui:htype-help   'ibtypes 'no-sort)
+	   "Displays documentation for one or all implicit button types.")
+	  ))
+       '(win .
+	 (("WinConfig>")
+	  ("AddName"        wconfig-add-by-name
+	   "Name current window configuration.")
+	  ("DeleteName"     wconfig-delete-by-name
+	   "Delete named window configuration.")
+	  ("RestoreName"    wconfig-restore-by-name
+	   "Restore frame to window configuration given by name.")
+	  ("PopRing"        (progn (wconfig-delete-pop)
+				   (hyperbole 'win))
+	   "Restores window configuration from ring and removes it from ring.")
+	  ("SaveRing"       (wconfig-ring-save)
+	   "Saves current window configuration to ring.")
+	  ("YankRing"       (progn (call-interactively 'wconfig-yank-pop)
+				   (hyperbole 'win))
+	   "Restores next window configuration from ring.")
+	  ))
+       )))
+
+;;; ************************************************************************
+;;; Public functions
+;;; ************************************************************************
+
+;;; Old name
+(fset 'hui:menu 'hyperbole)
+
+;;; Used as autoloaded main entry point to Hyperbole (but hsite.el) is the
+;;; file that is autoloaded when this is invoked.
+;;; It brings up a menu of commands. 
+(defun hyperbole (&optional menu menu-list)
+  "Invokes default Hyperbole menu user interface when not already active.
+Suitable for binding to a key, e.g. {C-h h}.
+Non-interactively, returns t if menu is actually invoked by call, else nil.
+
+Two optional arguments may be given to invoke alternative menus.
+MENU (a symbol) specifies the menu to invoke from MENU-LIST, (a
+Hyperbole menu list structure).  MENU defaults to 'hyperbole and MENU-LIST
+to `hui:menus'.  See `hui:menus' definition for the format of the menu list
+structure."
+
+  (interactive)
+  (if (and hui:menu-p (> (minibuffer-depth) 0))
+      (progn (beep) nil)
+    (unwind-protect
+	(progn
+	  (require 'hsite) ;; Since "hui-mini" may be loaded without loading
+			   ;; all of Hyperbole.
+	  (hyperb:init-menubar)
+	  (setq hui:menu-p t)
+	  (hui:menu-act (or menu 'hyperbole) menu-list)
+	  t)
+      (setq hui:menu-p nil))))
+
+(defun hui:menu-act (menu &optional menu-list)
+  "Prompts user with Hyperbole MENU (a symbol) and performs selected item.
+Optional second argument MENU-LIST is a Hyperbole menu list structure from
+which to extract MENU.  It defaults to `hui:menus'.  See its definition for
+the menu list structure." 
+  (let ((set-menu '(or (and menu (symbolp menu)
+			    (setq menu-alist
+				  (cdr (assq menu (or menu-list hui:menus)))))
+		       (hypb:error "(menu-act): Invalid menu symbol arg: %s"
+			      menu)))
+	(show-menu t)
+	(rtn)
+	menu-alist act-form)
+    (while (and show-menu (eval set-menu))
+      (cond ((and (consp (setq act-form (hui:menu-select menu-alist)))
+		  (cdr act-form)
+		  (symbolp (cdr act-form)))
+	     ;; Display another menu
+	     (setq menu (cdr act-form)))
+	    (act-form
+	     (let ((prefix-arg current-prefix-arg))
+	       (cond ((symbolp act-form)
+		      (if (eq act-form t)
+			  nil
+			(setq show-menu nil
+			      rtn (call-interactively act-form))))
+		     ((stringp act-form)
+		      (hui:menu-help act-form)
+		      ;; Loop and show menu again.
+		      )
+		     (t (setq show-menu nil
+			      rtn (eval act-form))))))
+	    (t (setq show-menu nil))))
+    rtn))
+
+(defun hui:menu-enter (&optional char-str)
+  "Uses CHAR-STR or last input character as minibuffer argument."
+  (interactive)
+  (let ((input (or char-str (aref (recent-keys) (1- (length (recent-keys)))))))
+    (cond (hyperb:emacs19-p
+	   (and (not (integerp input))
+		(eventp input)
+		(setq input (event-basic-type input))))
+	  (hyperb:lemacs-p
+	   (if (eventp input)
+	       (setq input (event-to-character input)))))
+    (if (or (symbolp input)
+	    (and (integerp input)
+		 (= input ?\r)))
+	(setq input (hargs:at-p)))
+    (erase-buffer)
+    (or (symbolp input) (insert input)))
+  (exit-minibuffer))
+
+(defun hui:menu-help (help-str)
+  "Displays HELP-STR in a small window.  HELP-STR must be a string."
+  (let* ((window-min-height 2)
+	 (owind (selected-window))
+	 (buf-name (hypb:help-buf-name "Menu")))
+    (unwind-protect
+	(progn
+	  (save-window-excursion
+	    (hkey-help-show buf-name)) ;; Needed to save wconfig.
+	  (if (eq (selected-window) (minibuffer-window))
+	      (other-window 1))
+	  (if (= (length (hypb:window-list 'no-mini)) 1)
+	      (split-window-vertically nil))
+	  (select-window (hui:bottom-window))
+	  (switch-to-buffer (get-buffer-create buf-name))
+	  (setq buffer-read-only nil)
+	  (erase-buffer)
+	  (insert "\n" help-str)
+	  (set-buffer-modified-p nil)
+	  (shrink-window
+	   (- (window-height)
+	      (+ 3 (length
+		    (delq nil
+			  (mapcar (function
+				   (lambda (chr) (= chr ?\n)))
+				  help-str)))))))
+      (select-window owind))))
+
+(defun hui:menu-xemacs (&optional menu menu-list)
+  "Returns an XEmacs menu built from Hyperbole type menus.
+Optional MENU (a symbol) specifies a specific submenu of optional MENU-LIST.
+a Hyperbole menu list structure.  Otherwise, all menus are used.
+MENU defaults to 'hyperbole and MENU-LIST to `hui:menus'.  See `hui:menus'
+definition for the format of the menu list structure."
+  (mapcar
+   (function 
+    (lambda (entry)
+      (or (consp entry) 
+	  (error "(hui:menu-xemacs): Invalid menu entry: %s" entry))
+      (let ((label (car entry))
+	    (content (car (cdr entry))))
+	(cond ((null content) (hypb:replace-match-string ">$" label "" t))
+	      ((and (consp content) (eq (car content) 'menu))
+	       (hui:menu-xemacs (cdr content)))
+	      (t (vector label content 't))))))
+   (cdr (assq (or menu 'hyperbole) (or menu-list hui:menus)))))
+
+(defun hui:menu-select (menu-alist)
+  "Prompts user to choose the first character of any item from MENU-ALIST.
+Case is not significant.  If chosen by direct selection with the Assist Key,
+returns any help string for item, else returns the action form for the item."
+  (let* ((menu-line (hui:menu-line menu-alist))
+	 (set:equal-op 'eq)
+	 (select-char (string-to-char hui:menu-select))
+	 (quit-char (string-to-char hui:menu-quit))
+	 (abort-char (string-to-char hui:menu-abort))
+	 (top-char  (string-to-char hui:menu-top))
+	 (item-keys (mapcar (function
+			     (lambda (item) (aref item 0)))
+			    (mapcar 'car (cdr menu-alist))))
+	 (keys (apply 'list select-char quit-char abort-char
+		      top-char item-keys))
+	 (key 0)
+	 (hargs:reading-p 'hmenu)
+	 sublist)
+    (while (not (memq (setq key (upcase
+				 (string-to-char
+				  (read-from-minibuffer
+				   "" menu-line hui:menu-mode-map))))
+		      keys))
+      (beep)
+      (setq hargs:reading-p 'hmenu)
+      (discard-input))
+    (cond ((eq key quit-char) nil)
+	  ((eq key abort-char) (beep) nil)
+	  ((eq key top-char) '(menu . hyperbole))
+	  ((and (eq key select-char)
+		(save-excursion
+		  (if (search-backward " " nil t)
+		      (progn (skip-chars-forward " ")
+			     (setq key (following-char))
+			     nil)  ;; Drop through.
+		    t))))
+	  (t (if (setq sublist (memq key item-keys))
+		 (let* ((label-act-help-list
+			 (nth (- (1+ (length item-keys)) (length sublist))
+			      menu-alist))
+			(act-form (car (cdr label-act-help-list))))
+		   (if (eq hargs:reading-p 'hmenu-help)
+		       (let ((help-str
+			      (or (car (cdr (cdr label-act-help-list)))
+				  "No help documentation for this item.")))
+			 (concat (car label-act-help-list) "\n  "
+				 help-str "\n    Action: "
+				 (prin1-to-string act-form)))
+		     act-form)))))))
+
+;;; ************************************************************************
+;;; Private functions
+;;; ************************************************************************
+
+(if (fboundp 'window-lowest-p)
+    (defun hui:bottom-window ()
+      "Return a window that is at the bottom of the selected frame."
+      (let ((winds (hypb:window-list 'no-mini))
+	    (window))
+	(while (and (not window) winds)
+	  (if (window-lowest-p (car winds))
+	      (setq window (car winds))
+	    (setq winds (cdr winds))))
+	window))
+  (defun hui:bottom-window ()
+    "Return a window that is at the bottom of the selected frame."
+    (let* ((winds (hypb:window-list 'no-mini))
+	   (bot-list (mapcar
+		      (function
+		       (lambda (wind)
+			 (nth 3 (window-edges wind))))
+		      winds))
+	   (bot (apply 'max bot-list)))
+      (nth (- (length winds) (length (memq bot bot-list))) winds))))
+
+(defun hui:menu-line (menu-alist)
+  "Returns a menu line string built from MENU-ALIST."
+  (let ((menu-prompt (concat (car (car menu-alist)) "  "))
+	(menu-items (mapconcat 'car (cdr menu-alist) "  "))
+	menu-line)
+    (setq menu-line (concat menu-prompt menu-items))
+    ;; Narrow menu by changing 2 spaces to 1 if too wide for current frame.
+    (if (>= (length menu-line) (1- (frame-width)))
+	(concat menu-prompt (mapconcat 'car (cdr menu-alist) " "))
+      menu-line)))
+
+;;; ************************************************************************
+;;; Private variables
+;;; ************************************************************************
+
+;; Hyperbole menu mode is suitable only for specially formatted data.
+(put 'hui:menu-mode 'mode-class 'special)
+
+(defvar hui:menu-mode-map nil
+  "Keymap containing hui:menu commands.")
+(if hui:menu-mode-map
+    nil
+  (setq hui:menu-mode-map (make-keymap))
+  (suppress-keymap hui:menu-mode-map)
+  (define-key hui:menu-mode-map hui:menu-quit   'hui:menu-enter)
+  (define-key hui:menu-mode-map hui:menu-abort  'hui:menu-enter)
+  (define-key hui:menu-mode-map hui:menu-top    'hui:menu-enter)
+  (define-key hui:menu-mode-map hui:menu-select 'hui:menu-enter)
+  ;;
+  ;; This next binding is necessary since the default button1 binding under
+  ;; XEmacs, mouse-track, is broken under XEmacs V19.8.
+  (and hyperb:lemacs-p window-system
+       (define-key hui:menu-mode-map 'button1 'mouse-set-point))
+  (let ((i 32))
+    (while (<= i 126)
+      (define-key hui:menu-mode-map (char-to-string i) 'hui:menu-enter)
+      (setq i (1+ i)))))
+
+(provide 'hui-mini)