From: bosch@loria.fr (Guido Bosch)
Newsgroups: alt.lucid-emacs.help
Subject: Re: patches for Hyperbole to run on lemacs19.2
Date: 27 Jul 92 01:15:13 GMT
Distribution: alt
Organization: INRIA-Lorraine / CRIN, Nancy, France

In article <9207241926.AA02186@gateway.bnr.ca> JSPARKES%BNR.CA@lucid.com (J.D.) writes:

 >   Hi, I've made Hyperbole work under Lucid emacs 19.2, and I'd like some
 >   brave beta testers. :-).  Actually, everything seems to work fine,
 >   with just one problem:
 >
 >   KNOWN BUG/PROBLEMS
 >
 >   1. sm-mouse-toggle-bindings (commonly bound to C-ct) does not preserve
 >      mode specific bindings because it only records the "default"
 >      bindings once.  Any advice on what to do for this is welcome.  (I
 >      find it annoying that I can't use the popup menu in Info-mode.)
 >

The problem is a more general one, after my opinon: For Emacs 19, the
Hyperbole user interface should be modified taking advantage of the
new features:

	- The user interface menu (`hui::menu') should be implemented 
	  as a popup-menu, accessable in the menu bar (I already
	  hacked it around, it was rather straightforward, see at the
	  end of this mailing).

	- The smart-key stuff should be bound to buttons with
	  modifiers (shift/control/meta/...). At least button3 has to
	  be kept free for mode specific menus. This is because
	  Emacses running under X11 come with a lot of packages that
	  do their own (maybe mode local) mouse handling.

	  Another solution would be to intergrate Hyperbole as an
	  essential part of Emacs 19's user interface and to use it
	  for all kind of hypertext like mouse actions. This is maybe a
	  better, but also a more expensive solution. 

	  For the moment, I use the following key bindings for
	  Hyperbole, and this also solves your problem with the info
	  menu. (I use the Control Shift modifier for smart keys,
	  because there are few chances that other packages could use
	  this also)
	  	  
	(cond ((string-match "Lucid" (emacs-version))
	   (defun le:mouse-set-point()
	     (mouse-set-point (copy-event last-input-event)))
	   (setq mouse-set-point-command 'le:mouse-set-point)
	   (global-set-key '(control shift button2) 'sm-depress)
	   (global-set-key '(control shift button2up) 'smart-key-mouse)
	   (global-set-key '(control shift button2) 'sm-depress-meta)
	   (global-set-key '(control shift button3up) 'smart-key-mouse-meta))

	  
Another point for the TODO list: 

	- Highlighting extents for explicit (and maybe implicit) buttons
	  

-- Guido

------------------------------ hui-menu.el ------------------------------
;;!emacs
;; $Id: hui-menus.el,v 1.2 1992/05/14 10:12:25 rsw Exp $
;;
;; FILE:         hui-menus.el
;; SUMMARY:      One line command menus for Hyperbole
;; USAGE:        GNU Emacs Lisp Library
;;
;; AUTHOR:       Bob Weiner
;; ORG:          Brown U.
;;
;; ORIG-DATE:    15-Oct-91 at 20:13:17
;; LAST-MOD:     25-Feb-92 at 06:08:14 by Bob Weiner
;;
;; This file is part of Hyperbole.
;; 
;; Copyright (C) 1991, 1992  Brown University, Providence, RI
;; Developed with support from Motorola Inc.
;; 
;; Permission to use, modify and redistribute this software and its
;; documentation for any purpose other than its incorporation into a
;; commercial product is hereby granted without fee.  A distribution fee
;; may be charged with any redistribution.  Any distribution requires
;; that the above copyright notice appear in all copies, that both that
;; copyright notice and this permission notice appear in supporting
;; documentation, and that neither the name of Brown University nor the
;; author's name be used in advertising or publicity pertaining to
;; distribution of the software without specific, written prior permission.
;; 
;; Brown University makes no representations about the suitability of this
;; software for any purpose.  It is provided "as is" without express or
;; implied warranty.
;;
;;
;; DESCRIPTION:  
;; DESCRIP-END.

;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************

(require 'hui)

;;; ************************************************************************
;;; Public variables
;;; ************************************************************************

(defvar hui:menu-select "\C-m"
  "*Upper case char-string which select Hyperbole menu item at point.")
(defvar hui:menu-quit   "Q"
  "*Upper case char-string which quits from selecting 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.")


(defvar hui:lucid-p (string-match "Lucid" emacs-version))

(setq hui:menus
      (if hui:lucid-p
	  ;; Lucid Emacs popup menus
	  '("Hyperbole"
	    ["Action" hui:hbut-act t]
	    ("Button File"
	     ["Directory File" (find-file hbmap:filename) t]
	     ["Personal File" (find-file (concat hbmap:dir-user hbmap:filename)) t])
	    ("Documentation"
	     ["Demo" (find-file-read-only (concat hyperb:dir "DEMO")) t]
	     ["Files" (find-file (concat hyperb:dir "MANIFEST")) t]
	     ["Glossary" (progn
			   (or (featurep 'info)
			       (progn (load "info") (provide 'info)))
			   (hact 'link-to-Info-node "(hypb.info)Glossary")) t]
	     ["Copyright" (hact 'link-to-string-match "* Copyright" 2
			       (concat hyperb:dir "README")) t]
	     ["Info Manual" (progn (or (featurep 'info)
				      (progn (load "info") (provide 'info)))
				  (hact 'link-to-Info-node "(hypb.info)")) t]
	     ["Mailing Lists" (hact 'link-to-string-match "* Mail Lists" 2
				(concat hyperb:dir "README")) t]
	     ["News" (hact 'link-to-string-match "* What's New" 2
			  (concat hyperb:dir "README")) t]
	     ["Smart Key" (find-file (concat hyperb:dir "hmouse-doc")) t])
	    ("Explicit Buttons"
	     ["Action" hui:hbut-act t]
	     ["Create"hui:ebut-create t]
	     ["Delete" hui:ebut-delete t]
	     ["Edit" hui:ebut-modify t]
	     ("Help"
	      ["Buffer Buttons" (hui:hbut-report -1) t]
	      ["Current Button" (hui:hbut-report) t]
	      ["Ordered Buttons" (hui:hbut-report 1) t])
	     ["Modify" hui:ebut-modify t]
	     ["Rename" hui:ebut-rename t]
	     ["Search" hui:ebut-search t])
	    ("Global] Buttons"
	     ["Action" gbut:act t]
	     ["Create" hui:gbut-create t]
	     ["Help" gbut:help t])
	    ["History" (hhist:remove current-prefix-arg) t]
	    ("Implicit Buttons"
	     ["Action" hui:hbut-act t]
	     ["Help" hui:hbut-help t]
	     ["Types" (hui:htype-help 'ibtypes 'no-sort) t])
	    ("Messages"
	     ["Compose Hyperbole Mail" (progn
				    (mail) (insert "hyperbole@cs.brown.edu")
				    (forward-line 1) (end-of-line)
				    (save-excursion
				      (insert
				       "Use a full *sentence* here.  Make a statement or ask a question."))
				    (hact 'hyp-config)
				    (message "Edit and then mail.")) t]
	     ["Edit Hypebol Mailing List Entry" (progn (mail) (insert "hyperbole-request@cs.brown.edu")
						 (forward-line 1) (end-of-line)
						 (hact 'hyp-request)
						 (message "Edit and then mail.")) t])
	    ("Rolodex"
	     ["Add" rolo-add t]
	     ["Display-again" rolo-display-matches t]
	     ["Edit" rolo-edit t]
	     ["Kill" rolo-kill t]
	     ["Order" rolo-sort t]
	     ["Regexp-find" rolo-grep t]
	     ["String-find" rolo-fgrep t]
	     ["Yank" rolo-yank t])

	    ("Types"
	     ["Action Types" (hui:htype-help   'actypes) t]
	     ["Delete Implicit Button Type" (hui:htype-delete 'ibtypes) t]
	     ["Doc on Implicit Button Types" (hui:htype-help   'ibtypes 'no-sort) t]))

	;; Hyperbol hui menus
	(list (cons
	       'hyperbole
	       (append
		(list (list (concat "Hypb" hyperb:version ">")))
		'(("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.")
		  ("Rolo/"       (progn (or (fboundp 'rolo-kill) (require 'wrolo))
					(hui:menu-act 'rolo))
		   "Hierarchical, multi-file rolodex lookup and edit commands.")
		  ("Types/"      (menu . types)
		   "Provides documentation on Hyperbole types.")
		  )))
	      '(butfile .
			(("ButFile>")
			 ("DirFile"      (find-file hbmap:filename)
			  "Edits directory-specific button file.")
			 ("PersonalFile" (find-file (concat hbmap:dir-user hbmap:filename))
			  "Edits user-specific button file.")
			 ))
	      '(doc .
		    (("Doc>")
		     ("Demo"         (find-file-read-only (concat hyperb:dir "DEMO"))
		      "Demonstrates Hyperbole features.")
		     ("Files"        (find-file (concat hyperb:dir "MANIFEST"))
		      "Summarizes Hyperbole system files.  Click on an entry to view it.")
		     ("Glossary"     (progn
				       (or (featurep 'info)
					   (progn (load "info") (provide 'info)))
				       (hact 'link-to-Info-node "(hypb.info)Glossary"))
		      "Glossary of Hyperbole terms.")
		     ("HypbCopy"  (hact 'link-to-string-match "* Copyright" 2
					(concat hyperb:dir "README"))
		      "Displays general Hyperbole copyright and license details.")
		     ("InfoManual"   (progn (or (featurep 'info)
						(progn (load "info") (provide 'info)))
					    (hact 'link-to-Info-node "(hypb.info)"))
		      "Online Info version of Hyperbole manual.")
		     ("MailLists"    (hact 'link-to-string-match "* Mail Lists" 2
					   (concat hyperb:dir "README"))
		      "Details on Hyperbole mail list subscriptions.")
		     ("New"          (hact 'link-to-string-match "* What's New" 2
					   (concat hyperb:dir "README"))
		      "Recent changes to Hyperbole.")
		     ("SmartKy"      (find-file (concat hyperb:dir "hmouse-doc"))
		      "Summarizes Smart Key mouse or keyboard handling.")
		     ))
	      '(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.")
		      ("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.")
		      ("Help"   gbut:help       "Reports on a global button by name.") 
		      ))
	      '(ibut .
		     (("IButton>")
		      ("Act"    hui:hbut-act    "Activates implicit button at point.") 
		      ("Help"   hui:hbut-help   "Reports on button's attributes.")
		      ("Types"  (hui:htype-help 'ibtypes 'no-sort)
		       "Displays documentation for one or all implicit button types.")
		      ))
	      '(msg .
		    (("Msg>")
		     ("Compose-Hypb-Mail"
		      (progn
			(mail) (insert "hyperbole@cs.brown.edu")
			(forward-line 1) (end-of-line)
			(save-excursion
			  (insert
			   "Use a full *sentence* here.  Make a statement or ask a question."))
			(hact 'hyp-config)
			(message "Edit and then mail."))
		      "Send a message to the Hyperbole discussion list.")
		     ("Edit-Hypb-Mail-List-Entry"
		      (progn (mail) (insert "hyperbole-request@cs.brown.edu")
			     (forward-line 1) (end-of-line)
			     (hact 'hyp-request)
			     (message "Edit and then mail."))
		      "Add, remove or change your entry on a hyperbole mail list.")
		     ))
	      '(rolo .
		     (("Rolo>")
		      ("Add"              rolo-add	  "Add a new rolo entry.")
		      ("Display-again"    rolo-display-matches
		       "Display last found rolodex matches again.")
		      ("Edit"             rolo-edit   "Edit an existing rolo entry.")
		      ("Kill"             rolo-kill   "Kill an existing rolo entry.")
		      ("Order"            rolo-sort   "Order rolo entries in a file.")
		      ("Regexp-find"      rolo-grep   "Find entries containing a regexp.")
		      ("String-find"      rolo-fgrep  "Find entries containing a string.")
		      ("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.")
		       ("DeleteIButType"   (hui:htype-delete 'ibtypes)
			"Deletes specified button type.")
		       ("IButTypes"        (hui:htype-help   'ibtypes 'no-sort)
			"Displays documentation for one or all implicit button types.")
		       )))))

(if hui:lucid-p
    (let ((menubar-rest default-menubar))
      (if;; There  is already a hyperbole menu
	  (setq menubar-rest (assoc (car hui:menus) default-menubar))
	  ;; update the existing one
	  (rplacd menubar-rest (cdr hui:menus))
	;; otherwise append append destructively the hui:menu
	(nconc default-menubar (list hui:menus)))
      ;; Redisplay
      (set-screen-menubar default-menubar)))


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

(defun hui:menu ()
  "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."
  (interactive)
  (if hui:lucid-p
      (popup-menu hui:menus)
    (condition-case ()
	(if hui:menu-p
	    nil
	  (setq hui:menu-p t)
	  (hui:menu-act 'hyperbole)
	  (setq hui:menu-p nil)
	  t)
      (quit (setq hui:menu-p nil))
      (error (setq hui:menu-p nil)))))

(defun hui:menu-act (menu)
  "Prompts user with Hyperbole MENU (a symbol) and performs selected item."
  (let ((set-menu '(or (and menu (symbolp menu)
			    (setq menu-alist (cdr (assq menu hui:menus))))
		       (error "(hui: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)
  (erase-buffer)
  (insert (or char-str (substring (recent-keys) -1)))
  (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
	    (smart-key-help-show buf-name)) ;; Needed to save screen config.
	  (if (eq (selected-window) (minibuffer-window))
	      (other-window 1))
	  (if (= (length (hypb:window-list 'no-mini)) 1)
	      (split-window-vertically nil))
	  (let* ((winds (hypb:window-list 'no-mini))
		 (bot-list (mapcar
			    '(lambda (wind)
			       (nth 3 (window-edges wind))) winds))
		 (bot (apply 'max bot-list)))
	    (select-window
	     (nth (- (length winds) (length (memq bot bot-list))) winds)))
	  (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 '(lambda (chr) (= chr ?\n)) help-str)))))))
      (select-window owind))))

(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 secondary
Smart Key, returns any help string for item, else returns the action form for
the item."
  (let* ((menu-prompt (concat (car (car menu-alist)) "  "))
	 (menu-items (mapconcat 'car (cdr 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 '(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
				   "" (concat menu-prompt menu-items)
				   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 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)
  (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-menus)
--
Guido BOSCH, INRIA-Lorraine/CRIN
Institut National de Recherche en Informatique et en Automatique (INRIA)
Centre de Recherche en Informatique de Nancy (CRIN)
Campus scientifique, B.P. 239            
54506 Vandoeuvre-les-Nancy CEDEX       	
Tel.: (+33) 83.91.24.24
Fax.: (+33) 83.41.30.79                	
email: bosch@loria.fr             	
Newsgroups: alt.lucid-emacs.help
Date: Sat, 11 Jul 92 22:16:46 EDT
From: bcotton@sergei.mitre.org (Robert T. Cotton)
Subject: Trying to write x-find-file.