NetNews Usenet Archive 1992 #16/NN_1992_16.iso/spool/alt/lucidem/help/135

Text File | 1992-07-26 | 19.8 KB | 533 lines

Path: sparky!uunet!mcsun!corton!loria!news.loria.fr!bosch
From: [e-mail] (Guido Bosch)
Newsgroups: alt.lucid-emacs.help
Subject: Re: patches for Hyperbole to run on lemacs19.2
Message-ID: <[e-mail]>
Date: 27 Jul 92 01:15:13 GMT
Sender: [e-mail]
Distribution: alt
Organization: INRIA-Lorraine / CRIN, Nancy, France
Lines: 521

In article <[e-mail]> [e-mail] (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 "[e-mail]")
                    (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 "[e-mail]")
                         (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 "[e-mail]")
            (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 "[e-mail]")
                 (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.: [phone]
Fax.: [phone]
email: [e-mail]