mirror of https://codeberg.org/cage/tinmop/
- added 'apropos-help-global'.
This commit is contained in:
parent
adada59513
commit
f388c9d0b2
|
@ -143,6 +143,8 @@
|
||||||
|
|
||||||
(define-key "C-h a" #'apropos-help)
|
(define-key "C-h a" #'apropos-help)
|
||||||
|
|
||||||
|
(define-key "C-h A" #'apropos-help-global)
|
||||||
|
|
||||||
(define-key "C-h m" #'open-manual)
|
(define-key "C-h m" #'open-manual)
|
||||||
|
|
||||||
(define-key "!" #'gemini-search)
|
(define-key "!" #'gemini-search)
|
||||||
|
|
|
@ -273,6 +273,25 @@ produces a tree and graft the latter on `existing-tree'"
|
||||||
(defparameter *gempub-library-keymap* (make-starting-comand-tree)
|
(defparameter *gempub-library-keymap* (make-starting-comand-tree)
|
||||||
"The keymap for gempub library of publication.")
|
"The keymap for gempub library of publication.")
|
||||||
|
|
||||||
|
(defparameter *all-keymaps* (list *global-keymap*
|
||||||
|
*thread-keymap*
|
||||||
|
*message-keymap*
|
||||||
|
*gemini-message-keymap*
|
||||||
|
*tags-keymap*
|
||||||
|
*conversations-keymap*
|
||||||
|
*send-message-keymap*
|
||||||
|
*follow-requests-keymap*
|
||||||
|
*open-attach-keymap*
|
||||||
|
*open-message-link-keymap*
|
||||||
|
*open-gemini-link-keymap*
|
||||||
|
*gemini-downloads-keymap*
|
||||||
|
*gemini-certificates-keymap*
|
||||||
|
*chats-list-keymap*
|
||||||
|
*chat-message-keymap*
|
||||||
|
*gemlog-subscription-keymap*
|
||||||
|
*gemini-toc-keymap*
|
||||||
|
*gempub-library-keymap*))
|
||||||
|
|
||||||
(defun define-key (key-sequence function &optional (existing-keymap *global-keymap*))
|
(defun define-key (key-sequence function &optional (existing-keymap *global-keymap*))
|
||||||
"Define a key sequence that trigger a function:
|
"Define a key sequence that trigger a function:
|
||||||
|
|
||||||
|
@ -420,7 +439,7 @@ understand"
|
||||||
((functionp key)
|
((functionp key)
|
||||||
(if (documentation key t)
|
(if (documentation key t)
|
||||||
(with-input-from-string (stream (documentation key t))
|
(with-input-from-string (stream (documentation key t))
|
||||||
(read-line stream))
|
(regex-replace-all " +" (read-line stream) " "))
|
||||||
(function-name key)))
|
(function-name key)))
|
||||||
((string= key "^J")
|
((string= key "^J")
|
||||||
(_ "Enter"))
|
(_ "Enter"))
|
||||||
|
@ -489,7 +508,7 @@ and `make-blocking-list-dialog-window') showing the full docstring for a command
|
||||||
bg
|
bg
|
||||||
fg)))
|
fg)))
|
||||||
|
|
||||||
(defun print-help (main-window &key (regex ".*"))
|
(defun print-help (main-window &key (regex ".*") (global-search nil))
|
||||||
"Generate an help text for the focused window and main window"
|
"Generate an help text for the focused window and main window"
|
||||||
(multiple-value-bind (header-bg header-fg attribute-header)
|
(multiple-value-bind (header-bg header-fg attribute-header)
|
||||||
(swconf:quick-help-header-colors)
|
(swconf:quick-help-header-colors)
|
||||||
|
@ -527,7 +546,10 @@ and `make-blocking-list-dialog-window') showing the full docstring for a command
|
||||||
(valid-results-p (fields)
|
(valid-results-p (fields)
|
||||||
(> (length fields) 2)))
|
(> (length fields) 2)))
|
||||||
(when-let* ((focused-keybindings (main-window:focused-keybindings main-window))
|
(when-let* ((focused-keybindings (main-window:focused-keybindings main-window))
|
||||||
(global-help (sort-help (key-paths *global-keymap*)))
|
(global-help (sort-help (if global-search
|
||||||
|
(loop for i in *all-keymaps* append
|
||||||
|
(key-paths i))
|
||||||
|
(key-paths *global-keymap*))))
|
||||||
(header-focused (colorize-header (_ "Focused window keys")))
|
(header-focused (colorize-header (_ "Focused window keys")))
|
||||||
(header-global (colorize-header (_ "Global keys")))
|
(header-global (colorize-header (_ "Global keys")))
|
||||||
(focused-help (sort-help (key-paths focused-keybindings)))
|
(focused-help (sort-help (key-paths focused-keybindings)))
|
||||||
|
@ -535,10 +557,12 @@ and `make-blocking-list-dialog-window') showing the full docstring for a command
|
||||||
(focused-header-fields (make-help-fields header-focused nil))
|
(focused-header-fields (make-help-fields header-focused nil))
|
||||||
(fields (list focused-header-fields)))
|
(fields (list focused-header-fields)))
|
||||||
(setf fields
|
(setf fields
|
||||||
|
(if global-search
|
||||||
|
global-help
|
||||||
(append fields
|
(append fields
|
||||||
focused-help
|
focused-help
|
||||||
(list global-header-fields)
|
(list global-header-fields)
|
||||||
global-help))
|
global-help)))
|
||||||
(handler-case
|
(handler-case
|
||||||
(let* ((scanner (create-scanner regex :case-insensitive-mode t))
|
(let* ((scanner (create-scanner regex :case-insensitive-mode t))
|
||||||
(actual-fields (remove-if-not (make-filter-help-text scanner)
|
(actual-fields (remove-if-not (make-filter-help-text scanner)
|
||||||
|
|
|
@ -2556,6 +2556,7 @@
|
||||||
:focus-to-conversations-window
|
:focus-to-conversations-window
|
||||||
:print-quick-help
|
:print-quick-help
|
||||||
:apropos-help
|
:apropos-help
|
||||||
|
:apropos-help-global
|
||||||
:move-message-tree
|
:move-message-tree
|
||||||
:change-folder
|
:change-folder
|
||||||
:change-timeline
|
:change-timeline
|
||||||
|
|
|
@ -1555,11 +1555,18 @@
|
||||||
((regex
|
((regex
|
||||||
:initform nil
|
:initform nil
|
||||||
:initarg :regex
|
:initarg :regex
|
||||||
:accessor regex)))
|
:accessor regex)
|
||||||
|
(global
|
||||||
|
:initform nil
|
||||||
|
:initarg :globalp
|
||||||
|
:reader globalp
|
||||||
|
:writer (setf global))))
|
||||||
|
|
||||||
(defmethod process-event ((object help-apropos-event))
|
(defmethod process-event ((object help-apropos-event))
|
||||||
(with-accessors ((regex regex)) object
|
(with-accessors ((regex regex)) object
|
||||||
(keybindings:print-help specials:*main-window* :regex regex)))
|
(keybindings:print-help specials:*main-window*
|
||||||
|
:regex regex
|
||||||
|
:global-search (globalp object))))
|
||||||
|
|
||||||
(defclass redraw-window-event (program-event) ())
|
(defclass redraw-window-event (program-event) ())
|
||||||
|
|
||||||
|
|
|
@ -595,6 +595,18 @@ current has focus"
|
||||||
:prompt (_ "Search for commands (regexp): ")
|
:prompt (_ "Search for commands (regexp): ")
|
||||||
:complete-fn #'complete:complete-always-empty)))
|
:complete-fn #'complete:complete-always-empty)))
|
||||||
|
|
||||||
|
(defun apropos-help-global ()
|
||||||
|
"Print a command's documentation matching a regular expression in
|
||||||
|
all commands database."
|
||||||
|
(flet ((on-input-complete (regex)
|
||||||
|
(let ((event (make-instance 'help-apropos-event
|
||||||
|
:globalp t
|
||||||
|
:regex regex)))
|
||||||
|
(push-event event))))
|
||||||
|
(ask-string-input #'on-input-complete
|
||||||
|
:prompt (_ "Search for commands (regexp): ")
|
||||||
|
:complete-fn #'complete:complete-always-empty)))
|
||||||
|
|
||||||
(defun move-message-tree ()
|
(defun move-message-tree ()
|
||||||
"Move messages tree to a different folder. If folder does not exist will be created."
|
"Move messages tree to a different folder. If folder does not exist will be created."
|
||||||
(flet ((on-input-complete (new-folder)
|
(flet ((on-input-complete (new-folder)
|
||||||
|
|
Loading…
Reference in New Issue