emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/hyperbole 65d8c13c4a 1/4: Improve Org ID links; add reg


From: ELPA Syncer
Subject: [elpa] externals/hyperbole 65d8c13c4a 1/4: Improve Org ID links; add regexp, max-matches to hyrolo-consult-grep
Date: Fri, 31 Mar 2023 03:58:29 -0400 (EDT)

branch: externals/hyperbole
commit 65d8c13c4ad13f9f0ce717c476ce265f63d7ff87
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>

    Improve Org ID links; add regexp, max-matches to hyrolo-consult-grep
---
 ChangeLog          |  14 ++++
 hibtypes.el        |   8 +--
 hsys-www.el        |   4 +-
 hui.el             | 185 ++++++++++++++++++++++++++++-------------------------
 hyrolo.el          |  72 +++++++++++++++------
 man/hyperbole.texi |  34 +++++++++-
 6 files changed, 204 insertions(+), 113 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 3a15aaa8a7..953d3948d1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2023-03-12  Bob Weiner  <rsw@gnu.org>
+
+* hyrolo.el (hyrolo-get-consult-version): Add.
+            (require 'package): Add.
+            (hyrolo-consult-grep): Add optional parameters to specify
+    initial regexp and max-matches per file.  Also ensure necessary
+    version of consult package is installed.  Update doc.
+
+* man/hyperbole.texi (By Dragging): Add doc for link-to-org-id.
+                     (Glossary): Add Ace Window, Consult, Org Mode,
+    and Org Roam entries.
+  hui.el (hui:link-possible-types): If an Org ID, use it exclusively
+    and handle IDs in any mode.
+
 2023-03-12  Mats Lidell  <matsl@gnu.org>
 
 * kotl/kexport.el (kexport:label-html-font-attributes): Don't use font
diff --git a/hibtypes.el b/hibtypes.el
index 43a8ee18e2..ac58483837 100644
--- a/hibtypes.el
+++ b/hibtypes.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    19-Sep-91 at 20:45:31
-;; Last-Mod:     11-Mar-23 at 17:42:25 by Bob Weiner
+;; Last-Mod:     12-Mar-23 at 21:41:30 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -137,7 +137,7 @@ line and check for a source reference line again."
 
 (defib org-id ()
   "Display Org roam or Org node referenced by id at point, if any.
-If on the :ID: definition line, do nothing and return nil.
+If on the :ID: definition line, display a message about how to copy the id.
 If the referenced location is found, return non-nil."
   (when (featurep 'org-id)
     (let* ((id (thing-at-point 'symbol t)) ;; Could be a uuid or some other 
form of id
@@ -153,9 +153,7 @@ If the referenced location is found, return non-nil."
                 (save-excursion (beginning-of-line)
                                 (re-search-forward ":\\(CUSTOM_\\)?ID:[ \t]+"
                                                    (line-end-position) t)))
-           (progn
-             (hact #'message "On ID definition; use {C-u M-RET} to copy a link 
to an ID.")
-             (hact #'identity id))
+           (hact #'message "On ID definition; use {C-u M-RET} to copy a link 
to an ID.")
          (when (let ((inhibit-message t)) ;; Inhibit org-id-find status msgs
                  (setq m (or (and (featurep 'org-roam) (org-roam-id-find id 
'marker))
                              (org-id-find id 'marker))))
diff --git a/hsys-www.el b/hsys-www.el
index 611577231a..7b91e6940a 100644
--- a/hsys-www.el
+++ b/hsys-www.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:     7-Apr-94 at 17:17:39 by Bob Weiner
-;; Last-Mod:     11-May-22 at 00:01:48 by Bob Weiner
+;; Last-Mod:     12-Mar-23 at 15:12:24 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -117,7 +117,7 @@ is used.  Valid values of this variable include 
`browse-url-default-browser' and
 
 ;;;###autoload
 (defun www-url-expand-file-name (path &optional dir)
-  "Expand and return  non-url and non-remote PATH in DIR.
+  "Expand and return non-url and non-remote PATH in DIR.
 Return http urls unchanged.  Normalize remote paths."
   (when (listp path)
     (setq path (car path)
diff --git a/hui.el b/hui.el
index 87c25c79f9..9e8e935da4 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:     11-Mar-23 at 15:38:26 by Bob Weiner
+;; Last-Mod:     12-Mar-23 at 20:46:57 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -1491,6 +1491,7 @@ possible types.
 
 Referent Context         Possible Link Type Returned
 ----------------------------------------------------
+Org Roam or Org Id       link-to-org-id
 Global Button            link-to-gbut
 Explicit Button          link-to-ebut
 Implicit Button          link-to-ibut
@@ -1512,91 +1513,103 @@ Buffer without File      link-to-buffer-tmp"
        hbut-sym
        lbl-key)
     (delq nil
-         (list (cond ((and (prog1 (setq hbut-sym (hbut:at-p))
-                             ;; Next line forces use of any ibut name in the 
link.
-                             (save-excursion (ibut:at-to-name-p hbut-sym)))
-                           (setq lbl-key (hattr:get hbut-sym 'lbl-key))
-                           (eq (current-buffer) (get-file-buffer (gbut:file))))
-                      (list 'link-to-gbut lbl-key))
-                     ((and hbut-sym (eq (hattr:get hbut-sym 'categ) 'explicit))
-                      (list 'link-to-ebut lbl-key))
-                     (hbut-sym
-                      (list 'link-to-ibut lbl-key (or buffer-file-name 
(buffer-name)))))
-               (when (and (featurep 'org-id) (derived-mode-p 'org-mode 
'hyrolo-mode))
-                 (save-excursion
-                   (beginning-of-line)
-                   (when (looking-at "[ \t]*:ID:[ \t]+\\([^ \t\r\n\f]+\\)")
-                     (list 'link-to-org-id (match-string 1)))))
-               (and (require 'bookmark)
-                     (derived-mode-p #'bookmark-bmenu-mode)
-                     (list 'link-to-bookmark (bookmark-bmenu-bookmark)))
-               (cond ((derived-mode-p #'Info-mode)
-                      (if (and Info-current-node
-                               (member Info-current-node
-                                       (Info-index-nodes Info-current-file))
-                               (Info-menu-item-at-p))
-                          (let ((hargs:reading-type 'Info-index-item))
-                            (list 'link-to-Info-index-item (hargs:at-p)))
-                        (let ((hargs:reading-type 'Info-node))
-                          (list 'link-to-Info-node (hargs:at-p)))))
-                      ((derived-mode-p #'texinfo-mode)
-                       (let (node)
-                         (save-excursion
-                           (beginning-of-line)
-                           (when (and (not (looking-at "@node "))
-                                      (not (re-search-backward "^@node " nil 
t)))
-                             (hypb:error "(hui:link-possible-types): Not 
within a texinfo node"))
-                          (require 'texnfo-upd)
-                           (setq node (texinfo-copy-node-name)))
-                         (list 'link-to-texinfo-node buffer-file-name node)))
-                     ((hmail:reader-p)
-                      (list 'link-to-mail
-                            (list (rmail:msg-id-get) buffer-file-name))))
-               (cond
-                ((let ((hargs:reading-type 'directory))
-                   (setq val (hargs:at-p t)))
-                 (list 'link-to-directory val))
-                ((let ((hargs:reading-type 'file))
-                   (setq val (hargs:at-p t)))
-                 (list 'link-to-file val (point)))
-                ((derived-mode-p #'kotl-mode)
-                 (list 'link-to-kcell buffer-file-name (kcell-view:idstamp)))
-                ;; If link is within an outline-regexp prefix, use
-                ;; a link-to-string-match.
-                ((and (boundp 'outline-regexp)
-                      (stringp outline-regexp)
-                      (save-excursion
-                        (<= (point)
-                            (progn
-                              (beginning-of-line)
-                              (if (looking-at outline-regexp)
-                                  (match-end 0)
-                                0)))))
-                 (save-excursion
-                   (end-of-line)
-                   (let ((heading (buffer-substring-no-properties
-                                   (point)
-                                   (line-end-position)))
-                         (occur 1))
-                     (while (search-backward heading nil t)
-                       (setq occur (1+ occur)))
-                     (list 'link-to-string-match
-                           heading occur buffer-file-name))))
-                (buffer-file-name
-                 (list 'link-to-file buffer-file-name (point)))
-                (t (list 'link-to-buffer-tmp (buffer-name))))
-               ;;
-               ;; Deleted link to elisp possibility as it can embed
-               ;; long elisp functions in the button data file and
-               ;; possibly not parse them correctly.
-               ;;
-               ;; (and (fboundp 'smart-emacs-lisp-mode-p)
-               ;;      (smart-emacs-lisp-mode-p)
-               ;;      (or (eq (char-syntax (following-char)) ?\()
-               ;;       (eq (char-syntax (preceding-char)) ?\)))
-               ;;      (setq val (hargs:sexpression-p))
-               ;;      (list 'eval-elisp val))
-               ))))
+         (list (cond ((and (featurep 'org-id)
+                           (cond ((save-excursion
+                                    (beginning-of-line)
+                                    (when (looking-at "[ \t]*:ID:[ \t]+\\([^ 
\t\r\n\f]+\\)")
+                                      ;; Org ID definition
+                                      (list 'link-to-org-id (match-string 
1)))))
+                                 (t (let* ((id (thing-at-point 'symbol t)) ;; 
Could be a uuid or some other form of id
+                                           (bounds (when id 
(bounds-of-thing-at-point 'symbol)))
+                                           (start (when bounds (car bounds)))
+                                           (case-fold-search t))
+                                      ;; Org ID link - must have id: prefix or 
is ignored.
+                                      (when start
+                                        (save-excursion
+                                          (goto-char (max (- start 3) 
(point-min)))
+                                          (when (looking-at "\\bid:")
+                                            (list 'link-to-org-id id)))))))))
+
+                     (t (cond ((and (prog1 (setq hbut-sym (hbut:at-p))
+                                      ;; Next line forces use of any ibut name 
in the link.
+                                      (save-excursion (ibut:at-to-name-p 
hbut-sym)))
+                                    (setq lbl-key (hattr:get hbut-sym 
'lbl-key))
+                                    (eq (current-buffer) (get-file-buffer 
(gbut:file))))
+                               (list 'link-to-gbut lbl-key))
+                              ((and hbut-sym (eq (hattr:get hbut-sym 'categ) 
'explicit))
+                               (list 'link-to-ebut lbl-key))
+                              (hbut-sym
+                               (list 'link-to-ibut lbl-key (or 
buffer-file-name (buffer-name))))
+                              ((and (require 'bookmark)
+                                    (derived-mode-p 'bookmark-bmenu-mode)
+                                    (list 'link-to-bookmark 
(bookmark-bmenu-bookmark))))
+                              ((cond ((derived-mode-p 'Info-mode)
+                                      (if (and Info-current-node
+                                               (member Info-current-node
+                                                       (Info-index-nodes 
Info-current-file))
+                                               (Info-menu-item-at-p))
+                                          (let ((hargs:reading-type 
'Info-index-item))
+                                            (list 'link-to-Info-index-item 
(hargs:at-p)))
+                                        (let ((hargs:reading-type 'Info-node))
+                                          (list 'link-to-Info-node 
(hargs:at-p)))))
+                                     ((derived-mode-p #'texinfo-mode)
+                                      (let (node)
+                                        (save-excursion
+                                          (beginning-of-line)
+                                          (when (and (not (looking-at "@node 
"))
+                                                     (not (re-search-backward 
"^@node " nil t)))
+                                            (hypb:error 
"(hui:link-possible-types): Not within a texinfo node"))
+                                          (require 'texnfo-upd)
+                                          (setq node (texinfo-copy-node-name)))
+                                        (list 'link-to-texinfo-node 
buffer-file-name node)))
+                                     ((hmail:reader-p)
+                                      (list 'link-to-mail
+                                            (list (rmail:msg-id-get) 
buffer-file-name)))))
+                              (t (cond
+                                  ((let ((hargs:reading-type 'directory))
+                                     (setq val (hargs:at-p t)))
+                                   (list 'link-to-directory val))
+                                  ((let ((hargs:reading-type 'file))
+                                     (setq val (hargs:at-p t)))
+                                   (list 'link-to-file val (point)))
+                                  ((derived-mode-p #'kotl-mode)
+                                   (list 'link-to-kcell buffer-file-name 
(kcell-view:idstamp)))
+                                  ;; If link is within an outline-regexp 
prefix, use
+                                  ;; a link-to-string-match.
+                                  ((and (boundp 'outline-regexp)
+                                        (stringp outline-regexp)
+                                        (save-excursion
+                                          (<= (point)
+                                              (progn
+                                                (beginning-of-line)
+                                                (if (looking-at outline-regexp)
+                                                    (match-end 0)
+                                                  0)))))
+                                   (save-excursion
+                                     (end-of-line)
+                                     (let ((heading 
(buffer-substring-no-properties
+                                                     (point)
+                                                     (line-end-position)))
+                                           (occur 1))
+                                       (while (search-backward heading nil t)
+                                         (setq occur (1+ occur)))
+                                       (list 'link-to-string-match
+                                             heading occur buffer-file-name))))
+                                  (buffer-file-name
+                                   (list 'link-to-file buffer-file-name 
(point)))
+                                  (t (list 'link-to-buffer-tmp 
(buffer-name)))))
+                              ;;
+                              ;; Deleted link to elisp possibility as it can 
embed
+                              ;; long elisp functions in the button data file 
and
+                              ;; possibly not parse them correctly.
+                              ;;
+                              ;; (and (fboundp 'smart-emacs-lisp-mode-p)
+                              ;;      (smart-emacs-lisp-mode-p)
+                              ;;      (or (eq (char-syntax (following-char)) 
?\()
+                              ;;        (eq (char-syntax (preceding-char)) 
?\)))
+                              ;;      (setq val (hargs:sexpression-p))
+                              ;;      (list 'eval-elisp val))
+                              )))))))
 
 (defun hui:list-remove-text-properties (lst)
   "Return LST, a list, with text properties removed from any string elements."
diff --git a/hyrolo.el b/hyrolo.el
index 36d84d0633..74642568d7 100644
--- a/hyrolo.el
+++ b/hyrolo.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:     7-Jun-89 at 22:08:29
-;; Last-Mod:     11-Mar-23 at 01:33:01 by Bob Weiner
+;; Last-Mod:     12-Mar-23 at 17:40:43 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -30,6 +30,7 @@
 (require 'custom) ;; For defface.
 (require 'hversion)
 (require 'hmail)
+(require 'package)
 (require 'set)
 (require 'sort)
 (require 'xml)
@@ -40,11 +41,15 @@
   (unless (require 'bbdb nil t)
     (defvar bbdb-file nil))
   (unless (require 'google-contacts nil t)
-    (defvar google-contacts-buffer-name nil)))
+    (defvar google-contacts-buffer-name nil))
+  (require 'kview nil t))
 
 ;;; ************************************************************************
 ;;; Public declarations
 ;;; ************************************************************************
+(defvar consult-grep-args)
+(defvar consult-ripgrep-args)
+(defvar helm-org-rifle-show-full-contents)
 (defvar helm-org-rifle-show-level-stars)
 (defvar markdown-regex-header)
 (defvar org-roam-directory)
@@ -1240,22 +1245,6 @@ otherwise just use the cdr of the item."
 ;;; Org Package Integrations
 ;;; ************************************************************************
 
-;;;###autoload
-(defun hyrolo-consult-grep ()
-  "Search with a consult package grep command.
-Use ripgrep (rg) if found, otherwise, plain grep.
-Interactively show all matches from `hyrolo-file-list'.
-Prompt for the search pattern."
-  (interactive)
-  (unless (package-installed-p 'consult)
-    (package-install 'consult))
-  (require 'consult)
-  (let ((files (seq-filter #'file-readable-p hyrolo-file-list))
-       (grep-func (cond ((executable-find "rg")
-                         #'consult-ripgrep)
-                        (t #'consult-grep))))
-    (funcall grep-func files)))
-
 ;;;###autoload
 (defun hyrolo-helm-org-rifle (&optional context-only-flag)
   "Search with helm and interactively show all matches from `hyrolo-file-list'.
@@ -1360,6 +1349,42 @@ Stop at the first and last subheadings of a superior 
heading."
   (interactive "p")
   (hyrolo-move-backward #'outline-backward-same-level arg))
 
+;;;###autoload
+(defun hyrolo-consult-grep (&optional regexp max-matches)
+  "Interactively search `hyrolo-file-list' with a consult package grep command.
+Use ripgrep (rg) if found, otherwise, plain grep.  Interactively
+show all matches from `hyrolo-file-list'.  Initialize search with
+optional REGEXP and interactively prompt for changes.  Limit matches
+per file to the absolute value of MAX-MATCHES if given."
+  (interactive "i\nP")
+  (unless (package-installed-p 'consult)
+    (package-install 'consult))
+  (require 'consult)
+  (let ((consult-version (hyrolo-get-consult-version)))
+    ;; Multi-file support added after consult version "0.32"
+    (when (not (and consult-version (string-greaterp consult-version "0.32")))
+      (error "(hyrolo-consult-grep): consult package version is %s; update 
required"
+            consult-version)))
+  (let ((files (seq-filter #'file-readable-p hyrolo-file-list))
+       (consult-grep-args (if (integerp max-matches)
+                              (if (listp consult-grep-args)
+                                  (append consult-grep-args
+                                          (list (format "-m %d" (abs 
max-matches))))
+                                (concat consult-grep-args
+                                        (format " -m %d" (abs max-matches))))
+                            consult-grep-args))
+       (consult-ripgrep-args (if (integerp max-matches)
+                                 (if (listp consult-ripgrep-args)
+                                     (append consult-ripgrep-args
+                                             (list (format "-m %d" (abs 
max-matches))))
+                                   (concat consult-ripgrep-args
+                                           (format " -m %d" (abs 
max-matches))))
+                               consult-ripgrep-args))
+       (grep-func (cond ((executable-find "rg")
+                         #'consult-ripgrep)
+                        (t #'consult-grep))))
+    (funcall grep-func files regexp)))
+
 ;;;###autoload
 (defun hyrolo-fgrep-directories (file-regexp &rest dirs)
   "String/logical HyRolo search over files matching FILE-REGEXP in rest of 
DIRS."
@@ -1745,6 +1770,17 @@ HYROLO-BUF may be a file-name, `buffer-name', or buffer."
            ", "
            (substring name-str (match-beginning first) (match-end first)))))
 
+(defun hyrolo-get-consult-version ()
+  "Return the string version of the installed consult package or nil."
+  (let* ((consult-file (find-library-name "consult"))
+        (buffer-existed (get-file-buffer consult-file))
+        (buffer-modified (when buffer-existed (buffer-modified-p 
buffer-existed)))
+        (buf (or buffer-existed (find-file-noselect consult-file))))
+    (with-current-buffer buf
+      (prog1 (package-get-version)
+       (unless buffer-modified
+         (kill-buffer buf))))))
+
 (defun hyrolo-highlight-matches (regexp start _end)
   "Highlight matches for REGEXP in region from START to END."
   (when (fboundp 'hproperty:but-add)
diff --git a/man/hyperbole.texi b/man/hyperbole.texi
index ec64d039a5..3cb03bcc8b 100644
--- a/man/hyperbole.texi
+++ b/man/hyperbole.texi
@@ -7,7 +7,7 @@
 @c Author:       Bob Weiner
 @c
 @c Orig-Date:     6-Nov-91 at 11:18:03
-@c Last-Mod:      7-Mar-23 at 22:08:27 by Bob Weiner
+@c Last-Mod:     12-Mar-23 at 20:46:34 by Bob Weiner
 
 @c %**start of header (This is for running Texinfo on a region.)
 @setfilename hyperbole.info
@@ -3359,6 +3359,7 @@ upon the referent context in which the Action Key is 
released.
 @example
 Referent Context         Link Type
 ----------------------------------------------------
+Org Roam or Org Id       link-to-org-id
 Global Button            link-to-gbut
 Explicit Button          link-to-ebut
 Implicit Button          link-to-ibut
@@ -7015,6 +7016,12 @@ if any emacs-related terms are unfamiliar to you.
 
 @table @b
 
+@item Ace Window
+Emacs extension package that labels windows with letters and allows
+quick selection or other operations on a specific window.  Hyperbole
+extends this with a number of additional commands like throw a buffer
+to a window or replace a windows's contents.  @xref{Keyboard Drags}.
+
 @item Action
 An executable behavior associated with a Hyperbole button.  @dfn{Links}
 are a specific class of actions which display existing entities, such as
@@ -7154,6 +7161,14 @@ A group of functions and variables with the same prefix 
in their names,
 used to provide an interface to an internal or external Hyperbole
 abstraction.
 
+@cindex consult package
+@cindex consult-org-roam package
+@item Consult
+An Emacs extension package that provides asynchronous search and narrow
+wrappers around common search commands like grep, ripgrep, find and locate.
+Hyperbole optionally utilizes this to search the HyRolo.  Use the
+@code{consult-org-roam} package to search Org Roam notes similarly.
+
 @item Context
 A programmatic or positional state recognized by Hyperbole.
 We speak of Smart Key and implicit button contexts.  Both are typically
@@ -7401,6 +7416,21 @@ Hyperbole provides the mouse support for the OO-Browser, 
providing Smart
 Keys that utilize the OO-Browser's capabilities both when it is displayed
 on screen and when editing code.
 
+@item Org Mode
+A built-in Emacs mode for outlining, note taking and scientific
+publishing.  Hyperbole simplifies access to a number of its features
+and integrates its own hypermedia capabilities with those of Org mode.
+Hyperbole can display the referent of any Org Id.
+@xref{Smart Key - Org Mode}.
+
+@cindex org-roam package
+@item Org Roam
+An Emacs extension package that inserts ids into Org mode files and
+indexes them within a Sqlite database for rapid note taking and lookup
+by title.  Hyperbole can display the referent of any Org Roam Id and
+provides full-text searching of Org Roam nodes utilzing the interactive
+grep commands from the Consult extension package.
+
 @item Outline
 See @b{Koutline}.
 
@@ -9482,7 +9512,7 @@ When in an Org mode context and 
@code{hsys-org-enable-smart-keys} is non-nil:
 @noindent
 Org links may be used outside of Org mode buffers.  Such links are
 handled by the separate implicit button type, @code{org-link-outside-org-mode}.
-Org and Org Roam IDs may be activated as hyperbuttons outside of Org mode 
buffers.
+Org Roam and Org IDs may be activated as hyperbuttons outside of Org mode 
buffers.
 They are handled by the separate implicit button type, @code{org-id}.
 
 @node Smart Key - Ivy, Smart Key - Treemacs, Smart Key - Org Mode, Smart 
Keyboard Keys



reply via email to

[Prev in Thread] Current Thread [Next in Thread]