[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/hyperbole ff2a482666 4/4: Make Hyperbole minibuffer men
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/hyperbole ff2a482666 4/4: Make Hyperbole minibuffer menus yield clean Emacs key and cmd logs |
|
Date: |
Mon, 31 Oct 2022 11:57:46 -0400 (EDT) |
branch: externals/hyperbole
commit ff2a482666a58f509b5df1cf4ce9c40195131f76
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>
Make Hyperbole minibuffer menus yield clean Emacs key and cmd logs
Notably with the interaction-log package. But should work with
others as well.
---
ChangeLog | 23 ++++++++++++
HY-TALK/HYPB | 58 ++++++++++++++++++++++++++++---
hui-mini.el | 112 ++++++++++++++++++++++++++++++++++++++---------------------
hui.el | 4 +--
hypb.el | 89 ++++++++++++++++++++++++++++++++++++++++++++++-
5 files changed, 240 insertions(+), 46 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 3a59a88f98..5a2a60ca0a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,26 @@
+2022-10-30 Bob Weiner <rsw@gnu.org>
+
+* hypb.el (hypb:activate-interaction-log-mode): Add to configure and
+ enable the interaction-log package for use with Hyperbole. It
+ displays a font-locked log of Emacs keys and commands executed.
+
+* hui-mini.el (hui:menu-enter): For character input, set 'this-command'
+ to 'self-insert-command'.
+ (hui:menu-mode-map): Rebound these keys to commands by
+ the same name: 'hui:menu-abort', 'hui:menu-quit', 'hui-menu-select',
+ and 'hui:menu-top'.
+ (hui:menu-select): Rename this function to 'hui:menu-choose'
+ to avoid conflict with aliasing above and ensure all the special keys
+ above are displayed in cmd logs.
+
+* hui-mini.el (hui:hypb-exit): Rename to 'hui:menu-exit-hyperbole'.
+
+* hui-mini.el (hui:menu-select): Don't record 'read-from-minibuffer'
+ in command history.
+ (hui:menu-act): Set 'this-command' and command keys to
+ be the full key sequence for a Hyperbole minibuffer menu command.
+ Ensure this single command appears in history for clean logging.
+
2022-10-27 Bob Weiner <rsw@gnu.org>
* hui-mini.el (hui:menu-item-key): Add and call from 'hui:menu-item-keys'.
diff --git a/HY-TALK/HYPB b/HY-TALK/HYPB
index c84a45a1fd..d9f74d7b0b 100644
--- a/HY-TALK/HYPB
+++ b/HY-TALK/HYPB
@@ -23,14 +23,64 @@ or interactively after loading Hyperbole:
Used for EmacsConf 2022
Install: <unless (package-installed-p 'interaction-log) (package-install
'interaction-log)>
- Activate: <interaction-log-mode 1>
- Deactivate: <interaction-log-mode 0>
+ Load: <load-library "interaction-log">
Configure:
- <progn (setq ilog-display-state 'commands)
+ <progn
+ Install: <unless (package-installed-p 'keypression) (package-install
'keypression)>
+
+ (setq ilog-display-state 'commands
+ ilog-print-lambdas 'not-compiled)
+ (mapc (lambda (cmd-str) (push (format "^%s$" cmd-str)
ilog-self-insert-command-regexps))
+ '("hyperbole" "hui:menu-enter"))
+ (interaction-log-mode 0)
+
(global-set-key
(kbd "C-h C-l")
- (lambda () (interactive) (display-buffer ilog-buffer-name)))>
+ (lambda () (interactive) (display-buffer ilog-buffer-name)))
+
+ (defun ilog-show-in-new-frame ()
+ "Display log in a pop up frame of width 41 with parameters of
selected frame."
+ (interactive)
+ (require 'hycontrol)
+ (unless interaction-log-mode (interaction-log-mode +1))
+ (let ((params (frame-parameters)))
+ (setcdr (assq 'width params) 41)
+ (let ((win (display-buffer-pop-up-frame
+ (get-buffer ilog-buffer-name)
+ (list (cons 'pop-up-frame-parameters params)))))
+ (set-window-dedicated-p win t)
+ (select-frame (window-frame win))
+ (hycontrol-frame-to-right-center)
+ win)))
+
+ (define-minor-mode interaction-log-mode
+ "Global minor mode logging keys, commands, file loads and messages.
+ Logged stuff goes to the *Emacs Log* buffer."
+ :group 'interaction-log
+ :lighter nil
+ :global t
+ :after-hook interaction-log-mode-hook
+ (if interaction-log-mode
+ (progn
+ (add-hook 'after-change-functions #'ilog-note-buffer-change)
+ (add-hook 'post-command-hook #'ilog-record-this-command)
+ (add-hook 'post-command-hook #'ilog-post-command)
+ (setq ilog-truncation-timer (run-at-time 30 30
#'ilog-truncate-log-buffer))
+ (setq ilog-insertion-timer (run-with-timer ilog-idle-time
ilog-idle-time
+
#'ilog-timer-function))
+ (message "Interaction Log: started logging in %s"
ilog-buffer-name)
+ (easy-menu-add ilog-minor-mode-menu))
+ (remove-hook 'after-change-functions #'ilog-note-buffer-change)
+ (remove-hook 'post-command-hook #'ilog-record-this-command)
+ (remove-hook 'post-command-hook #'ilog-post-command)
+ (when (timerp ilog-truncation-timer) (cancel-timer
ilog-truncation-timer))
+ (setq ilog-truncation-timer nil)
+ (when (timerp ilog-insertion-timer) (cancel-timer
ilog-insertion-timer))
+ (setq ilog-insertion-timer nil)))>
+
+ Activate: <interaction-log-mode 1>
+ Deactivate: <interaction-log-mode 0>
** Keypression - overlaying parts of buffer (shows trail of keys)
Used for EmacsNYC talk
diff --git a/hui-mini.el b/hui-mini.el
index 2e6cb06889..a12e35b8c8 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: 10-Oct-22 at 22:55:17 by Mats Lidell
+;; Last-Mod: 31-Oct-22 at 01:44:19 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -25,7 +25,7 @@
;;; Public variables
;;; ************************************************************************
-(defvar hui:hypb-exit "X"
+(defvar hui:menu-exit-hyperbole "X"
"*Upper case character string which exits from/disables Hyperbole mode.
Also exits any active minibuffer menu.")
(defvar hui:menu-select "\C-m"
@@ -33,7 +33,7 @@ Also exits any active minibuffer menu.")
(defvar hui:menu-quit "Q"
"*Upper case character string which quits selecting from a Hyperbole menu
item.")
(defvar hui:menu-abort "\C-g"
- "*Same function as `hui:menu-quit'.")
+ "*Beeps and aborts from any Hyperbole menu.")
(defvar hui:menu-top "\C-t"
"*Character string which returns to top Hyperbole menu.")
@@ -136,6 +136,10 @@ binding made with this function."
(when (called-interactively-p 'interactive)
(message "{%s} set to invoke {%s}" (key-description key) binding))))
+(defun hui:menu-hyperbole-prefix ()
+ "Return prefix keys that invoke the Hyperbole minibuffer menu."
+ (kbd (key-description (where-is-internal #'hyperbole (current-global-map)
t))))
+
(defun hui:menu-act (menu &optional menu-list doc-flag help-string-flag)
"Prompt user with Hyperbole MENU (a symbol) and perform selected item.
Optional second argument MENU-LIST is a Hyperbole menu list structure from
@@ -147,7 +151,7 @@ a menu item should be shown rather than display of a menu.
DOC-FLAG
non-nil means show documentation for any item that is selected by the
user. HELP-STRING-FLAG non-nil means show only the first line of the
documentation, not the full text."
- (setq hui:menu-keys "")
+ (setq hui:menu-keys (hui:menu-hyperbole-prefix))
(let ((show-menu t)
(rtn)
menu-alist act-form)
@@ -156,7 +160,7 @@ documentation, not the full text."
(cdr (assq menu (or menu-list
hui:menus)))))
(hypb:error "(hui:menu-act): Invalid menu symbol
arg: `%s'"
menu)))
- (cond ((and (consp (setq act-form (hui:menu-select menu-alist doc-flag
help-string-flag)))
+ (cond ((and (consp (setq act-form (hui:menu-choose menu-alist doc-flag
help-string-flag)))
(cdr act-form)
(symbolp (cdr act-form)))
;; Display another menu
@@ -165,8 +169,10 @@ documentation, not the full text."
(let ((prefix-arg current-prefix-arg))
(cond ((symbolp act-form)
(unless (eq act-form t)
+ (set--this-command-keys hui:menu-keys)
(setq show-menu nil
- rtn (call-interactively act-form))))
+ this-command act-form)
+ rtn (call-interactively act-form)))
((stringp act-form)
(if (or doc-flag help-string-flag)
(setq show-menu nil
@@ -174,8 +180,10 @@ documentation, not the full text."
(hui:menu-help act-form)
;; Loop and show menu again.
))
- (t (setq show-menu nil
- rtn (eval act-form))))))
+ (t (set--this-command-keys hui:menu-keys)
+ (setq show-menu nil
+ this-command act-form)
+ rtn (eval act-form)))))
(t (setq show-menu nil))))
rtn))
@@ -204,7 +212,7 @@ the menu list structure."
(cdr (assq menu (or menu-list
hui:menus)))))
(hypb:error "(hui:menu-get-keys): Invalid menu
symbol arg: `%s'"
menu)))
- (cond ((and (consp (setq act-form (hui:menu-select menu-alist)))
+ (cond ((and (consp (setq act-form (hui:menu-choose menu-alist)))
(cdr act-form)
(symbolp (cdr act-form)))
;; Display another menu
@@ -261,7 +269,7 @@ instead returns the one line help string for the key
sequence."
;; Ignore any keys past the first menu item activation.
(discard-input)))))
-(defun hui:hypb-exit ()
+(defun hui:menu-exit-hyperbole ()
"Exit any Hyperbole minibuffer menu and disable `hyperbole-mode'."
(interactive)
(hyperbole-mode 0)
@@ -279,9 +287,15 @@ instead returns the one line help string for the key
sequence."
(setq input (hargs:at-p)))
(erase-buffer)
(when (or (characterp input) (stringp input))
+ (setq this-command #'self-insert-command)
(insert input)))
(exit-minibuffer))
+(defalias 'hui:menu-quit #'hui:menu-enter)
+(defalias 'hui:menu-abort #'hui:menu-enter)
+(defalias 'hui:menu-top #'hui:menu-enter)
+(defalias 'hui:menu-select #'hui:menu-enter)
+
(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."
@@ -332,24 +346,29 @@ If on the menu name prefix or the last item, move to the
first item."
(if (eq owind (minibuffer-window))
(select-window owind)))))
+(defun hui:menu-item-key (item)
+ "Return ordered list of keys that activate Hypb minibuffer MENU-ALIST items.
+For each item, the key is either the first capital letter in item
+or if there are none, then its first character."
+ ;; Return either the first capital letter in item or if
+ ;; none, then its first character.
+ (or (catch 'capital
+ (progn (mapc (lambda (c) (and (<= ?A c) (>= ?Z c)
+ (throw 'capital c)))
+ item)
+ ;; Ensure nil is returned from catch if no
+ ;; matching char is found
+ nil))
+ (aref item 0)))
+
(defun hui:menu-item-keys (menu-alist)
"Return ordered list of keys that activate Hypb minibuffer MENU-ALIST items.
For each item, the key is either the first capital letter in item
or if there are none, then its first character."
- (mapcar (lambda (item)
- ;; Return either the first capital letter in item or if
- ;; none, then its first character.
- (or (catch 'capital
- (progn (mapc (lambda (c) (and (<= ?A c) (>= ?Z c)
- (throw 'capital c)))
- item)
- ;; Ensure nil is returned from catch if no
- ;; matching char is found
- nil))
- (aref item 0)))
+ (mapcar (lambda (item) (hui:menu-item-key item))
(mapcar 'car (cdr menu-alist))))
-(defun hui:menu-select (menu-alist &optional doc-flag help-string-flag)
+(defun hui:menu-choose (menu-alist &optional doc-flag help-string-flag)
"Prompt user to choose the first capitalized char of any item from
MENU-ALIST.
The character may be entered in lowercase. If chosen by direct
selection with the Assist Key, return any help string for item,
@@ -363,7 +382,7 @@ documentation, not the full text."
(let* ((menu-line (hui:menu-line menu-alist))
(set:equal-op 'eq)
(select-char (string-to-char hui:menu-select))
- (exit-char (string-to-char hui:hypb-exit))
+ (exit-char (string-to-char hui:menu-exit-hyperbole))
(quit-char (string-to-char hui:menu-quit))
(abort-char (string-to-char hui:menu-abort))
(top-char (string-to-char hui:menu-top))
@@ -376,7 +395,7 @@ documentation, not the full text."
(while (not (memq (setq key (upcase
(string-to-char
(read-from-minibuffer
- "" menu-line hui:menu-mode-map))))
+ "" menu-line hui:menu-mode-map nil t))))
keys))
(beep)
(setq hargs:reading-type 'hmenu)
@@ -384,11 +403,26 @@ documentation, not the full text."
;; Here, the minibuffer has been exited, and `key' has been set to one of:
;; a menu item first capitalized character code;
;; a menu command character code;
- ;; 1 for in the menu prefix area;
- ;; 0 for at the end of the menu.
- (cond ((memq key (list 0 exit-char quit-char)) nil)
- ((eq key abort-char) (beep) nil)
- ((memq key (list 1 top-char)) '(menu . hyperbole))
+ ;; 1 for in the menu prefix area (moves to top menu);
+ ;; 0 for at the end of the menu (does nothing).
+ (cond ((eq key exit-char)
+ (set--this-command-keys (concat hui:menu-keys
hui:menu-exit-hyperbole))
+ (setq this-command #'hui:menu-exit)
+ nil)
+ ((eq key quit-char)
+ (set--this-command-keys (concat hui:menu-keys hui:menu-quit))
+ (setq this-command #'hui:menu-quit)
+ nil)
+ ((eq key 0)
+ nil)
+ ((eq key abort-char)
+ (beep)
+ (set--this-command-keys (concat hui:menu-keys hui:menu-abort))
+ (setq this-command #'hui:menu-abort)
+ nil)
+ ((memq key (list 1 top-char))
+ (setq hui:menu-keys (concat hui:menu-keys (char-to-string top-char)))
+ '(menu . hyperbole))
((and (eq key select-char)
(save-excursion
(if (search-backward " " nil t)
@@ -567,16 +601,16 @@ The menu is a menu of commands from MENU-ALIST."
(setq i (1+ i))))
;;
;; Bind any active keys for menu mode
- (define-key hui:menu-mode-map hui:hypb-exit #'hui:hypb-exit)
- (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)
- (define-key hui:menu-mode-map "\M-b" #'hui:menu-backward-item)
- (define-key hui:menu-mode-map "\M-f" #'hui:menu-forward-item)
- (define-key hui:menu-mode-map "\C-i" #'hui:menu-forward-item) ;; TAB
- (define-key hui:menu-mode-map [backtab] #'hui:menu-backward-item) ;;
Shift-TAB
- (define-key hui:menu-mode-map "\M-\C-i" #'hui:menu-backward-item)) ;;
M-TAB
+ (define-key hui:menu-mode-map hui:menu-exit-hyperbole
#'hui:menu-exit-hyperbole)
+ (define-key hui:menu-mode-map hui:menu-quit #'hui:menu-quit)
+ (define-key hui:menu-mode-map hui:menu-abort #'hui:menu-abort)
+ (define-key hui:menu-mode-map hui:menu-top #'hui:menu-top)
+ (define-key hui:menu-mode-map hui:menu-select #'hui:menu-select)
+ (define-key hui:menu-mode-map "\M-b"
#'hui:menu-backward-item)
+ (define-key hui:menu-mode-map "\M-f"
#'hui:menu-forward-item)
+ (define-key hui:menu-mode-map "\C-i"
#'hui:menu-forward-item) ;; TAB
+ (define-key hui:menu-mode-map [backtab]
#'hui:menu-backward-item) ;; Shift-TAB
+ (define-key hui:menu-mode-map "\M-\C-i"
#'hui:menu-backward-item)) ;; M-TAB
;;; ************************************************************************
;;; Hyperbole Minibuffer Menus
diff --git a/hui.el b/hui.el
index da5707e4af..7cddd66b6e 100644
--- a/hui.el
+++ b/hui.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 19-Sep-91 at 21:42:03
-;; Last-Mod: 7-Oct-22 at 23:36:14 by Mats Lidell
+;; Last-Mod: 31-Oct-22 at 00:33:29 by Bob Weiner
;;
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -1027,7 +1027,7 @@ from those instead. See also documentation for
(let ((item)
type)
(setq type-and-args
- (hui:menu-select
+ (hui:menu-choose
(cons '("Link to>")
(mapcar
(lambda (type-and-args)
diff --git a/hypb.el b/hypb.el
index 1db973056e..175ed74d73 100644
--- a/hypb.el
+++ b/hypb.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 6-Oct-91 at 03:42:38
-;; Last-Mod: 25-Oct-22 at 19:17:15 by Bob Weiner
+;; Last-Mod: 31-Oct-22 at 03:08:23 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -51,6 +51,93 @@ It must end with a space."
;;; Public functions
;;; ************************************************************************
+(defun hypb:activate-interaction-log-mode ()
+ "Configure and enable the interaction-log package for use with Hyperbole.
+This displays a clean log of Emacs keys used and commands executed."
+ (interactive)
+ ;; Ensure package is installed
+ (unless (package-installed-p 'keypression) (package-install 'keypression))
+
+ ;; Ensure interaction-log-mode is disabled to removes its command
+ ;; hooks which are replaced below.
+ (interaction-log-mode 0)
+
+ ;; Optional binding you can enable to display the ilog buffer
+ ;; (global-set-key
+ ;; (kbd "C-h C-l")
+ ;; (lambda () (interactive) (display-buffer ilog-buffer-name)))
+
+ ;; Display source code lambdas only
+ (setq ilog-print-lambdas 'not-compiled)
+
+ ;; Omit display of some lower-level Hyperbole commands for cleaner logs
+ (mapc (lambda (cmd-str) (push (format "^%s$" cmd-str)
ilog-self-insert-command-regexps))
+ '("hyperbole" "hui:menu-enter"))
+
+ ;; Redefine the mode to display commands on post-command-hook rather
+ ;; than pre-command-hook since Hyperbole rewrites some command names
+ ;; and key sequences.
+ (define-minor-mode interaction-log-mode
+ "Global minor mode logging keys, commands, file loads and messages.
+ Logged stuff goes to the *Emacs Log* buffer."
+ :group 'interaction-log
+ :lighter nil
+ :global t
+ :after-hook interaction-log-mode-hook
+ (if interaction-log-mode
+ (progn
+ (add-hook 'after-change-functions #'ilog-note-buffer-change)
+ (add-hook 'post-command-hook #'ilog-record-this-command)
+ (add-hook 'post-command-hook #'ilog-post-command)
+ (setq ilog-truncation-timer (run-at-time 30 30
#'ilog-truncate-log-buffer))
+ (setq ilog-insertion-timer (run-with-timer ilog-idle-time
ilog-idle-time
+ #'ilog-timer-function))
+ (message "Interaction Log: started logging in %s" ilog-buffer-name)
+ (easy-menu-add ilog-minor-mode-menu))
+ (remove-hook 'after-change-functions #'ilog-note-buffer-change)
+ (remove-hook 'post-command-hook #'ilog-record-this-command)
+ (remove-hook 'post-command-hook #'ilog-post-command)
+ (when (timerp ilog-truncation-timer) (cancel-timer
ilog-truncation-timer))
+ (setq ilog-truncation-timer nil)
+ (when (timerp ilog-insertion-timer) (cancel-timer ilog-insertion-timer))
+ (setq ilog-insertion-timer nil)))
+
+ ;; Define this function to display a 41 character wide ilog frame
+ ;; at the right of the screen with other frame parameters that match
+ ;; the frame selected when this is called.
+ (defun ilog-show-in-other-frame ()
+ "Display ilog in a separate frame of width 41 with parameters of selected
frame.
+Raise and reuse any existing single window frame displaying ilog."
+ (interactive)
+ (require 'hycontrol)
+ (with-selected-window (selected-window)
+ (let* ((win (get-buffer-window ilog-buffer-name t))
+ (frame (when win (window-frame win))))
+ (if (and frame (= (with-selected-frame frame (count-windows)) 1))
+ (raise-frame frame)
+ (unless interaction-log-mode (interaction-log-mode 1))
+ (let ((params (frame-parameters)))
+ (setcdr (assq 'width params) 41)
+ (setq win (display-buffer-pop-up-frame
+ (get-buffer ilog-buffer-name)
+ (list (cons 'pop-up-frame-parameters params))))
+ (set-window-dedicated-p win t)
+ (with-selected-frame (window-frame win)
+ (hycontrol-frame-to-right-center))
+ win)))))
+
+ ;; Enable the mode
+ (interaction-log-mode 1)
+
+ ;; Limit display to commands executed
+ (with-current-buffer ilog-buffer-name
+ (setq ilog-display-state 'messages)
+ ;; Changes to command-only mode
+ (ilog-toggle-view)
+ (message ""))
+
+ (ilog-show-in-other-frame))
+
(defmacro hypb:assert-same-start-and-end-buffer (&rest body)
"Assert that buffers name does not change during execution of BODY.
Trigger an error with traceback if the buffer is not live or its