home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / hyperbole / hui-menus.el < prev    next >
Encoding:
Text File  |  1995-08-29  |  18.5 KB  |  510 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         hui-menus.el
  4. ;; SUMMARY:      One line command menus for Hyperbole
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     hypermedia, mouse
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Brown U.
  10. ;;
  11. ;; ORIG-DATE:    15-Oct-91 at 20:13:17
  12. ;; LAST-MOD:     25-Aug-95 at 13:41:58 by Bob Weiner
  13. ;;
  14. ;; This file is part of Hyperbole.
  15. ;; Available for use and distribution under the same terms as GNU Emacs.
  16. ;;
  17. ;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
  18. ;; Developed with support from Motorola Inc.
  19. ;;
  20. ;; DESCRIPTION:  
  21. ;; DESCRIP-END.
  22.  
  23. ;;; ************************************************************************
  24. ;;; Other required Elisp libraries
  25. ;;; ************************************************************************
  26.  
  27. (require 'hypb)
  28.  
  29. ;;; ************************************************************************
  30. ;;; Public variables
  31. ;;; ************************************************************************
  32.  
  33. (defvar hui:menu-select "\C-m"
  34.   "*Upper case char-string which selects the Hyperbole menu item at point.")
  35. (defvar hui:menu-quit   "Q"
  36.   "*Upper case char-string which quits selecting from a Hyperbole menu item.")
  37. (defvar hui:menu-abort  "\C-g"
  38.   "*Same function as 'hui:menu-quit'.")
  39. (defvar hui:menu-top    "\C-t"
  40.   "*Character which returns to top Hyperbole menu.")
  41.  
  42. (defvar hui:menu-p nil
  43.   "Non-nil iff a current Hyperbole menu activation exists.")
  44.  
  45. (defvar hui:menus nil
  46.   "Command menus for use with the default Hyperbole user interface.")
  47. (setq
  48.  hui:menus
  49.  (delq nil
  50.  (list (cons
  51.     'hyperbole
  52.     (append
  53.      (let ((version (if (= (aref hyperb:version 0) ?0)
  54.                 (substring hyperb:version 1)
  55.               hyperb:version)))
  56.        (list (list (concat "Hy" version ">"))))
  57.      (delq nil
  58.            (list
  59.         '("Act"         hui:hbut-act
  60.           "Activates button at point or prompts for explicit button.")
  61.         '("Butfile/"    (menu . butfile)
  62.           "Quick access button files menus.")
  63.         '("Doc/"        (menu . doc)
  64.           "Quick access to Hyperbole documentation.")
  65.         '("Ebut/"       (menu . ebut)
  66.           "Explicit button commands.")
  67.         '("Gbut/"       (menu . gbut)
  68.           "Global button commands.")
  69.         '("Hist"        (hhist:remove current-prefix-arg)
  70.           "Jumps back to location prior to last Hyperbole button follow.")
  71.         '("Ibut/"       (menu . ibut)
  72.           "Implicit button and button type commands.")
  73.         '("Msg/"        (menu . msg)
  74.           "Mail and News messaging facilities.")
  75.         (if hyperb:kotl-p
  76.             '("Otl/"        (menu . otl)
  77.               "Autonumbered outlining and hyper-node facilities."))
  78.         '("Rolo/"       (menu . rolo)
  79.           "Hierarchical, multi-file rolodex lookup and edit commands.")
  80.         '("Win/"       (menu . win)
  81.           "Window configuration management command.")
  82.         ))))
  83.        '(butfile .
  84.      (("Butfile>")
  85.       ("DirFile"      (find-file hbmap:filename)
  86.        "Edits directory-specific button file.")
  87.       ("Info"
  88.        (hact 'link-to-Info-node "(hyperbole.info)Button Files")
  89.        "Displays manual section on button files.") 
  90.       ("PersonalFile" (find-file
  91.                 (expand-file-name hbmap:filename hbmap:dir-user))
  92.        "Edits user-specific button file.")
  93.       ))
  94.        '(doc .
  95.      (("Doc>")
  96.       ("Demo"         (find-file-read-only
  97.                 (expand-file-name "DEMO" hyperb:dir))
  98.        "Demonstrates Hyperbole features.")
  99.       ("Files"        (find-file-read-only
  100.                 (expand-file-name "MANIFEST" hyperb:dir))
  101.        "Summarizes Hyperbole system files.  Click on an entry to view it.")
  102.       ("Glossary"
  103.        (hact 'link-to-Info-node "(hyperbole.info)Glossary")
  104.        "Glossary of Hyperbole terms.")
  105.       ("HypbCopy"  (progn
  106.              (hact 'link-to-string-match "* Copyright" 2
  107.                    (expand-file-name "README" hyperb:dir))
  108.              (setq buffer-read-only nil)
  109.              (toggle-read-only))
  110.        "Displays general Hyperbole copyright and license details.")
  111.       ("Info"      (hact 'link-to-Info-node "(hyperbole.info)Top")
  112.        "Online Info version of Hyperbole manual.")
  113.       ("MailLists"    (progn
  114.                 (hact 'link-to-string-match "* Mail Lists" 2
  115.                   (expand-file-name "README" hyperb:dir))
  116.                 (setq buffer-read-only nil)
  117.                 (toggle-read-only))
  118.        "Details on Hyperbole mail list subscriptions.")
  119.       ("New"          (progn
  120.                 (hact 'link-to-string-match "* What's New" 2
  121.                   (expand-file-name "README" hyperb:dir))
  122.                 (setq buffer-read-only nil)
  123.                 (toggle-read-only))
  124.        "Recent changes to Hyperbole.")
  125.       ("SmartKy"      (find-file-read-only (hypb:mouse-help-file))
  126.        "Summarizes Smart Key mouse or keyboard handling.")
  127.       ("Types/"       (menu . types)
  128.        "Provides documentation on Hyperbole types.")
  129.      ))
  130.        '(ebut .
  131.      (("EButton>")
  132.       ("Act"    hui:hbut-act
  133.         "Activates button at point or prompts for explicit button.")
  134.       ("Create" hui:ebut-create)
  135.       ("Delete" hui:ebut-delete)
  136.       ("Edit"   hui:ebut-modify "Modifies any desired button attributes.")
  137.       ("Help/"  (menu . ebut-help) "Summarizes button attributes.")
  138.       ("Info"
  139.        (hact 'link-to-Info-node "(hyperbole.info)Explicit Buttons")
  140.        "Displays manual section on explicit buttons.")
  141.       ("Modify" hui:ebut-modify "Modifies any desired button attributes.")
  142.       ("Rename" hui:ebut-rename "Relabels an explicit button.")
  143.       ("Search" hui:ebut-search
  144.        "Locates and displays personally created buttons in context.")
  145.       ))
  146.        '(ebut-help .
  147.      (("Help on>")
  148.       ("BufferButs"   (hui:hbut-report -1)
  149.        "Summarizes all explicit buttons in buffer.")
  150.       ("CurrentBut"   (hui:hbut-report)
  151.        "Summarizes only current button in buffer.")
  152.       ("OrderedButs"  (hui:hbut-report 1)
  153.        "Summarizes explicit buttons in lexicographically order.")
  154.       ))
  155.        '(gbut .
  156.      (("GButton>")
  157.       ("Act"    gbut:act        "Activates global button by name.") 
  158.       ("Create" hui:gbut-create "Adds a global button to gbut:file.")
  159.       ("Edit"   hui:gbut-modify "Modifies global button attributes.")
  160.       ("Help"   gbut:help       "Reports on a global button by name.") 
  161.       ("Info"   (hact 'link-to-Info-node "(hyperbole.info)Global Buttons")
  162.        "Displays manual section on global buttons.")
  163.       ("Modify" hui:gbut-modify "Modifies global button attributes.")
  164.       ))
  165.        '(ibut .
  166.      (("IButton>")
  167.       ("Act"    hui:hbut-act    "Activates implicit button at point.") 
  168.       ("DeleteIButType"   (hui:htype-delete 'ibtypes)
  169.        "Deletes specified button type.")
  170.       ("Help"   hui:hbut-help   "Reports on button's attributes.")
  171.       ("Info"   (hact 'link-to-Info-node
  172.               "(hyperbole.info)Implicit Buttons and Types")
  173.        "Displays manual section on implicit buttons.")
  174.       ("Types"  (hui:htype-help 'ibtypes 'no-sort)
  175.        "Displays documentation for one or all implicit button types.")
  176.       ))
  177.        '(msg .
  178.      (("Msg>")
  179.       ("Compose-Hypb-Mail"
  180.        (hmail:compose "hyperbole@hub.ucsb.edu" '(hact 'hyp-config))
  181.        "Send a message to the Hyperbole discussion list.")
  182.       ("Edit-Hypb-List-Entry"
  183.        (hmail:compose "hyperbole-request@hub.ucsb.edu"
  184.               '(hact 'hyp-request))
  185.        "Add, remove or change your entry on a hyperbole mail list.")
  186.       ("Modify-Hypb-Announce-Entry"
  187.        (hmail:compose "hyperbole-announce-request@hub.ucsb.edu"
  188.               '(hact 'hyp-request))
  189.        "Add, remove or change your entry on a hyperbole mail list.")
  190.       ))
  191.        (if hyperb:kotl-p
  192.        '(otl
  193.          . (("Otl>")
  194.         ("All"       kotl-mode:show-all "Expand all collapsed cells.") 
  195.         ("Below"     kotl-mode:hide-sublevels
  196.          "Hide all cells in outline deeper than a particular level.")
  197.         ("Create"    kfile:find   "Create or edit an outline file.")
  198.         ("Example"   (find-file-read-only
  199.                   (expand-file-name
  200.                    "EXAMPLE.kotl" (concat hyperb:dir "kotl/")))
  201.          "Display a self-descriptive example outline file.")
  202.         ("Hide"      (progn (kotl-mode:is-p)
  203.                     (kotl-mode:hide-tree (kcell-view:label)))
  204.          "Collapse tree rooted at point.")
  205.         ("Info"
  206.          (hact 'link-to-Info-node "(hyperbole.info)Outliner")
  207.          "Display manual section on Hyperbole outliner.")
  208.         ("Kill"      kotl-mode:kill-tree
  209.          "Kill ARG following trees starting from point.")
  210.         ("Link"      klink:create
  211.          "Create and insert an implicit link at point.")
  212.         ("Overview"  kotl-mode:overview
  213.          "Show first line of each cell.")
  214.         ("Show"      (progn (kotl-mode:is-p)
  215.                     (kotl-mode:show-tree (kcell-view:label)))
  216.          "Expand tree rooted at point.")
  217.         ("Top"       kotl-mode:top-cells
  218.          "Hide all but top-level cells.") 
  219.         ("View"      kfile:view
  220.          "View an outline file in read-only mode.")
  221.         )))
  222.        '(rolo .
  223.      (("Rolo>")
  224.       ("Add"              rolo-add      "Add a new rolo entry.")
  225.       ("Display"          rolo-display-matches
  226.        "Display last found rolodex matches again.")
  227.       ("Edit"             rolo-edit   "Edit an existing rolo entry.")
  228.       ("Info"   (hact 'link-to-Info-node "(hyperbole.info)Rolodex")
  229.        "Displays manual section on Hyperbole rolodex.")
  230.       ("Kill"             rolo-kill   "Kill an existing rolo entry.")
  231.       ("Order"            rolo-sort   "Order rolo entries in a file.")
  232.       ("RegexFind"        rolo-grep   "Find entries containing a regexp.")
  233.       ("StringFind"       rolo-fgrep  "Find entries containing a string.")
  234.       ("WordFind"         rolo-word   "Find entries containing words.")
  235.       ("Yank"             rolo-yank
  236.        "Find an entry containing a string and insert it at point.")
  237.       ))
  238.        '(types .
  239.      (("Types>")
  240.       ("ActionTypes"      (hui:htype-help   'actypes)
  241.        "Displays documentation for one or all action types.")
  242.       ("IButTypes"        (hui:htype-help   'ibtypes 'no-sort)
  243.        "Displays documentation for one or all implicit button types.")
  244.       ))
  245.        '(win .
  246.      (("WinConfig>")
  247.       ("AddName"        wconfig-add-by-name
  248.        "Name current window configuration.")
  249.       ("DeleteName"     wconfig-delete-by-name
  250.        "Delete named window configuration.")
  251.       ("RestoreName"    wconfig-restore-by-name
  252.        "Restore frame to window configuration given by name.")
  253.       ("PopRing"        wconfig-delete-pop
  254.        "Restores window configuration from ring and removes it from ring.")
  255.       ("SaveRing"       wconfig-ring-save
  256.        "Saves current window configuration to ring.")
  257.       ("YankRing"       wconfig-yank-pop
  258.        "Restores next window configuration from ring.")
  259.       ))
  260.        )))
  261.  
  262. ;;; ************************************************************************
  263. ;;; Public functions
  264. ;;; ************************************************************************
  265.  
  266. ;;; Old name
  267. (fset 'hui:menu 'hyperbole)
  268.  
  269. ;;; Used as autoloaded main entry point to Hyperbole.
  270. ;;; It brings up a menu of commands. 
  271. (defun hyperbole (&optional menu menu-list)
  272.   "Invokes default Hyperbole menu user interface when not already active.
  273. Suitable for binding to a key, e.g. {C-h h}.
  274. Non-interactively, returns t if menu is actually invoked by call, else nil.
  275.  
  276. Two optional arguments may be given to invoke alternative menus.
  277. MENU (a symbol) specifies the menu to invoke from MENU-LIST, (a
  278. Hyperbole menu list structure).  MENU defaults to 'hyperbole and MENU-LIST
  279. to `hui:menus'.  See `hui:menus' definition for the format of the menu list
  280. structure."
  281.  
  282.   (interactive)
  283.   (if (and hui:menu-p (> (minibuffer-depth) 0))
  284.       (progn (beep) nil)
  285.     (unwind-protect
  286.     (progn
  287.       (require 'hsite) ;; Since "hui-menus" may be loaded without loading
  288.                ;; all of Hyperbole.
  289.       (hyperb:init-menubar)
  290.       (setq hui:menu-p t)
  291.       (hui:menu-act (or menu 'hyperbole) menu-list)
  292.       t)
  293.       (setq hui:menu-p nil))))
  294.  
  295. (defun hui:menu-act (menu &optional menu-list)
  296.   "Prompts user with Hyperbole MENU (a symbol) and performs selected item.
  297. Optional second argument MENU-LIST is a Hyperbole menu list structure from
  298. which to extract MENU.  It defaults to `hui:menus'.  See its definition for
  299. the menu list structure." 
  300.   (let ((set-menu '(or (and menu (symbolp menu)
  301.                 (setq menu-alist
  302.                   (cdr (assq menu (or menu-list hui:menus)))))
  303.                (hypb:error "(menu-act): Invalid menu symbol arg: %s"
  304.                   menu)))
  305.     (show-menu t)
  306.     (rtn)
  307.     menu-alist act-form)
  308.     (while (and show-menu (eval set-menu))
  309.       (cond ((and (consp (setq act-form (hui:menu-select menu-alist)))
  310.           (cdr act-form)
  311.           (symbolp (cdr act-form)))
  312.          ;; Display another menu
  313.          (setq menu (cdr act-form)))
  314.         (act-form
  315.          (let ((prefix-arg current-prefix-arg))
  316.            (cond ((symbolp act-form)
  317.               (if (eq act-form t)
  318.               nil
  319.             (setq show-menu nil
  320.                   rtn (call-interactively act-form))))
  321.              ((stringp act-form)
  322.               (hui:menu-help act-form)
  323.               ;; Loop and show menu again.
  324.               )
  325.              (t (setq show-menu nil
  326.                   rtn (eval act-form))))))
  327.         (t (setq show-menu nil))))
  328.     rtn))
  329.  
  330. (defun hui:menu-enter (&optional char-str)
  331.   "Uses CHAR-STR or last input character as minibuffer argument."
  332.   (interactive)
  333.   (let ((input (or char-str (aref (recent-keys) (1- (length (recent-keys)))))))
  334.     (cond (hyperb:emacs19-p
  335.        (and (not (integerp input))
  336.         (eventp input)
  337.         (setq input (event-basic-type input))))
  338.       (hyperb:lemacs-p
  339.        (if (eventp input)
  340.            (setq input (event-to-character input)))))
  341.     (if (or (symbolp input)
  342.         (and (integerp input)
  343.          (= input ?\r)))
  344.     (setq input (hargs:at-p)))
  345.     (erase-buffer)
  346.     (or (symbolp input) (insert input)))
  347.   (exit-minibuffer))
  348.  
  349. (defun hui:menu-help (help-str)
  350.   "Displays HELP-STR in a small window.  HELP-STR must be a string."
  351.   (let* ((window-min-height 2)
  352.      (owind (selected-window))
  353.      (buf-name (hypb:help-buf-name "Menu")))
  354.     (unwind-protect
  355.     (progn
  356.       (save-window-excursion
  357.         (hkey-help-show buf-name)) ;; Needed to save wconfig.
  358.       (if (eq (selected-window) (minibuffer-window))
  359.           (other-window 1))
  360.       (if (= (length (hypb:window-list 'no-mini)) 1)
  361.           (split-window-vertically nil))
  362.       (select-window (hui:bottom-window))
  363.       (switch-to-buffer (get-buffer-create buf-name))
  364.       (setq buffer-read-only nil)
  365.       (erase-buffer)
  366.       (insert "\n" help-str)
  367.       (set-buffer-modified-p nil)
  368.       (shrink-window
  369.        (- (window-height)
  370.           (+ 3 (length
  371.             (delq nil
  372.               (mapcar (function
  373.                    (lambda (chr) (= chr ?\n)))
  374.                   help-str)))))))
  375.       (select-window owind))))
  376.  
  377. (defun hui:menu-xemacs (&optional menu menu-list)
  378.   "Returns an XEmacs menu built from Hyperbole type menus.
  379. Optional MENU (a symbol) specifies a specific submenu of optional MENU-LIST.
  380. a Hyperbole menu list structure.  Otherwise, all menus are used.
  381. MENU defaults to 'hyperbole and MENU-LIST to `hui:menus'.  See `hui:menus'
  382. definition for the format of the menu list structure."
  383.   (mapcar
  384.    (function 
  385.     (lambda (entry)
  386.       (or (consp entry) 
  387.       (error "(hui:menu-xemacs): Invalid menu entry: %s" entry))
  388.       (let ((label (car entry))
  389.         (content (car (cdr entry))))
  390.     (cond ((null content) (hypb:replace-match-string ">$" label "" t))
  391.           ((and (consp content) (eq (car content) 'menu))
  392.            (hui:menu-xemacs (cdr content)))
  393.           (t (vector label content 't))))))
  394.    (cdr (assq (or menu 'hyperbole) (or menu-list hui:menus)))))
  395.  
  396. (defun hui:menu-select (menu-alist)
  397.   "Prompts user to choose the first character of any item from MENU-ALIST.
  398. Case is not significant.  If chosen by direct selection with the Assist Key,
  399. returns any help string for item, else returns the action form for the item."
  400.   (let* ((menu-line (hui:menu-line menu-alist))
  401.      (set:equal-op 'eq)
  402.      (select-char (string-to-char hui:menu-select))
  403.      (quit-char (string-to-char hui:menu-quit))
  404.      (abort-char (string-to-char hui:menu-abort))
  405.      (top-char  (string-to-char hui:menu-top))
  406.      (item-keys (mapcar (function
  407.                  (lambda (item) (aref item 0)))
  408.                 (mapcar 'car (cdr menu-alist))))
  409.      (keys (apply 'list select-char quit-char abort-char
  410.               top-char item-keys))
  411.      (key 0)
  412.      (hargs:reading-p 'hmenu)
  413.      sublist)
  414.     (while (not (memq (setq key (upcase
  415.                  (string-to-char
  416.                   (read-from-minibuffer
  417.                    "" menu-line hui:menu-mode-map))))
  418.               keys))
  419.       (beep)
  420.       (setq hargs:reading-p 'hmenu)
  421.       (discard-input))
  422.     (cond ((eq key quit-char) nil)
  423.       ((eq key abort-char) (beep) nil)
  424.       ((eq key top-char) '(menu . hyperbole))
  425.       ((and (eq key select-char)
  426.         (save-excursion
  427.           (if (search-backward " " nil t)
  428.               (progn (skip-chars-forward " ")
  429.                  (setq key (following-char))
  430.                  nil)  ;; Drop through.
  431.             t))))
  432.       (t (if (setq sublist (memq key item-keys))
  433.          (let* ((label-act-help-list
  434.              (nth (- (1+ (length item-keys)) (length sublist))
  435.                   menu-alist))
  436.             (act-form (car (cdr label-act-help-list))))
  437.            (if (eq hargs:reading-p 'hmenu-help)
  438.                (let ((help-str
  439.                   (or (car (cdr (cdr label-act-help-list)))
  440.                   "No help documentation for this item.")))
  441.              (concat (car label-act-help-list) "\n  "
  442.                  help-str "\n    Action: "
  443.                  (prin1-to-string act-form)))
  444.              act-form)))))))
  445.  
  446. ;;; ************************************************************************
  447. ;;; Private functions
  448. ;;; ************************************************************************
  449.  
  450. (if (fboundp 'window-lowest-p)
  451.     (defun hui:bottom-window ()
  452.       "Return a window that is at the bottom of the selected frame."
  453.       (let ((winds (hypb:window-list 'no-mini))
  454.         (window))
  455.     (while (and (not window) winds)
  456.       (if (window-lowest-p (car winds))
  457.           (setq window (car winds))
  458.         (setq winds (cdr winds))))
  459.     window))
  460.   (defun hui:bottom-window ()
  461.     "Return a window that is at the bottom of the selected frame."
  462.     (let* ((winds (hypb:window-list 'no-mini))
  463.        (bot-list (mapcar
  464.               (function
  465.                (lambda (wind)
  466.              (nth 3 (window-edges wind))))
  467.               winds))
  468.        (bot (apply 'max bot-list)))
  469.       (nth (- (length winds) (length (memq bot bot-list))) winds))))
  470.  
  471. (defun hui:menu-line (menu-alist)
  472.   "Returns a menu line string built from MENU-ALIST."
  473.   (let ((menu-prompt (concat (car (car menu-alist)) "  "))
  474.     (menu-items (mapconcat 'car (cdr menu-alist) "  "))
  475.     menu-line)
  476.     (setq menu-line (concat menu-prompt menu-items))
  477.     ;; Narrow menu by changing 2 spaces to 1 if too wide for current frame.
  478.     (if (>= (length menu-line) (1- (frame-width)))
  479.     (concat menu-prompt (mapconcat 'car (cdr menu-alist) " "))
  480.       menu-line)))
  481.  
  482. ;;; ************************************************************************
  483. ;;; Private variables
  484. ;;; ************************************************************************
  485.  
  486. ;; Hyperbole menu mode is suitable only for specially formatted data.
  487. (put 'hui:menu-mode 'mode-class 'special)
  488.  
  489. (defvar hui:menu-mode-map nil
  490.   "Keymap containing hui:menu commands.")
  491. (if hui:menu-mode-map
  492.     nil
  493.   (setq hui:menu-mode-map (make-keymap))
  494.   (suppress-keymap hui:menu-mode-map)
  495.   (define-key hui:menu-mode-map hui:menu-quit   'hui:menu-enter)
  496.   (define-key hui:menu-mode-map hui:menu-abort  'hui:menu-enter)
  497.   (define-key hui:menu-mode-map hui:menu-top    'hui:menu-enter)
  498.   (define-key hui:menu-mode-map hui:menu-select 'hui:menu-enter)
  499.   ;;
  500.   ;; This next binding is necessary since the default button1 binding under
  501.   ;; XEmacs, mouse-track, is broken under XEmacs V19.8.
  502.   (and hyperb:lemacs-p window-system
  503.        (define-key hui:menu-mode-map 'button1 'mouse-set-point))
  504.   (let ((i 32))
  505.     (while (<= i 126)
  506.       (define-key hui:menu-mode-map (char-to-string i) 'hui:menu-enter)
  507.       (setq i (1+ i)))))
  508.  
  509. (provide 'hui-menus)
  510.