;;; hui-menu.el --- Menubar menu of GNU Hyperbole commands -*- lexical-binding: t; -*- ;; ;; Author: Bob Weiner ;; ;; Orig-Date: 28-Oct-94 at 10:59:44 ;; Last-Mod: 19-Jun-23 at 13:28:35 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; ;; Copyright (C) 1994-2021 Free Software Foundation, Inc. ;; See the "HY-COPY" file for license information. ;; ;; This file is part of GNU Hyperbole. ;;; Commentary: ;;; Code: ;;; ************************************************************************ ;;; Other required Elisp libraries ;;; ************************************************************************ (eval-and-compile (mapc #'require '(hpath hui-jmenu hyrolo-menu browse-url easymenu))) ;;; ************************************************************************ ;;; Private functions ;;; ************************************************************************ (defmacro hui-menu-browser (title browser-option) `(list (list ,title ["Chrome (Google)" (setq ,browser-option #'browse-url-chrome) :style radio :selected (eq ,browser-option #'browse-url-chrome)] ["Chromium" (setq ,browser-option #'browse-url-chromium) :style radio :selected (eq ,browser-option #'browse-url-chromium)] ["Default (System wide)" (setq ,browser-option #'browse-url-default-browser) :style radio :selected (eq ,browser-option #'browse-url-default-browser)] ["EWW (Emacs)" (setq ,browser-option #'eww-browse-url) :style radio :selected (eq ,browser-option #'eww-browse-url)] ;; Whatever browse-url-text-browser is set to, default is Lynx ["Emacs Text Browser" (setq ,browser-option #'browse-url-text-emacs) :style radio :selected (eq ,browser-option #'browse-url-text-emacs)] ["Firefox" (setq ,browser-option #'browse-url-firefox) :style radio :selected (eq ,browser-option #'browse-url-firefox)] ["KDE" (setq ,browser-option #'browse-url-kde) :style radio :selected (eq ,browser-option #'browse-url-kde)] ["XTerm Text Browser" (setq ,browser-option #'browse-url-text-xterm) :style radio :selected (eq ,browser-option #'browse-text-xterm)] "----" ["Toggle-URLs-in-New-Window" (setq browse-url-new-window-flag (not browse-url-new-window-flag)) :style toggle :selected browse-url-new-window-flag]))) ;; List explicit buttons in the current buffer for menu activation. (defun hui-menu-explicit-buttons (rest-of-menu) (delq nil (append '(["Manual" (id-info "(hyperbole)Explicit Buttons") t] "----") (let ((labels (ebut:list)) (cutoff)) (if labels (progn ;; Cutoff list if too long. (if (setq cutoff (nthcdr (1- hui-menu-max-list-length) labels)) (setcdr cutoff nil)) (delq nil (append '("----" ["Alphabetize-List" (setq hui-menu-order-explicit-buttons (not hui-menu-order-explicit-buttons)) :style toggle :selected hui-menu-order-explicit-buttons] "Activate:") (mapcar (lambda (label) (vector label `(ebut:act ,label) t)) (if hui-menu-order-explicit-buttons (sort labels #'string-lessp) labels)) (if cutoff '(". . .")) '("----" "----")))))) rest-of-menu))) (defun hui-menu-cutoff-list (lst) "If list LST is longer than, `hui-menu-max-list-length', then cut it off there. Return t if cutoff, else nil." (let ((cutoff)) (if (setq cutoff (nthcdr (1- hui-menu-max-list-length) lst)) (setcdr cutoff nil)) (if cutoff t))) ;; List existing global buttons for menu activation. (defun hui-menu-global-buttons (rest-of-menu) (delq nil (append '(["Manual" (id-info "(hyperbole)Global Buttons") t] "----") (let ((labels (gbut:label-list)) (cutoff)) (when labels ;; Cutoff list if too long. (setq cutoff (hui-menu-cutoff-list labels)) (delq nil (append '("----" "Activate:") (mapcar (lambda (label) (vector label `(gbut:act ,label) t)) (sort labels 'string-lessp)) (if cutoff '(". . .")) '("----" "----"))))) rest-of-menu))) (defun hui-menu-key-binding-item (item-name command) "Return a key binding menu item string built from ITEM-NAME and COMMAND." (concat item-name (when (where-is-internal command nil t) (format "(%s)" (key-description (where-is-internal command nil t)))))) (defun hui-menu-key-bindings (rest-of-menu) (nconc (list (vector (hui-menu-key-binding-item "Action-Key \t\t\t" 'hkey-either) '(hui:bind-key #'hkey-either) t) ;; {M-RET} (vector (hui-menu-key-binding-item "Button-Rename-Key \t" 'hui:ebut-rename) '(hui:bind-key #'hui:ebut-rename) t) ;; None (vector (hui-menu-key-binding-item "Drag-Emulation-Key \t\t" 'hkey-operate) '(hui:bind-key #'hkey-operate) t) ;; {M-o} (vector (hui-menu-key-binding-item "Find-Web-Key \t\t" 'hui-search-web) '(hui:bind-key #'hui-search-web) t) ;; {C-c /} (vector (hui-menu-key-binding-item "Grid-of-Windows-Key \t" 'hycontrol-windows-grid) '(hui:bind-key #'hycontrol-windows-grid) t) ;; {C-c @} (vector (hui-menu-key-binding-item "Hyperbole-Menu-Key \t" 'hyperbole) '(hui:global-bind-key #'hyperbole) t) ;; {C-h h} (vector (hui-menu-key-binding-item "Jump-Thing-Key \t\t" 'hui-select-goto-matching-delimiter) '(hui:bind-key #'hui-select-thing) t) ;; {C-c .} (vector (hui-menu-key-binding-item "Mark-Thing-Key \t\t" 'hui-select-thing) '(hui:bind-key #'hui-select-thing) t) ;; {C-c RET} (vector (hui-menu-key-binding-item "Smart-Help-Key \t\t" 'hkey-help) '(hui:bind-key #'hkey-help) t) ;; {C-h A} (vector (hui-menu-key-binding-item "Windows-Control-Key\t" 'hycontrol-enable-windows-mode) '(hui:bind-key #'hycontrol-enable-windows-mode) t)) ;; {C-C \} rest-of-menu)) ;; Dynamically compute submenus for Screen menu (defun hui-menu-screen (_ignored) (list ["Manual" (id-info "(hyperbole)HyControl") t] "----" ["Control-Frames" hycontrol-enable-frames-mode t] ["Control-Windows" hycontrol-enable-windows-mode t] "----" (hui-menu-of-buffers) (hui-menu-of-frames) (hui-menu-of-windows))) (defun hui-menu-web-search () ;; Pulldown menu (let* (service action) (mapcar (lambda (service-and-action) (setq service (car service-and-action) action (cdr service-and-action)) (if (stringp action) (vector service (list #'hyperbole-web-search service nil) t) (vector service ;; a command symbol action t))) hyperbole-web-search-alist))) ;;; ************************************************************************ ;;; Public variables ;;; ************************************************************************ (defconst hui-menu-about (vector (concat "About-Hyperbole-" (if (= (aref hyperb:version 0) ?0) (substring hyperb:version 1) hyperb:version)) #'(hypb:display-file-with-logo "HY-ABOUT") t)) (defconst hui-menu-options (append '(["All-Hyperbole-Options" (customize-browse 'hyperbole) t] "----" ["Hyperbole-on-Menubar" (cond ((and (boundp 'menubar-configuration) (not (memq 'Hyperbole menubar-configuration))) ;; Hyperbole may be included as part of the menubar but ;; may be invisible due to a menubar configuration ;; setting. Invoking this item should then make it ;; visible. (hyperb:init-menubar)) ((global-key-binding [menu-bar Hyperbole]) ;; Already on the menubar, remove it. (hui-menu-remove Hyperbole)) (t;; Add it. (hyperb:init-menubar))) :style toggle :selected (cond ((boundp 'menubar-configuration) (memq 'Hyperbole menubar-configuration)) (t (and (global-key-binding [menu-bar Hyperbole]) t)))] "----" ["Find-File-Accepts-URLs" hpath:find-file-urls-mode :style toggle :selected hpath:find-file-urls-mode] "----") '(("Change-Key-Bindings" :filter hui-menu-key-bindings)) '("----") (list (cons "Display-Referents-in" (mapcar (lambda (sym) (vector (capitalize (symbol-name sym)) `(setq hpath:display-where ',sym) :style 'radio :selected `(eq hpath:display-where ',sym))) (mapcar #'car hpath:display-where-alist)))) '("----") (hui-menu-browser "Display-URLs-in" browse-url-browser-function) '("----") (hui-menu-browser "Display-Web-Searches-in" hyperbole-web-search-browser-function) '("----") '(("Org-M-RETURN" "----" "----" ["All-Programmed-Contexts" (customize-save-variable 'hsys-org-enable-smart-keys t) :style radio :selected (when (boundp 'hsys-org-enable-smart-keys) (eq hsys-org-enable-smart-keys t))] ["Hypb-Buttons-Only" (customize-save-variable 'hsys-org-enable-smart-keys 'buttons) :style radio :selected (when (boundp 'hsys-org-enable-smart-keys) (eq hsys-org-enable-smart-keys 'buttons))] ["Ignore" (customize-save-variable 'hsys-org-enable-smart-keys nil) :style radio :selected (when (boundp 'hsys-org-enable-smart-keys) (eq hsys-org-enable-smart-keys nil))])) '("----") '(("Smart-Key-Press-at-Eol" "----" "----" ;; This menu may be loaded by InfoDock before hsettings.el has ;; defined `smart-scroll-proportional'. Handle that case ;; with a conditional. ["Scrolls-a-Windowful" (setq smart-scroll-proportional nil) :style radio :selected (when (boundp 'smart-scroll-proportional) (null smart-scroll-proportional))] ["Scrolls-Proportionally" (setq smart-scroll-proportional t) :style radio :selected (when (boundp 'smart-scroll-proportional) smart-scroll-proportional)])) '("----" ["Toggle-Isearch-Invisible-Text" hypb:toggle-isearch-invisible :visible (boundp 'isearch-invisible) :style toggle :selected (when (boundp 'isearch-invisible) isearch-invisible)] ["Toggle-Messaging-Explicit-Buttons" hyperbole-toggle-messaging :style toggle :selected (not inhibit-hyperbole-messaging)] ["Toggle-Rolo-Dates" hyrolo-toggle-datestamps :style toggle :selected (and (boundp 'hyrolo-add-hook) (listp hyrolo-add-hook) (memq 'hyrolo-set-date hyrolo-add-hook))] ["Toggle-Smart-Key-Debug (HyDebug)" hkey-toggle-debug :style toggle :selected hkey-debug])) "Untitled menu of Hyperbole options.") (defvar infodock-hyperbole-menu nil) ;;; ************************************************************************ ;;; Public functions ;;; ************************************************************************ ;; Add Hyperbole menu to menubar. (defun hyperbole-menubar-menu () "Add to or update the Hyperbole menu on the global menubar." (cond ((boundp 'menubar-configuration) (unless (memq 'Hyperbole menubar-configuration) ;; Hyperbole may be included as part of the menubar but ;; may be invisible due to a menubar configuration ;; setting. Make it visible here. (if (fboundp 'customize-set-variable) (customize-set-variable 'menubar-configuration (cons 'Hyperbole menubar-configuration)) (setq menubar-configuration (cons 'Hyperbole menubar-configuration))))) (t (let ((add-before (cond ((and (boundp 'infodock-menubar-type) (eq infodock-menubar-type 'menubar-infodock)) "Key") ((global-key-binding [menu-bar Koutline]) "Koutline") ((global-key-binding [menu-bar OO-Browser]) "OO-Browser")))) (easy-menu-add-item (current-global-map) '("menu-bar") (infodock-hyperbole-menu t) add-before)))) ;; Force a menu-bar update. (force-mode-line-update)) (defun hyperbole-popup-menu (&optional rebuild-flag) "Popup the Hyperbole menubar menu." (interactive "P") (popup-menu (infodock-hyperbole-menu rebuild-flag))) ;;; Don't change this name; doing so will break the way InfoDock ;;; initializes the Hyperbole menu. (defun infodock-hyperbole-menu (&optional rebuild-flag) "Return the Hyperbole menu for the global InfoDock menubar. Uses any non-nil existing value of the menu unless optional REBUILD-FLAG is non-nil, in which case the menu is rebuilt." (when (or rebuild-flag (null infodock-hyperbole-menu)) (setq infodock-hyperbole-menu (delq nil (list "Hyperbole" :config 'Hyperbole hui-menu-about ["Demonstration" hyperbole-demo t] ;; Comment InfoDock manual reference out until ;; InfoDock is modernized for Emacs 25. ;; (if (and (boundp 'infodock-version) infodock-version) ;; ["Manual" (id-info "(infodock)Hyperbole Menu") t] ;; ["Manual" (id-info "(hyperbole)Top") t]) ["Manual" (id-info "(hyperbole)Top") t] ["What-is-New?" (hypb:display-file-with-logo "HY-NEWS") t] ["Why-Use?" (find-file (expand-file-name "HY-WHY.kotl" hyperb:dir)) t] "----" ["Remove-This-Menu" (progn ;; Delete Hyperbole menu from all menubars. (hui-menu-remove Hyperbole) ;; ;; Remove Hyperbole button comment from future outgoing mail. (when (boundp 'smail:comment) (setq smail:comment nil))) t] "----" ["Activate-Button-in-Buffer" hui:hbut-act t] ["Back-to-Prior-Location" hhist:pop (and (boundp '*hhist*) *hhist*)] '("Button-File" ["Manual" (id-info "(hyperbole)Button Files") t] "----" ["Edit-Per-Directory-File" (find-file hbmap:filename) t] ["Edit-Personal-File" (find-file (expand-file-name hbmap:filename hbmap:dir-user)) t]) (cons "Customize" hui-menu-options) '("Documentation" ["Manual" (id-info "(hyperbole)Top") t] "----" ["About" (hypb:display-file-with-logo "HY-ABOUT") t] ["Concepts" (find-file (expand-file-name "HY-CONCEPTS.kotl" hyperb:dir)) t] ["Demonstration" hyperbole-demo t] ["Files" (hypb:display-file-with-logo "MANIFEST") t] ["Glossary" (id-info "(hyperbole)Glossary") t] ["New-Features" (hypb:display-file-with-logo "HY-NEWS") t] ["Smart-Key-Summary" (id-browse-file (hypb:hkey-help-file)) t] ("Types" ["Action-Types-Manual" (id-info "(hyperbole)Action Types") t] ["Implicit-Button-Types-Manual" (id-info "(hyperbole)Implicit Buttons") t] "----" ["Show-Action-Types" (hui:htype-help-current-window 'actypes) t] ["Show-Implicit-Button-Types" (hui:htype-help-current-window 'ibtypes 'no-sort) t]) ["WhyUse" (find-file (expand-file-name "HY-WHY.kotl" hyperb:dir)) t]) '("Explicit-Button" :filter hui-menu-explicit-buttons ["Activate" hui:ebut-act t] ["Create" hui:ebut-create t] ["Delete" hui:ebut-delete t] ["Edit" hui:ebut-edit t] ("Help" ["Manual" (id-info "(hyperbole)Location") t] "----" ["Buffer-Buttons" (hui:hbut-report -1) t] ["Current-Button" (hui:hbut-report) t] ["Ordered-Buttons" (hui:hbut-report 1) t]) ["Link" hui:ebut-link-directly t] ["Rename" hui:ebut-rename t] ["Search" hui:ebut-search t] ["Types" (hui:htype-help-current-window 'actypes) t]) (append '("Find" ["Manual" (id-info-item "menu, Find") t] "----" ;; Show numbered line matches in all specified files. ["Grep-Files" hypb:rgrep t] ;; Show numbered line matches for regexp in all file-based buffers. ["Locate-Files" locate t] ;; Show numbered line matches for regexp in all file-based buffers. ["Match-File-Buffers" moccur t] ;; Show numbered line matches for regexp from this buffer. ["Occur-Here" occur t] ;; Following point, remove all lines that match regexp. ["Remove-Lines-Here" hypb:remove-lines t] ;; Following point, keep only lines that match regexp. ["Save-Lines-Here" hypb:save-lines t] "----" "Web-Search:") (hui-menu-web-search)) '("Global-Button" :filter hui-menu-global-buttons ["Create" hui:gbut-create t] ["Delete" hui:gbut-delete t] ["Edit" hui:gbut-edit t] ["Help" gbut:help t] ["Rename" hui:gbut-rename t]) '("Implicit-Button" ["Manual" (id-info "(hyperbole)Implicit Buttons") t] "----" ["Activate" hui:ibut-act t] ["Create" hui:ibut-create t] ["Delete-Type" (hui:htype-delete 'ibtypes) t] ["Edit" hui:ibut-edit t] ["Help" hui:hbut-help t] ["Link" hui:ibut-link-directly t] ["Name" hui:ibut-label-create t] ["Rename" hui:ibut-rename t] ["Types" (hui:htype-help 'ibtypes 'no-sort) t]) '("Koutliner" ["Manual" (id-info "(hyperbole)Koutliner") t] ["Example" kotl-mode:example t] "----" ["Create-File" kfile:find t] ["View-File" kfile:view t] "----" ["Collapse-Tree" (progn (kotl-mode:is-p) (kotl-mode:hide-tree (kcell-view:label))) (eq major-mode 'kotl-mode)] ["Create-Link" klink:create (eq major-mode 'kotl-mode)] ["Expand-All-Trees" kotl-mode:show-all (eq major-mode 'kotl-mode)] ["Expand-Tree" (progn (kotl-mode:is-p) (kotl-mode:show-tree (kcell-view:label))) (eq major-mode 'kotl-mode)] ["Show-Top-Level-Only" kotl-mode:hide-body (eq major-mode 'kotl-mode)]) '("Mail-Lists" ["Manual" (id-info "(hyperbole)Suggestion or Bug Reporting") t] "----" ["Mail-to-Hyperbole-Users-List" (hmail:compose "hyperbole-users@gnu.org" '(hact 'hyp-config)) t] ["Mail-to-Hyperbole-Bug-Report-List" (hmail:compose "bug-hyperbole@gnu.org" '(hact 'hyp-config)) t] "----" ["Join-Hyperbole-Users-List" (hmail:compose "hyperbole-users-join@gnu.org" nil "Just send the message; subject and body are ignored.") t] ["Join-Hyperbole-Bug-Report-List" (hmail:compose "bug-hyperbole-join@gnu.org" nil "Just send the message; subject and body are ignored.") t] "----" ["Leave-Hyperbole-Users-List" (hmail:compose "hyperbole-users-leave@gnu.org" nil "Just send the message; subject and body are ignored.") t] ["Leave-Hyperbole-Bug-Report-List" (hmail:compose "bug-hyperbole-leave@gnu.org" nil "Just send the message; subject and body are ignored.") t]) infodock-hyrolo-menu '("Screen (HyControl)" :filter hui-menu-screen) hui-menu-hywconfig))))) ;;; ************************************************************************ ;;; Private variables ;;; ************************************************************************ (defvar hui-menu-max-list-length 24 "Positive integer that caps the length of a Hyperbole dynamic menu lists.") (defvar hui-menu-order-explicit-buttons t "When non-nil (default), explicit button menu list is lexicographically ordered. Otherwise, explicit buttons are listed in their order of appearance within the current buffer.") (provide 'hui-menu) ;;; hui-menu.el ends here