branch: externals/hyperbole
commit d9f10a29ac5e77272b6ce068269899384e3c1168
Author: Bob Weiner <r...@gnu.org>
Commit: Bob Weiner <r...@gnu.org>
Add HyRolo searching for Koutline files (*.kotl)
Simply add Koutline files to hyrolo-file-list.
---
ChangeLog | 67 +++++++++++
HY-NEWS | 9 ++
hui-mouse.el | 6 +-
hyrolo-logic.el | 14 +--
hyrolo.el | 305 +++++++++++++++++++++++++++++++++------------------
kotl/kotl-mode.el | 24 ++--
kotl/kview.el | 5 +-
test/demo-tests.el | 6 +-
test/hyrolo-tests.el | 3 +
9 files changed, 311 insertions(+), 128 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 6f425bc51b..18d6a96218 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,70 @@
+2022-08-21 Bob Weiner <r...@gnu.org>
+
+* hyrolo.el (hyrolo-set-date): Don't add a date if in a Koutline
+ buffer.
+* hyrolo.el (hyrolo-add, hyrolo-edit, hyrolo-toggle-narrow-to-entry,
+ hyrolo-grep-file, hyrolo-to):
+ hyrolo-logic.el (hyrolo-map-logic):
+ Replace use of 'widen' with new function, 'hyrolo-widen',
+ which widens only to the textual part of a buffer, leaving
+ Koutline meta-data hidden, for example.
+ (hyrolo-edit, hyrolo-add): If in a Koutline, ensure point is
+ left in a valid, editable position.
+ (hyrolo-narrowed-p): Remove. Use 'buffer-narrowed-p' instead.
+ (hyrolo-show-levels): Make argument of NUM-LEVELS relative
+ to first matched level, so some entries are always shown.
+ (hyrolo-min-matched-level): Add and use in 'hyrolo-show-levels'
+ (hyrolo-back-to-visible-point): Add and use in
+ 'hyrolo-show-levels'.
+ (hyrolo-display-matches): Move invocation of 'hyrolo-mode'
+ to when the match display buffer is created in 'hyrolo-set-display-buffer'.
+ (hyrolo-set-display-buffer): Add and used above.
+
+2022-08-20 Bob Weiner <r...@gnu.org>
+
+* hyrolo.el (hyrolo-grep): Add support for 'outline-regexp' and
+ 'outline-level' variables from multiple file types.
+ (hyrolo-mode): Set local value of 'outline-level' to
+ 'hyrolo-mode-outline-level' and define that function to support
+ star outlines and Koutlines. Also, make 'hyrolo-entry-regexp'
+ local and set it to its default value, after which it may be
+ modified.
+ (hyrolo-previous-match): Change so can be used in a
+ predicate when a match is found.
+ (hyrolo-mode-outline-level): Add and use in 'hyrolo-mode'.
+
+* kotl/kotl-mode.el (kotl-mode): Add local settings of:
+ 'hyrolo-entry-regexp', 'outline-level', and 'outline-regexp'
+ specific to Koutlines.
+ kotl/kview.el (kview:outline-regexp): Regexp quote
+ use of 'kview:default-label-separator'.
+ (hyrolo-name-at): Change to only go to beginning of
+ the current line to check if at the start of a hyrolo entry;
+ don't do a reverse search any more.
+
+2022-08-11 Bob Weiner <r...@gnu.org>
+
+* kotl/kview.el (kview:outline-regexp): Add groupings to match
+ to 'hyperbole-entry-regexp' when HyRolo searches kotls.
+
+* kotl/kotl-mode.el (kotl-mode): Set this mode with 'special
+ property since cells are specially formatted and edited.
+ hyrolo.el (hyrolo-grep-file):
+ hyrolo-logic.el (hyrolo-map-logic): Don't widen buffers whose
+ major mode is marked 'special.
+
+2022-08-08 Bob Weiner <r...@gnu.org>
+
+* kotl/kview.el (kview:outline-regexp): Add so can be referenced
+ elsewhere.
+ kotl/kotl-mode.el (kotl-mode): Use kview:outline-regexp.
+
+2022-08-07 Bob Weiner <r...@gnu.org>
+
+* hyrolo.el (hyrolo-org, hyrolo-org-roam): Remove cddr call to filter
+ . and .. out since match to "\\.org$" already does. Also add
+ missing arguments to hyrolo-org and complete doc strings.
+
2022-07-26 Mats Lidell <ma...@gnu.org>
* kotl/kotl-orgtbl.el: Shorten docs strings to be within 80 char limit.
diff --git a/HY-NEWS b/HY-NEWS
index 501545a4eb..def0edf47c 100644
--- a/HY-NEWS
+++ b/HY-NEWS
@@ -12,6 +12,15 @@
libraries to eliminate all Error-level messages).
+** HYROLO (See "(hyperbole)HyRolo").
+
+ *** Koutline Fast Search: Koutlines may now be included in 'rolo-file-list'
+ and individual cells extracted properly with any HyRolo query. Then
+ the interactive commands to show the top-level matches, an outline of
+ matches or to show, hide or move to matches all work in the match
+ display buffer as well.
+
+
** KOUTLINER (See "(hyperbole)Koutliner").
*** M-S-left and M-S-Right: Org compatibility - Add tree promote and demote
diff --git a/hui-mouse.el b/hui-mouse.el
index 2c797afc97..9d78077fdf 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-89
-;; Last-Mod: 17-Jul-22 at 15:03:45 by Bob Weiner
+;; Last-Mod: 21-Aug-22 at 10:59:08 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -1292,10 +1292,10 @@ If assist-key is pressed within:
;;; ************************************************************************
(defun smart-hyrolo ()
- "In hyrolo match buffer, edits current entry.
+ "In hyrolo match buffer, edit current entry.
Uses one key or mouse key.
-Invoked via a key press when in the `hyrolo-display-buffer'. It assumes that
+Invoked via a key press when in the `hyrolo-display-buffer'. Assume that
its caller has already checked that the key was pressed in an appropriate
buffer and has moved the cursor to the selected buffer."
(interactive)
diff --git a/hyrolo-logic.el b/hyrolo-logic.el
index 964e0dfb77..2940d1c266 100644
--- a/hyrolo-logic.el
+++ b/hyrolo-logic.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 13-Jun-89 at 22:57:33
-;; Last-Mod: 15-Jul-22 at 23:23:52 by Mats Lidell
+;; Last-Mod: 21-Aug-22 at 14:42:41 by Bob Weiner
;;
;; Copyright (C) 1989-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -143,13 +143,13 @@ is nil and optional NO-SUB-ENTRIES-OUT flag is non-nil.
SEXP should utilize the
free variables `start' and `end' as the region on which to operate.
Return the number of evaluations of SEXP that match entries."
(let* ((display-buf (unless count-only
- (prog1 (set-buffer (get-buffer-create
hyrolo-display-buffer))
+ (prog1 (hyrolo-set-display-buffer)
(setq buffer-read-only nil)
(erase-buffer))))
(result
(mapcar
- (lambda (in-bufs)
- (hyrolo-map-logic sexp in-bufs count-only include-sub-entries
+ (lambda (buf)
+ (hyrolo-map-logic sexp buf count-only include-sub-entries
no-sub-entries-out))
(cond ((null in-bufs) hyrolo-file-list)
((listp in-bufs) in-bufs)
@@ -173,14 +173,14 @@ to operate. Return the number of evaluations of SEXP
that match entries."
(if (or (bufferp hyrolo-buf)
(if (file-exists-p hyrolo-buf)
(setq hyrolo-buf (find-file-noselect hyrolo-buf t))))
- (let* ((display-buf (set-buffer (get-buffer-create
hyrolo-display-buffer)))
+ (let* ((display-buf (hyrolo-set-display-buffer))
(buffer-read-only))
(let ((hdr-pos) (num-found 0))
(set-buffer hyrolo-buf)
(save-excursion
(save-restriction
- (widen)
- (goto-char 1)
+ (hyrolo-widen)
+ (goto-char (point-min))
;; Ensure no entries in outline mode are hidden.
(outline-show-all)
(when (re-search-forward hyrolo-hdr-regexp nil t 2)
diff --git a/hyrolo.el b/hyrolo.el
index 1d50f59063..74faaaff21 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: 3-Jul-22 at 09:46:59 by Bob Weiner
+;; Last-Mod: 21-Aug-22 at 14:47:29 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -28,6 +28,7 @@
(require 'custom) ;; For defface.
(require 'hversion)
(require 'hmail)
+(require 'set)
(require 'sort)
(require 'xml)
@@ -209,9 +210,12 @@ entry which begins with the parent string."
(set-buffer (or (get-file-buffer file) (find-file-noselect file)))
(when (called-interactively-p 'interactive)
(message "Locating insertion point for `%s'..." name))
- (let ((parent "") (level "") end)
- (widen)
- (goto-char 1)
+ (let ((parent "")
+ (level "")
+ (entry-regexp (default-value 'hyrolo-entry-regexp))
+ end)
+ (hyrolo-widen)
+ (goto-char (point-min))
;; If name includes slash level separator character, walk down
;; existing matching tree of entries to find insertion point.
(while (string-match "\\`[^\]\[/<>{}\"]*/" name)
@@ -219,7 +223,7 @@ entry which begins with the parent string."
parent (substring name 0 end)
name (substring name (min (1+ end) (length name))))
(if (re-search-forward
- (concat hyrolo-entry-regexp (regexp-quote parent) "\\s-") nil t)
+ (concat entry-regexp (regexp-quote parent) "\\s-") nil t)
(setq level (match-string-no-properties hyrolo-entry-group-number))
(error "(hyrolo-add): Insertion failed, `%s' parent entry not found in
\"%s\""
parent file)))
@@ -236,33 +240,33 @@ entry which begins with the parent string."
;; entry by moving to an entry with the same (or nearest) first character
;; to that of `name'.
(if (and (= level-len 1)
- (equal hyrolo-entry-regexp "^\\(\\*+\\)\\([ \t]+\\)"))
+ (equal entry-regexp "^\\(\\*+\\)\\([ \t]+\\)"))
(let ((case-fold-search))
(goto-char (point-min))
- (if (re-search-forward (concat hyrolo-entry-regexp
+ (if (re-search-forward (concat entry-regexp
(regexp-quote (char-to-string
first-char)))
nil t)
(goto-char (match-beginning 0))
(goto-char (point-max))
- (if (and (> first-char ?0)
- (re-search-backward
- (concat "^\\*[ \t]+["
- (substring
-
"0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_`abcdefghijklmnopqrstuvwxyz"
- 0 (min (- first-char ?0) 62))
- "])")
- nil t))
- (progn (goto-char (match-end 0))
- (hyrolo-to-entry-end t level-len)
- ;; Now at the insertion point, immediately after
- ;; the last existing entry whose first character
- ;; is less than that of `name'. Setting `again'
- ;; to nil prevents further searching for an
- ;; insertion point.
- (setq again nil)))))
+ (when (and (> first-char ?0)
+ (re-search-backward
+ (concat "^\\*[ \t]+["
+ (substring
+
"0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_`abcdefghijklmnopqrstuvwxyz"
+ 0 (min (- first-char ?0) 62))
+ "])")
+ nil t))
+ (goto-char (match-end 0))
+ (hyrolo-to-entry-end t level-len)
+ ;; Now at the insertion point, immediately after
+ ;; the last existing entry whose first character
+ ;; is less than that of `name'. Setting `again'
+ ;; to nil prevents further searching for an
+ ;; insertion point.
+ (setq again nil))))
(goto-char (point-min)))
- (while (and again (re-search-forward hyrolo-entry-regexp nil 'end))
+ (while (and again (re-search-forward entry-regexp nil 'end))
(setq entry-level-len (length (match-string-no-properties
hyrolo-entry-group-number)))
(if (/= entry-level-len level-len)
(hyrolo-to-entry-end t entry-level-len)
@@ -288,12 +292,14 @@ entry which begins with the parent string."
;; hyrolo-to-buffer may move point from its desired location, so
;; restore it.
(let ((opoint (point)))
- (widen)
+ (hyrolo-widen)
(hyrolo-to-buffer (current-buffer))
(goto-char opoint))
+ (when (derived-mode-p 'kotl-mode)
+ (kotl-mode:to-valid-position))
(run-hooks 'hyrolo-add-hook)
- (if (called-interactively-p 'interactive)
- (message "Edit entry at point.")))))
+ (when (called-interactively-p 'interactive)
+ (message "Edit entry at point.")))))
;;;###autoload
(defun hyrolo-display-matches (&optional display-buf return-to-buffer)
@@ -314,9 +320,6 @@ Second arg RETURN-TO-BUFFER is the buffer to leave point
within after the displa
(error (get-buffer-window display-buf)))
(setq hyrolo--wconfig (current-window-configuration)))
(hyrolo-to-buffer display-buf)
- (unless (eq major-mode 'hyrolo-mode)
- (hyrolo-mode))
- (setq buffer-read-only nil)
(when (fboundp 'hproperty:but-create)
(hproperty:but-create))
(hyrolo-shrink-window)
@@ -364,12 +367,15 @@ parent entry which begins with the parent string."
(message "(hyrolo-edit): `%s' not found." name)
(beep)
(hyrolo-to-buffer (or (get-file-buffer (car file-list))
- (find-file-noselect (car file-list))))
+ (find-file-noselect (car file-list))))
(setq buffer-read-only nil))
- (widen)
+ (hyrolo-widen)
;; hyrolo-to-buffer may have moved point from its desired location, so
;; restore it.
- (if found-point (goto-char found-point))
+ (when found-point
+ (goto-char found-point))
+ (when (derived-mode-p 'kotl-mode)
+ (kotl-mode:to-valid-position))
(run-hooks 'hyrolo-edit-hook))))
(defun hyrolo-edit-entry ()
@@ -439,6 +445,14 @@ the logical expression matching."
(funcall hyrolo-find-file-function file)
(setq buffer-read-only nil)))
+(defun hyrolo-forward-visible-line (&optional arg)
+ "Move forward by optional ARG lines (default = 1), ignoring currently
invisible newlines only.
+If ARG is negative, move backward -ARG lines.
+If ARG is zero, move to the beginning of the current line."
+ (unless arg
+ (setq arg 1))
+ (forward-visible-line arg))
+
;;;###autoload
(defun hyrolo-grep (regexp &optional max-matches hyrolo-file-or-bufs
count-only no-display)
"Display rolo entries matching REGEXP and return count of matches.
@@ -446,7 +460,7 @@ To a maximum of prefix arg MAX-MATCHES, in buffer(s) from
optional HYROLO-FILE-O
hyrolo-file-list. Default is to find all matching entries. Each entry is
displayed with all of its sub-entries. Optional COUNT-ONLY non-nil means don't
retrieve and don't display matching entries. Optional NO-DISPLAY non-nil
-means retrieve entries but don't display.
+vmeans retrieve entries but don't display.
Nil value of MAX-MATCHES means find all matches, t value means find all matches
but omit file headers, negative values mean find up to the inverse of that
@@ -463,19 +477,27 @@ Return number of entries matched. See also documentation
for the variable
((list hyrolo-file-or-bufs))))
(case-fold-search t)
(display-buf (unless count-only
- (set-buffer (get-buffer-create hyrolo-display-buffer))))
+ (hyrolo-set-display-buffer)))
(total-matches 0)
(num-matched 0)
(inserting (or (eq max-matches t)
(and (integerp max-matches) (< max-matches 0))))
- (file))
+ (hyrolo-entry-regexps (set:create))
+ (outline-regexps (set:create))
+ (file)
+ hyrolo-buf)
(unless count-only
(setq buffer-read-only nil)
(or inserting (erase-buffer)))
(while (and (setq file (car hyrolo-file-list))
(or (not (integerp max-matches))
(< total-matches (max max-matches (- max-matches)))))
- (setq hyrolo-file-list (cdr hyrolo-file-list)
+ (setq hyrolo-buf (find-file-noselect file t)
+ hyrolo-entry-regexps (set:add (buffer-local-value
'hyrolo-entry-regexp hyrolo-buf)
+ hyrolo-entry-regexps)
+ outline-regexps (set:add (buffer-local-value 'outline-regexp
hyrolo-buf)
+ outline-regexps)
+ hyrolo-file-list (cdr hyrolo-file-list)
num-matched (cond ((and (featurep 'bbdb) (equal file bbdb-file))
(hyrolo-bbdb-grep-file file regexp max-matches
count-only))
((and (hyrolo-google-contacts-p) (equal file
google-contacts-buffer-name))
@@ -489,6 +511,15 @@ Return number of entries matched. See also documentation
for the variable
(- max-matches num-matched)
(+ max-matches num-matched)))))
(unless (or count-only no-display inserting (= total-matches 0))
+ (set-buffer display-buf)
+ (when hyrolo-entry-regexps
+ (setq hyrolo-entry-regexp (string-join hyrolo-entry-regexps "\\|"))
+ (unless (string-prefix-p hyrolo-hdr-regexp hyrolo-entry-regexp)
+ (setq hyrolo-entry-regexp (concat hyrolo-hdr-regexp "\\|"
hyrolo-entry-regexp))))
+ (when outline-regexps
+ (setq outline-regexp (string-join outline-regexps "\\|"))
+ (unless (string-prefix-p hyrolo-hdr-regexp outline-regexp)
+ (setq outline-regexp (concat hyrolo-hdr-regexp "\\|"
outline-regexp))))
(hyrolo-display-matches display-buf))
(when (called-interactively-p 'interactive)
(message "%s matching entr%s found in rolo."
@@ -617,7 +648,8 @@ Return t if entry is killed, nil otherwise."
(message "(hyrolo-mail-to): Invalid buffer or no e-mail address
found"))))
(defun hyrolo-next-match ()
- "Move point forward to the start of the next rolo search match."
+ "Move point forward to the start of the next rolo search match.
+Raise an error if a match is not found."
(interactive)
(hyrolo-verify)
(let ((start (point))
@@ -649,13 +681,15 @@ With a prefix argument of LEVELS-TO-SHOW > 0, show the
first lines of entries on
(hyrolo-show-levels levels-to-show))
(defun hyrolo-previous-match ()
- "Move point back to the start of the previous rolo search match."
+ "Move point back to the start of the previous rolo search match.
+This could be the current match if point is past its `hyrolo-match-regexp'.
+Raise an error if a match is not found."
(interactive)
(hyrolo-verify)
(let ((case-fold-search t))
- (unless (re-search-backward hyrolo-match-regexp nil t)
- (error
- "(hyrolo-previous-match): No prior matches for \"%s\""
hyrolo-match-regexp))))
+ (or (re-search-backward hyrolo-match-regexp nil t)
+ (error
+ "(hyrolo-previous-match): No prior matches for \"%s\""
hyrolo-match-regexp))))
(defun hyrolo-prompt (keyboard-function prompt)
"Use KEYBOARD-FUNCTION to PROMPT for a yes/no answer."
@@ -696,10 +730,16 @@ With a prefix argument of LEVELS-TO-SHOW > 0, show the
first lines of entries on
(message "(HyRolo): Your personal rolo file is now: \"%s\"."
new-file))))
+(defun hyrolo-set-display-buffer ()
+ (prog1 (set-buffer (get-buffer-create hyrolo-display-buffer))
+ (unless (eq major-mode 'hyrolo-mode)
+ (hyrolo-mode))
+ (setq buffer-read-only nil)))
+
;;;###autoload
(defun hyrolo-sort (&optional hyrolo-file)
"Sort up to 14 levels of entries in HYROLO-FILE (default is personal rolo).
-Assume entries are delimited by one or more `*'characters.
+Assume entries are delimited by one or more `*' characters.
Return list of number of groupings at each entry level."
(interactive
(list (let ((default "")
@@ -757,13 +797,6 @@ of groupings sorted."
;; This wraps forward-visible-line, making its ARG optional, making
;; its calling convention match that of forward-line.
-(defun hyrolo-forward-visible-line (&optional arg)
- "Move forward by optional ARG lines (default = 1), ignoring currently
invisible newlines only.
-If ARG is negative, move backward -ARG lines.
-If ARG is zero, move to the beginning of the current line."
- (unless arg
- (setq arg 1))
- (forward-visible-line arg))
;; Derived from `sort-lines' in "sort.el" since through at least Emacs 25.0
;; invisible lines are not grouped with the prior visible line, making
@@ -805,8 +838,8 @@ With optional ARG, turn them on iff ARG is positive."
"Toggle between display of current entry and display of all matched entries.
Useful when bound to a mouse key."
(interactive)
- (if (hyrolo-narrowed-p)
- (widen)
+ (if (buffer-narrowed-p)
+ (hyrolo-widen)
(when (or (looking-at hyrolo-entry-regexp)
(re-search-backward hyrolo-entry-regexp nil t))
(forward-char)
@@ -815,12 +848,19 @@ Useful when bound to a mouse key."
(goto-char (point-min)))
(defun hyrolo-top-level ()
- "Show only the first line of all `top-level' rolo matches."
+ "Show only the first line of all top-level hyrolo matches.
+Top-level matches are those with the lowest outline level among the
+matched entries."
(interactive)
(hyrolo-verify)
(hyrolo-hide-subtree)
(hyrolo-show-levels 1))
+(defun hyrolo-widen ()
+ "Widen non-special HyRolo buffers mainly for adding entries or editing them."
+ (unless (eq (get major-mode 'mode-class) 'special)
+ (widen)))
+
;;;###autoload
(defun hyrolo-word (string &optional max-matches hyrolo-file count-only
no-display)
"Display rolo entries with whole word match for STRING.
@@ -1119,8 +1159,10 @@ otherwise just use the cdr of the item."
(helm-org-rifle-files files)))
;;;###autoload
-(defun hyrolo-org ()
- "Prompt for patterns and search Org directory files for string or
logic-based matches."
+(defun hyrolo-org (string &optional max-matches)
+ "Prompt for patterns and search Org directory files for STRING or
logic-based matches.
+OPTIONAL prefix arg, MAX-MATCHES, limits the number of matches
+returned to the number given."
(interactive "sFind Org directory string (or logical expression): \nP")
(require 'org)
(unless (file-readable-p org-directory)
@@ -1128,13 +1170,15 @@ otherwise just use the cdr of the item."
(if (file-readable-p org-directory)
(if (fboundp #'helm-org-rifle-org-directory)
(helm-org-rifle-org-directory)
- (let ((hyrolo-file-list (cddr (directory-files org-directory t
"\\.org$"))))
+ (let ((hyrolo-file-list (directory-files org-directory t "\\.org$")))
(hyrolo-fgrep string max-matches)))
(error "(hyrolo-org): `org-directory', \"%s\", does not exist"
org-directory)))
;;;###autoload
(defun hyrolo-org-roam (string &optional max-matches)
- "Search Org Roam directory files for string or logic-based matches."
+ "Search Org Roam directory files for STRING or logic-based matches.
+OPTIONAL prefix arg, MAX-MATCHES, limits the number of matches
+returned to the number given."
(interactive "sFind Org Roam directory string (or logical expression): \nP")
(unless (package-installed-p 'org-roam)
(package-install #'org-roam))
@@ -1144,7 +1188,7 @@ otherwise just use the cdr of the item."
(unless org-roam-db-autosync-mode
(org-roam-db-autosync-mode))
(if (file-readable-p org-roam-directory)
- (let ((hyrolo-file-list (cddr (directory-files org-roam-directory t
"\\.org$"))))
+ (let ((hyrolo-file-list (directory-files org-roam-directory t
"\\.org$")))
(hyrolo-fgrep string max-matches))
(error "(hyrolo-org-roam): `org-roam-directory', \"%s\", does not exist"
org-roam-directory)))
@@ -1179,28 +1223,29 @@ Return number of matching entries found."
(delq 'magit-auto-revert-mode-enable-in-buffers
after-change-major-mode-hook)))
(if (and (or (null max-matches) (eq max-matches t) (integerp max-matches))
(or (setq actual-buf (hyrolo-buffer-exists-p hyrolo-file-or-buf))
- (if (file-exists-p hyrolo-file-or-buf)
- (setq actual-buf (find-file-noselect hyrolo-file-or-buf t)
- new-buf-p t))))
+ (when (file-exists-p hyrolo-file-or-buf)
+ (setq actual-buf (find-file-noselect hyrolo-file-or-buf t)
+ new-buf-p t))))
(let ((hdr-pos) (num-found 0) (curr-entry-level-len)
(incl-hdr t) start next-entry-exists)
- (if max-matches
- (cond ((eq max-matches t)
- (setq incl-hdr nil max-matches nil))
- ((< max-matches 0)
- (setq incl-hdr nil
- max-matches (- max-matches)))))
+ (when max-matches
+ (cond ((eq max-matches t)
+ (setq incl-hdr nil max-matches nil))
+ ((< max-matches 0)
+ (setq incl-hdr nil
+ max-matches (- max-matches)))))
(set-buffer actual-buf)
- (if new-buf-p (setq buffer-read-only t))
+ (when new-buf-p
+ (setq buffer-read-only t))
(save-excursion
(save-restriction
- (widen)
+ (hyrolo-widen)
;; Ensure no entries in outline mode are hidden.
- (if (fboundp #'outline-show-all) (outline-show-all))
+ (outline-show-all)
(goto-char (point-min))
- (if (re-search-forward hyrolo-hdr-regexp nil t 2)
- (progn (forward-line)
- (setq hdr-pos (cons (point-min) (point)))))
+ (when (re-search-forward hyrolo-hdr-regexp nil t 2)
+ (forward-line)
+ (setq hdr-pos (cons (point-min) (point))))
(re-search-forward hyrolo-entry-regexp nil t)
(while (and (or (null max-matches) (< num-found max-matches))
(re-search-forward regexp nil t))
@@ -1409,52 +1454,73 @@ Name is returned as `last, first-and-middle'."
(defun hyrolo-name-at ()
"If point is within an entry in `hyrolo-display-buffer', return the entry
name, else nil."
- (if (string-equal (buffer-name) hyrolo-display-buffer)
- (save-excursion
- (if (or (looking-at hyrolo-entry-regexp)
- (progn (end-of-line)
- (re-search-backward hyrolo-entry-regexp nil t)))
- (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")
- (if (or (looking-at "[^ \t\n\r]+ ?, ?[^ \t\n\r]+")
- (looking-at "\\( ?[^ \t\n\r]+\\)+"))
- (match-string-no-properties 0)))))))
-
-(defun hyrolo-narrowed-p ()
- (or (/= (point-min) 1) (/= (1+ (buffer-size)) (point-max))))
+ (when (string-equal (buffer-name) hyrolo-display-buffer)
+ (save-excursion
+ (beginning-of-line)
+ (when (looking-at hyrolo-entry-regexp)
+ (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (when (or (looking-at "[^ \t\n\r]+ ?, ?[^ \t\n\r]+")
+ (looking-at "\\( ?[^ \t\n\r]+\\)+"))
+ (match-string-no-properties 0))))))
(defun hyrolo-save-buffer (&optional hyrolo-buf)
"Save optional HYROLO-BUF if changed and `hyrolo-save-buffers-after-use' is
t.
Default is current buffer. Used, for example, after a rolo entry is killed."
- (or hyrolo-buf (setq hyrolo-buf (current-buffer)))
+ (unless hyrolo-buf
+ (setq hyrolo-buf (current-buffer)))
(and hyrolo-save-buffers-after-use (buffer-modified-p hyrolo-buf)
(set-buffer hyrolo-buf) (save-buffer)))
(defun hyrolo-set-date ()
- "Add a line with the current date at the end of the current rolo entry.
+ "Add a line with the current date at the end of the current hyrolo entry.
+Does not add a date if in a Koutline buffer.
+
Suitable for use as an entry in `hyrolo-add-hook' and `hyrolo-edit-hook'.
The date format is determined by the setting, `hyrolo-date-format', with
a default of MM/DD/YYYY."
- (save-excursion
- (skip-chars-forward "*")
- (hyrolo-to-entry-end)
- (skip-chars-backward " \t\n\r\f")
- (skip-chars-backward "^\n\r\f")
- (if (looking-at "\\s-+[-0-9./]+\\s-*$") ;; a date
- (progn (delete-region (point) (match-end 0))
- (insert "\t" (hyrolo-current-date)))
- (end-of-line)
- (insert "\n\t" (hyrolo-current-date)))))
+ (unless (derived-mode-p 'kotl-mode)
+ (save-excursion
+ (skip-chars-forward "*")
+ (hyrolo-to-entry-end)
+ (skip-chars-backward " \t\n\r\f")
+ (skip-chars-backward "^\n\r\f")
+ (if (looking-at "\\s-+[-0-9./]+\\s-*$") ;; a date
+ (progn (delete-region (point) (match-end 0))
+ (insert "\t" (hyrolo-current-date)))
+ (end-of-line)
+ (insert "\n\t" (hyrolo-current-date))))))
+
+(defun hyrolo-min-matched-level ()
+ "Return the minimum hyrolo level within a single file of matches."
+ (goto-char (point-min))
+ (let ((min-level (hyrolo-mode-outline-level)))
+ (while (outline-next-heading)
+ (setq min-level (min min-level (hyrolo-mode-outline-level))))
+ min-level))
+
+(defun hyrolo-back-to-visible-point ()
+ (interactive)
+ (while (and (not (bobp)) (invisible-p (point)))
+ ;; Move back one character at a time here because using this fails
+ ;; and ends up at the beginning of buffer every time under Emacs 27.1:
+ ;; (goto-char (previous-single-char-property-change (point) 'invisible))))
+ (goto-char (1- (point)))))
(defun hyrolo-show-levels (num-levels)
- "Show only the first line of up to NUM-LEVELS of rolo matches. NUM-LEVELS
must be 1 or greater."
+ "Show only the first line of up to NUM-LEVELS of rolo matches. NUM-LEVELS
must be 1 or greater.
+NUM-LEVELS is relative to the first level of matches, so if NUM-LEVELS
+is 2 and the first level matched from an outline is level 3, then
+levels 3 and 4 will be shown."
(outline-show-all)
(save-excursion
(goto-char (point-min))
(if (not (re-search-forward hyrolo-hdr-regexp nil t 2))
(outline-hide-sublevels num-levels)
(goto-char (point-min))
- (let (start end)
+ (let (start
+ end
+ max-level-to-show)
(while (re-search-forward hyrolo-hdr-regexp nil t 2)
(forward-line)
(setq start (point)
@@ -1463,11 +1529,19 @@ a default of MM/DD/YYYY."
(goto-char (point-max))))
(save-restriction
(narrow-to-region start end)
- (outline-hide-sublevels num-levels)))))
+ (if (> num-levels 20)
+ (setq max-level-to-show num-levels)
+ (setq max-level-to-show (+ (hyrolo-min-matched-level)
+ (1- num-levels))))
+ (outline-hide-sublevels max-level-to-show)))))
+ (goto-char (point-min))
;; This pause forces a window redisplay that maximizes the
;; entries displayed for any final location of point.
- (goto-char (point-min))
- (sit-for 0.001)))
+ (sit-for 0.001))
+ ;; Need to leave point on a visible character or since
+ ;; hyrolo uses reveal-mode, redisplay will rexpand
+ ;; hidden entries to make point visible.
+ (hyrolo-back-to-visible-point))
(defun hyrolo-shrink-window ()
(let* ((lines (count-lines (point-min) (point-max)))
@@ -1499,7 +1573,7 @@ Return point where matching entry begins or nil if not
found."
(error "(hyrolo-to): File not readable: `%s'" file)))
(set-buffer (or (get-file-buffer file) (find-file-noselect file)))
(let ((case-fold-search t) (real-name name) (parent "") (level) end)
- (widen) (goto-char 1)
+ (hyrolo-widen) (goto-char 1)
(while (string-match "\\`[^\]\[<>{}\"]*/" name)
(setq end (1- (match-end 0))
level nil
@@ -1531,7 +1605,7 @@ Return point where matching entry begins or nil if not
found."
(point))))))))
(unless found
(hyrolo-kill-buffer))) ;; conditionally kill
- (widen)
+ (hyrolo-widen)
found))
(defun hyrolo-to-buffer (buffer &optional other-window-flag _frame)
@@ -1556,6 +1630,23 @@ Return current point."
(progn (beginning-of-line) (point))
(goto-char (point-max))))
+(defun hyrolo-mode-outline-level ()
+ "Heuristically determine `outline-level' function to use in HyRolo match
buffer."
+ (cond ((looking-at (default-value 'outline-regexp))
+ ;; on an entry from a star-outline
+ (funcall (default-value #'outline-level)))
+ ((looking-at hyrolo-hdr-regexp)
+ 0)
+ ((featurep 'kview)
+ ;; assume on an entry from an alpha or legal Koutline
+ ;; with default outline settings
+ (kcell-view:level)
+ (setq lbl-sep-len (length kview:default-label-separator))
+ (floor (/ (- (or (kcell-view:indent nil lbl-sep-len)) lbl-sep-len)
+ kview:default-level-indent)))
+ ;; Just default to top-level if no other outline type is found
+ (t 1)))
+
(defun hyrolo-mode ()
"Major mode for the rolo match buffer.
Calls the functions given by `hyrolo-mode-hook'.
@@ -1569,6 +1660,10 @@ Calls the functions given by `hyrolo-mode-hook'.
;;
(when (fboundp 'outline-minor-mode)
(outline-minor-mode 1))
+ (make-local-variable 'hyrolo-entry-regexp)
+ (setq hyrolo-entry-regexp (default-value 'hyrolo-entry-regexp))
+ (make-local-variable 'outline-level)
+ (setq outline-level #'hyrolo-mode-outline-level)
(reveal-mode 1) ;; Expose hidden text as move into it.
(run-hooks 'hyrolo-mode-hook))
diff --git a/kotl/kotl-mode.el b/kotl/kotl-mode.el
index 5a657d5940..675283367b 100644
--- a/kotl/kotl-mode.el
+++ b/kotl/kotl-mode.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 6/30/93
-;; Last-Mod: 17-Jul-22 at 16:25:03 by Mats Lidell
+;; Last-Mod: 20-Aug-22 at 18:29:51 by Bob Weiner
;;
;; Copyright (C) 1993-2022 Free Software Foundation, Inc.
;; See the "../HY-COPY" file for license information.
@@ -69,6 +69,9 @@ Normally set from the UNDO element of a yank-handler; see
`insert-for-yank'.")
;;; Public functions
;;; ************************************************************************
+;; Koutline mode is suitable only for specially formatted data.
+(put 'kotl-mode 'mode-class 'special)
+
;;;###autoload
(defun kotl-mode ()
"The major mode used to edit and view koutlines.
@@ -95,15 +98,17 @@ It provides the following keys:
;; from save-some-buffers, {C-x s}.
(add-hook 'write-file-functions #'kotl-mode:update-buffer nil 'local)
(mapc #'make-local-variable
- '(kotl-previous-mode indent-line-function indent-region-function
- outline-isearch-open-invisible-function
- outline-regexp
- line-move-ignore-invisible minor-mode-alist
- selective-display-ellipses
- paragraph-separate paragraph-start))
+ '(hyrolo-entry-regexp kotl-previous-mode
+ indent-line-function indent-region-function
+ outline-isearch-open-invisible-function
+ outline-level outline-regexp
+ line-move-ignore-invisible minor-mode-alist
+ selective-display-ellipses
+ paragraph-separate paragraph-start))
;; Used by kimport.el functions.
(unless (and (boundp 'kotl-previous-mode) kotl-previous-mode)
- (setq kotl-previous-mode major-mode
+ (setq hyrolo-entry-regexp (concat "^" kview:outline-regexp)
+ kotl-previous-mode major-mode
;; Remove outline minor-mode mode-line indication.
minor-mode-alist (copy-sequence minor-mode-alist)
minor-mode-alist (set:remove '(outline-minor-mode " Outl")
@@ -115,7 +120,8 @@ It provides the following keys:
;; Remove indication that buffer is narrowed.
mode-line-format (copy-sequence mode-line-format)
mode-line-format (set:remove "%n" mode-line-format)
- outline-regexp (concat " *[0-9][0-9a-z.]*"
kview:default-label-separator)))
+ outline-level #'kcell-view:level
+ outline-regexp kview:outline-regexp))
;;
(when (fboundp 'add-to-invisibility-spec)
(add-to-invisibility-spec '(outline . t)))
diff --git a/kotl/kview.el b/kotl/kview.el
index ca8f84ac12..5c0258c4b6 100644
--- a/kotl/kview.el
+++ b/kotl/kview.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 6/30/93
-;; Last-Mod: 17-Jul-22 at 16:22:51 by Mats Lidell
+;; Last-Mod: 11-Aug-22 at 00:31:40 by Bob Weiner
;;
;; Copyright (C) 1993-2022 Free Software Foundation, Inc.
;; See the "../HY-COPY" file for license information.
@@ -56,6 +56,9 @@ Default value is \". \"."
:type 'string
:group 'hyperbole-koutliner)
+(defconst kview:outline-regexp (concat "\\( *\\)[0-9][0-9a-z.]*\\("
kview:default-label-separator "\\)")
+ "Koutline view `outline-regexp' value that handles all label formats.")
+
(defcustom kview:default-label-type 'alpha
"*Default label-type to use for new koutlines. Default value is 'alpha.
It must be one of the following symbols:
diff --git a/test/demo-tests.el b/test/demo-tests.el
index 1bbfa6b9e6..e21228b1e3 100644
--- a/test/demo-tests.el
+++ b/test/demo-tests.el
@@ -578,15 +578,15 @@ enough files with matching mode loaded."
(existing-shell-flag (get-buffer-process shell-buffer-name)))
(unwind-protect
(with-temp-buffer
- (insert "{M-x shell RET M-> (apropos grep) RET}")
+ (insert "{M-x shell RET M-> (time apropos grep) RET RET}")
(goto-char 5)
(action-key)
(hy-test-helpers:consume-input-events)
(with-current-buffer shell-buffer-name
(with-timeout (5 (ert-fail "Test timed out"))
- (while (not (string-match-p "\ngrep ?(1).*-"
(buffer-substring-no-properties (point-min) (point-max))))
+ (while (not (string-match-p "grep ?(1).*-"
(buffer-substring-no-properties (point-min) (point-max))))
(accept-process-output (get-buffer-process
shell-buffer-name))))
- (should (string-match-p "\ngrep ?(1).*-"
(buffer-substring-no-properties (point-min) (point-max))))))
+ (should (string-match-p "grep ?(1).*-"
(buffer-substring-no-properties (point-min) (point-max))))))
(unless existing-shell-flag
(set-process-query-on-exit-flag (get-buffer-process shell-buffer-name)
nil)
(hy-test-helpers:kill-buffer shell-buffer-name)))))
diff --git a/test/hyrolo-tests.el b/test/hyrolo-tests.el
index e434f6eaf0..280743a083 100644
--- a/test/hyrolo-tests.el
+++ b/test/hyrolo-tests.el
@@ -160,6 +160,7 @@
(should (hact 'kbd-key "<"))
(should (equal (point) (point-min)))
+ (re-search-forward hyrolo-hdr-regexp nil t 2)
(should (hact 'kbd-key "n"))
(should (looking-at "\\*\\*\\s-+Strong"))
@@ -178,10 +179,12 @@
(load "../hyrolo-demo")
(should (hact 'kbd-key "C-x 4r com RET TAB"))
(hy-test-helpers:consume-input-events)
+
(should (string= (buffer-name) "*Hyperbole Rolo*"))
(should (hact 'kbd-key "<"))
(should (equal (point) (point-min)))
+ (re-search-forward hyrolo-hdr-regexp nil t 2)
(should (hact 'kbd-key "n"))
(should (looking-at "\\*\\*\\s-+Strong"))
