From f388c9d0b2b41b597d46f1e2da9b7c8ce3be1d35 Mon Sep 17 00:00:00 2001
From: cage <cage@invalid>
Date: Sat, 28 Aug 2021 16:39:34 +0200
Subject: [PATCH] - added 'apropos-help-global'.

---
 etc/init.lisp           |  2 ++
 src/keybindings.lisp    | 38 +++++++++++++++++++++++++++++++-------
 src/package.lisp        |  1 +
 src/program-events.lisp | 11 +++++++++--
 src/ui-goodies.lisp     | 12 ++++++++++++
 5 files changed, 55 insertions(+), 9 deletions(-)

diff --git a/etc/init.lisp b/etc/init.lisp
index e2752ae..605aeb2 100644
--- a/etc/init.lisp
+++ b/etc/init.lisp
@@ -143,6 +143,8 @@
 
 (define-key "C-h a"     #'apropos-help)
 
+(define-key "C-h A"     #'apropos-help-global)
+
 (define-key "C-h m"     #'open-manual)
 
 (define-key "!"         #'gemini-search)
diff --git a/src/keybindings.lisp b/src/keybindings.lisp
index 1048cd9..7c19672 100644
--- a/src/keybindings.lisp
+++ b/src/keybindings.lisp
@@ -273,6 +273,25 @@ produces a tree and graft the latter on `existing-tree'"
 (defparameter *gempub-library-keymap* (make-starting-comand-tree)
   "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*))
   "Define a key sequence that trigger a function:
 
@@ -420,7 +439,7 @@ understand"
     ((functionp key)
      (if (documentation key t)
          (with-input-from-string (stream (documentation key t))
-           (read-line stream))
+           (regex-replace-all "  +" (read-line stream) " "))
          (function-name key)))
     ((string= key "^J")
      (_ "Enter"))
@@ -489,7 +508,7 @@ and `make-blocking-list-dialog-window') showing the full docstring for a command
                                           bg
                                           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"
   (multiple-value-bind (header-bg header-fg attribute-header)
       (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)
                (> (length fields) 2)))
       (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-global         (colorize-header  (_ "Global keys")))
                   (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))
                   (fields                (list focused-header-fields)))
         (setf fields
-              (append fields
-                      focused-help
-                      (list global-header-fields)
-                      global-help))
+              (if global-search
+                  global-help
+                  (append fields
+                          focused-help
+                          (list global-header-fields)
+                          global-help)))
         (handler-case
             (let* ((scanner   (create-scanner regex :case-insensitive-mode t))
                    (actual-fields (remove-if-not (make-filter-help-text scanner)
diff --git a/src/package.lisp b/src/package.lisp
index b241a6a..a7a4ff1 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -2556,6 +2556,7 @@
    :focus-to-conversations-window
    :print-quick-help
    :apropos-help
+   :apropos-help-global
    :move-message-tree
    :change-folder
    :change-timeline
diff --git a/src/program-events.lisp b/src/program-events.lisp
index 9e4d531..accf419 100644
--- a/src/program-events.lisp
+++ b/src/program-events.lisp
@@ -1555,11 +1555,18 @@
   ((regex
     :initform nil
     :initarg :regex
-    :accessor regex)))
+    :accessor regex)
+   (global
+    :initform nil
+    :initarg :globalp
+    :reader  globalp
+    :writer  (setf global))))
 
 (defmethod process-event ((object help-apropos-event))
   (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) ())
 
diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp
index d40326e..8a38148 100644
--- a/src/ui-goodies.lisp
+++ b/src/ui-goodies.lisp
@@ -595,6 +595,18 @@ current has focus"
                       :prompt      (_ "Search for commands (regexp): ")
                       :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 ()
   "Move messages tree to a different folder. If folder does not exist will be created."
   (flet ((on-input-complete (new-folder)