branch: externals/hyperbole
commit 72ca3f004175d5121447f184d087a6bf36bbf67c
Author: Bob Weiner <r...@gnu.org>
Commit: Bob Weiner <r...@gnu.org>
hui-mini.el: Multi-line menu support; add To/ and Doc a-z menus
---
ChangeLog | 53 ++++++++++++--
hui-mini.el | 233 ++++++++++++++++++++++++++++++++++++++++++++++++++----------
2 files changed, 242 insertions(+), 44 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 21b4c9bfe5..1ba09c5ca7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,10 +1,19 @@
-2022-07-19 Mats Lidell <ma...@gnu.org>
+2022-07-17 Bob Weiner <r...@gnu.org>
+
+* hmouse-drv.el (hkey-debug): Add print of all button properties when on
+ a Hyperbole button.
+
* hsettings.el (hyperbole-web-search): Add optional 'return-search-expr-flag'
to return search expression rather than doing the search. Use
with Assist Key.
* hibtypes.el (action): Call ibut:create to ensure button attributes
are set properly.
+ hbut.el (ibut:create): Return nil if at end-of-buffer.
+
+* hui-mouse.el (smart-imenu-item-p): Support -99 position value
+ that Emacs uses to indicate a rescan should be done.
+
* test/demo-tests.el (fast-demo-key-series-shell-pushd-hyperb-dir,
fast-demo-key-series-shell-grep,
fast-demo-key-series-shell-apropos):
@@ -13,12 +22,12 @@
* hact.el (htype:symbol): Return nil if type-category is invalid.
+2022-07-17 Mats Lidell <ma...@gnu.org>
+
* test/demo-tests.el (fast-demo-key-series-shell-apropos): Add optional
whitespace after command to accomodate for different versions on
apropos.
-2022-07-17 Mats Lidell <ma...@gnu.org>
-
* hypb.el (hypb:replace-match-string): Fix obsolete version to 8.0.1.
* kotl/kotl-mode.el (kotl-mode:beginning-of-line): Rename from
@@ -68,11 +77,19 @@
(hypb:function-symbol-replace, hypb:map-sublists)
(hypb:constant-vector-symbol-replace): Delete functions.
+2022-07-12 Bob Weiner <r...@gnu.org>
+
* hbut.el (ibut:create): Add, extracted from 'ibut:at-p'; define
with cl-defun so can optionally use non-positional colon-prefixed
keyword args to specify specific args.
* hmouse-drv.el (hkey-help): Set 'assist-flag' so matches Assist Key
+ behavior in edges cases.
+
+* hactypes.el (display-value): Add to display a value when a get or
+ value function returns that value.
+ hibtypes.el (action): Use 'display-value'.
+
2022-07-12 Mats Lidell <ma...@gnu.org>
* test/hpath-tests.el (hpath:auto-variable-alist-load-path-test): Simplify
@@ -121,6 +138,34 @@
* hsys-org.el (hsys-org-link-at-p, hsys-org-heading-at-p): Update to use
'smart-eolp' and 'smart-eobp'.
+2022-06-26 Bob Weiner <r...@gnu.org>
+
+* hui-mouse.el (hkey-alist): Fix smart-lisp to jump to load, autoload and
+ require targets.
+ hmouse-tag.el (smart-lisp-at-load-expression-p): Ensure expr ends with
+ whitespace (a full word).
+
+2022-06-25 Bob Weiner <r...@gnu.org>
+
+* hui-mini.el (hui:menu-forward-item, hui:menu-backward-item): Update to
+ handle menus without a name> prefix, e.g. a-Z menu. Also add numeric
+ prefix arg handling.
+
+2022-06-20 Bob Weiner <r...@gnu.org>
+
+* hui-mini.el (hui:menu-to-personal-section): Add.
+ (hui:menu-item): Add support for inserting menu item label
+ into the action when the action is 'hui:menu-to-personal-section'.
+ (hui:menu-a-z): Add this customizable menu.
+
+* hyrolo.el (hyrolo-add): Add newline before adding entry if point is not
+ at the beginning of the line for insertion, i.e. when buffer does not
+ end with a newline.
+
+* hui-mini.el (hui:menu-multi-line): Add to change long minibuffer menu lines
+ into multi-line menus.
+ (hui:menu-line): Update to use 'hui:menu-multi-line'.
+
2022-06-19 Bob Weiner <r...@gnu.org>
* test/demo-tests.el (fast-demo-key-series-shell-apropos): Allow optional space
@@ -9516,5 +9561,3 @@ V5.06 changes ^^^^:
Copyright 1991-2021 Free Software Foundation, Inc.
Copying and distribution of this file, with or without modification, are
permitted provided the copyright notice and this notice are preserved.
-
-
diff --git a/hui-mini.el b/hui-mini.el
index 9d50c5dc64..c84bcdb55c 100644
--- a/hui-mini.el
+++ b/hui-mini.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 15-Oct-91 at 20:13:17
-;; Last-Mod: 15-May-22 at 00:51:30 by Bob Weiner
+;; Last-Mod: 17-Jul-22 at 09:48:06 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -217,16 +217,29 @@ the menu list structure."
(t (setq show-menu nil))))
hui:menu-keys))
-(defun hui:menu-backward-item ()
- "Move point back to the previous start of a selectable minibuffer menu item.
If on the first item, move to the last."
- (interactive)
- (if (save-excursion (not (search-backward ">" nil t)))
- (goto-char (point-max)))
- (if (and (re-search-backward "[ \t]+[^> \t\n]" nil t)
- (save-excursion (search-backward ">" nil t)))
- (skip-chars-forward " \t")
- (goto-char (point-min))
- (hui:menu-backward-item)))
+(defun hui:menu-backward-item (&optional arg)
+ "Move point back to the optional ARGth previous start of a selectable
minibuffer menu item.
+If on the menu name prefix or the first item, move to the last item."
+ (interactive "p")
+ (unless arg (setq arg 1))
+ (if (< arg 0)
+ (hui:menu-forward-item (- arg))
+ (let (opoint)
+ (while (> arg 0)
+ ;; First skip back past menu name/description prompt, if within it.
+ (when (save-excursion (not (search-backward "\\(^\\|[ \t]\\)[^<
\t\n\r]+>" nil t)))
+ (setq opoint (point))
+ (skip-chars-backward "^ \t\n\r")
+ (skip-chars-forward " \t")
+ (skip-chars-forward "^<> \t\n\r")
+ (unless (looking-at ">\\s-")
+ (goto-char opoint)
+ (skip-chars-backward "^ \t\n\r")))
+ (if (re-search-backward "\\s-[^> \t\n\r]" nil t)
+ (forward-char 1)
+ (goto-char (point-max))
+ (skip-chars-backward "^ \t\n\r"))
+ (setq arg (1- arg))))))
(defun hui:menu-doc (key-sequence &optional help-string-flag)
"Return formatted documentation for a normalized Hyperbole minibuffer menu
KEY-SEQUENCE.
@@ -266,17 +279,29 @@ With optional HELP-STRING-FLAG, instead returns the one
line help string for the
(insert input)))
(exit-minibuffer))
-(defun hui:menu-forward-item ()
- "Move point to the next selectable minibuffer menu item. If on the last
item, move to the first."
- ;; First skip past menu name/description prompt, if need be.
- (interactive)
- (if (save-excursion (not (search-backward ">" nil t)))
- (search-forward ">" nil t))
- (if (re-search-forward "[ \t]+[^> \t\n]" nil t)
- (backward-char 1)
- (goto-char (point-min))
- (if (search-forward ">" nil t)
- (hui:menu-forward-item))))
+(defun hui:menu-forward-item (&optional arg)
+ "Move point to the optional prefix ARGth next selectable minibuffer menu
item.
+If on the menu name prefix or the last item, move to the first item."
+ (interactive "p")
+ (unless arg (setq arg 1))
+ (if (< arg 0)
+ (hui:menu-backward-item (- arg))
+ (let (opoint)
+ (while (> arg 0)
+ ;; First skip past menu name/description prompt, if within it.
+ (when (save-excursion (not (search-backward "\\(^\\|[ \t]\\)[^<
\t\n\r]+>" nil t)))
+ (setq opoint (point))
+ (skip-chars-backward "^ \t\n\r")
+ (skip-chars-forward " \t")
+ (skip-chars-forward "^<> \t\n\r")
+ (unless (looking-at ">\\s-")
+ (goto-char opoint)))
+ (if (re-search-forward "\\s-+[^> \t\n\r]" nil t)
+ (backward-char 1)
+ (goto-char (point-min))
+ (when (looking-at "[^< \t\n\r]+>\\s-")
+ (hui:menu-forward-item)))
+ (setq arg (1- arg))))))
(defun hui:menu-help (help-str)
"Displays HELP-STR in a small window at the bottom of the selected frame.
HELP-STR must be a string."
@@ -374,6 +399,15 @@ documentation, not the full text."
t))))
(t (hui:menu-item key doc-flag help-string-flag nil menu-alist)))))
+(defun hui:menu-to-personal-section (section)
+ "Go to top-level SECTION in personal button file; add the section if
necessary."
+ (let* ((hypb-personal-file (expand-file-name hbmap:filename hbmap:dir-user))
+ (hyrolo-file-list (list hypb-personal-file))
+ (hyrolo-add-hook)) ;; Prevent addition of dates when add navigation
sections
+ (if (= 1 (hyrolo-fgrep section 1 nil t t))
+ (hpath:find (concat hypb-personal-file "#" section))
+ (hyrolo-add section))))
+
;;; ************************************************************************
;;; Private functions
;;; ************************************************************************
@@ -410,6 +444,7 @@ constructs. If not given, the top level Hyperbole menu is
used."
(let* ((label-act-help-list
(nth (- (1+ (length item-keys)) (length sublist))
menu-alist))
+ (label (car label-act-help-list))
(act-form (cadr label-act-help-list)))
(if (or (eq hargs:reading-type 'hmenu-help)
(and doc-flag
@@ -426,19 +461,50 @@ constructs. If not given, the top level Hyperbole menu
is used."
(concat (car label-act-help-list) "\n "
help-str "\n Action: "
(prin1-to-string act-form))))
- act-form)))))
+ (if (eq act-form #'hui:menu-to-personal-section)
+ (list #'hui:menu-to-personal-section label)
+ act-form))))))
(defun hui:menu-line (menu-alist)
"Return a menu line string built from MENU-ALIST."
(let ((menu-prompt (concat (caar menu-alist) " "))
(menu-items (mapconcat 'car (cdr menu-alist) " "))
+ (width (1- (frame-width)))
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) " "))
+ (when (>= (length menu-line) width)
+ ;; Narrow menu by changing 2 spaces to 1 if too wide for current frame.
+ (setq menu-line (concat menu-prompt (mapconcat #'car (cdr menu-alist) "
"))))
+ (if (>= (length menu-line) width)
+ ;; If still too wide, switch to a multi-line layout.
+ (hui:menu-multi-line menu-alist)
menu-line)))
+(defun hui:menu-multi-line (menu-alist)
+ "Return the formatted text for a multi-line minibuffer window popup menu
with a menu of commands from optional MENU-ALIST."
+ (let* ((items-in-line 0)
+ (item-start 0)
+ (menu-strings (mapcar #'car menu-alist))
+ (max-item-len
+ (when menu-strings (+ 1 (apply 'max (mapcar #'length
menu-strings))))))
+ (unless menu-strings
+ (error "(hui:menu-multi-line): Invalid menu specified, '%s'."
menu-alist))
+ (with-temp-buffer
+ (let (indent-tabs-mode)
+ (mapcar
+ (lambda (s)
+ (setq item-start (* max-item-len items-in-line))
+ (if (or (>= item-start (frame-width))
+ (>= (+ item-start max-item-len) (frame-width)))
+ (progn
+ (setq items-in-line 0)
+ (insert "\n" s))
+ (move-to-column item-start t)
+ (insert s))
+ (setq items-in-line (1+ items-in-line)))
+ menu-strings)
+ (buffer-string)))))
+
(defun hui:menu-web-search ()
"Hyperbole minibuffer menu of web search engines."
(let* (service
@@ -529,21 +595,23 @@ constructs. If not given, the top level Hyperbole menu
is used."
(list (list (concat "Hy" version ">"))))
(delq nil
'(
- ("Act" hui:hbut-act "Activate button at point or
prompt for a labeled button in buffer.")
- ("Butfile/" (menu . butfile) "Quick access button files
menus.")
- ("Cust/" (menu . cust) "Customizes Hyperbole by
setting major options.")
- ("Doc/" (menu . doc) "Quick access to Hyperbole
documentation.")
- ("Ebut/" (menu . ebut) "Explicit button commands.")
- ("Find/" (menu . find) "Find matching line commands.")
- ("Gbut/" (menu . gbut) "Global button commands.")
+ ("Act" hui:hbut-act "Activate button at point or
prompt for a labeled button in buffer.")
+ ("Butfile/" (menu . butfile) "Quick access button files
menus.")
+ ("Cust/" (menu . cust) "Customizes Hyperbole by
setting major options.")
+ ("Doc/" (menu . doc) "Quick access to Hyperbole
documentation.")
+ ("Ebut/" (menu . ebut) "Explicit button commands.")
+ ("Find/" (menu . find) "Find matching line
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.")
- ("Kotl/" (menu . kotl) "Autonumbered outlining and
hyperlink capabilities.")
- ("Msg/" (menu . msg) "Mail and News messaging
capabilities.")
- ("Rolo/" (menu . hyrolo) "Hierarchical, multi-file rolo
lookup and edit commands.")
- ("Screen/" (menu . screen) "Screen display management
commands.")
- ("Win/" (menu . win) "Window configuration
management commands.")))))
+ ("Ibut/" (menu . ibut) "Implicit button and button
type commands.")
+ ("Kotl/" (menu . kotl) "Autonumbered outlining and
hyperlink capabilities.")
+ ("Msg/" (menu . msg) "Mail and News messaging
capabilities.")
+ ("Rolo/" (menu . hyrolo) "Hierarchical, multi-file
rolo lookup and edit commands.")
+ ("Screen/" (menu . screen) "Screen display management
commands.")
+ ("To/" (menu . to) "A-Z menu to search and add
Emacs artifacts")
+ ("Win/" (menu . win) "Window configuration
management commands.")
+ ))))
'(butfile .
(("Butfile>")
("DirFile" (find-file hbmap:filename)
@@ -774,6 +842,7 @@ constructs. If not given, the top level Hyperbole menu is
used."
"Interactively delete, jump to, move, replicate, and resize frames.")
("WindowsControl" hycontrol-enable-windows-mode
"Interactively delete, jump to, rebalance, resize, and split
windows.")))
+ (cons 'to hui:menu-to)
'(types .
(("Types>")
("ActionTypes" (hui:htype-help-current-window 'actypes)
@@ -795,6 +864,92 @@ constructs. If not given, the top level Hyperbole menu is
used."
"Restores next window configuration from ring.")))
(hui:menu-web-search)))))
+;;; ************************************************************************
+;;; Public Customizations - must come after menus are defined
+;;; ************************************************************************
+
+(defcustom hui:menu-to
+ '(("To>")
+ ("Agenda-or-Search" org-agenda)
+ ("Bookmarks" bookmark-jump)
+ ("Calendar" calendar)
+ ("Directories" hui:menu-to-personal-section)
+ ;; ("E")
+ ("recent-Files" recentf-open-files)
+ ("Global-Buttons" (find-file (expand-file-name
hbmap:filename hbmap:dir-user)))
+ ;; ("Helm" (menu . helm) "Display Hyperbole helm
control menu")
+ ;; ("I")
+ ("Jump-to-Websites" webjump)
+ ("Koutlines" hui:menu-to-personal-section)
+ ;; ("L")
+ ("buffer-Menu-Filter")
+ ("Notes" hyrolo-org)
+ ("Org-Search" helm-org-rifle-org-directory)
+ ("Projects" hui:menu-to-personal-section)
+ ("Rolo" hyrolo-fgrep)
+ ;; ("<Quit-Menu>")
+ ("Shell-Commands" hui:menu-to-personal-section)
+ ("Todos" org-todo-list)
+ ("URL-Links" hui:menu-to-personal-section)
+ ;; ("V")
+ ("Web-Search/" (menu . web) "Display Hyperbole web
search menu")
+ ;; ("X")
+ ;; ("Y")
+ ;; ("Zettelkasten-Search")
+ )
+ "*Hyperbole minibuffer To menu items of the form:
+\(LABEL-STRING ACTION-SEXP DOC-STR)."
+ :set (lambda (var value)
+ (if (fboundp #'hyperbole-minibuffer-menu)
+ (progn (set-default var value)
+ (hyperbole-minibuffer-menu))
+ (set-default var value)))
+ :type '(list string sexp (set string nil))
+ :group 'hyperbole-buttons)
+
+(defcustom hui:doc-a-z
+ '(("a-Z>")
+ ("Apropos-Symbol" hypb:helm-apropos)
+ ;; ("B")
+ ;; ("C")
+ ("Devdocs-Lookup" hypb:devdocs-lookup)
+ ;; ("E")
+ ;; ("F")
+ ;; ("G")
+ ;; ("H")
+ ("Info-Search" hypb:helm-info)
+ ;; ("J")
+ ;; ("K")
+ ;; ("L")
+ ;; ("M")
+ ;; ("N")
+ ;; ("O")
+ ;; ("P")
+ ("<Quit-Menu>")
+ ;; ("R")
+ ;; ("S")
+ ;; ("T")
+ ;; ("U")
+ ;; ("V")
+ ;; ("W")
+ ;; ("X")
+ ;; ("Y")
+ ;; ("Z")
+ )
+ "*Hyperbole minibuffer To menu items of the form:
+\(LABEL-STRING ACTION-SEXP DOC-STR)."
+ :set (lambda (var value)
+ (if (fboundp #'hyperbole-minibuffer-menu)
+ (progn (set-default var value)
+ (hyperbole-minibuffer-menu))
+ (set-default var value)))
+ :type '(list string sexp (set string nil))
+ :group 'hyperbole-buttons)
+
+;;; ************************************************************************
+;;; Initializations
+;;; ************************************************************************
+
;; Always rebuild the Hyperbole minibuffer menu when this file is loaded.
(hyperbole-minibuffer-menu)
