branch: externals/hyperbole
commit bcc6ebd03141f4c54149452659f31923ea5f8097
Author: bw <r...@gnu.org>
Commit: bw <r...@gnu.org>
Highlight [HyWikiWord], <HyWikiWord>, not [[HyWikiWord]], <<HyWikiWord>>
Handle delete commands that may affect whether or not a HyWikiWord is
highlighted.
---
ChangeLog | 48 ++++++
hbut.el | 11 +-
hsys-org-roam.el | 9 +-
hsys-org.el | 55 +++----
hyrolo.el | 9 +-
hywiki.el | 447 ++++++++++++++++++++++++++++++++++++-------------------
6 files changed, 386 insertions(+), 193 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index e47deb3513..5c093c48ef 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,12 +1,60 @@
+2024-07-28 Bob Weiner <r...@gnu.org>
+
* hproperty.el (hproperty:but-add): Add a button only when a button with the
same property
value, start, and end does not already exist, to prevent duplicates.
+* hywiki.el (hywiki-maybe-highlight-page-name): Fix to dehighlight wiki words
only if within
+ double square or angle brackets (leaving these to Org to handle).
+ (hywiki-buttonize-non-character-commands): Add 'delete-' commands.
+ (hywiki--highlighting-done-flag): Add and use in
'hywiki-maybe-highlight-page-name'.
+ (hywiki-maybe-highlight-org-element-backward,
+ hywiki-maybe-highlight-org-element-forward): Add these two functions.
+ (hywiki-maybe-highlight-page-names): Fix to not use whole buffer highlight
flag when
+ given a region.
+
+* hsys-org-roam.el (hsys-org-roam-tags-view):
+ hsys-org.el (hsys-org-tags-view):
+ hywiki.el (hywiki-tags-view):
+ hyrolo.el (hyrolo-tags-view): Add doc for 'match' arg.
+
+* hsys-org.el (hsys-org-get-agenda-tags): Rename arg from
+ 'org-consult-agenda-function' to 'agenda-tags-view-function' since does
+ not require the consult package and don't want to override any org
+ package name. Improve doc string.
+ (hsys-org--agenda-tags-string): Improve doc string and fix to
return
+ non-nil only when point is within a tag string. Simplify return value
creation.
+
+2024-07-15 Bob Weiner <r...@gnu.org>
+
+* hywiki.el (hywiki-in-page-p): Change to use 'default-directory' instead
+ of 'buffer-file-name' so works with temp buffers created during Org
+ export to other formats, e.g. html.
+
+2024-07-14 Bob Weiner <r...@gnu.org>
+
+* hywiki.el (hywiki-convert-words-to-org-links, hywiki-map-words): Add.
+
* hibtypes.el (Info-node): Handle decoding of Info node names in
Hyperbole Help buffer lbl-key: lines, eliminating excess underscores.
* hmouse-tag.el (smart-lisp-mode-p): Add 'help-mode', e.g. for output of {C-h
A}
to make Hyperbole cross-references work.
+2024-07-13 Bob Weiner <r...@gnu.org>
+
+* hywiki.el (hywiki--range): Add to hold (start . end) range values.
+ (hywiki-word-at): If word is already highlighted with
+ 'hywiki-word-face', use that as a shortcut to get the word.
+ (hywiki-buttonize-word): Add.
+ (hywiki-maybe-highlight-page-name): Rewrite to use above function.
+
+2024-07-10 Bob Weiner <r...@gnu.org>
+
+* hywiki.el (hywiki-org-link-export): Add as [[hy:WikiWord]] link-export
property.
+ (hywiki-org-link-resolve): Add to resolve HyWikiWord link to its
page.
+ (hywiki-org-link-store): Change :description property to be just
+ the 'page-name' itself.
+
2024-07-07 Bob Weiner <r...@gnu.org>
* hibtypes.el (elisp-compiler-msg): Fix to handle both of these cases:
diff --git a/hbut.el b/hbut.el
index e89a9688c1..ce4967ce6a 100644
--- a/hbut.el
+++ b/hbut.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 18-Sep-91 at 02:57:09
-;; Last-Mod: 7-Jul-24 at 14:57:30 by Bob Weiner
+;; Last-Mod: 15-Jul-24 at 01:42:17 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -2246,11 +2246,12 @@ first encountered."
Without the start and end delimiter arguments, this is the normalized
key form of the optional name that may precede an implicit button.
If the delimiter arguments are given, return the key form of the
-implicit button text at point between those delimiters. Assume point is
-within the first line of any button.
+implicit button text at point between those delimiters. Point must be
+within the first line and after the opening delimiter of any button to
+get the key.
-Use `ibut:at-p' instead to test if point is on either the implicit
-button text itself or the name.
+Alternatively, use `ibut:at-p' to test if point is on either the
+implicit button text itself or the name.
All following arguments are optional. If AS-LABEL is non-nil, label is
returned rather than the key derived from the label. START-DELIM and
diff --git a/hsys-org-roam.el b/hsys-org-roam.el
index 52c674b3e8..62e34bbfcf 100644
--- a/hsys-org-roam.el
+++ b/hsys-org-roam.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 26-Feb-23 at 11:20:15 by Bob Weiner
-;; Last-Mod: 7-Jul-24 at 17:04:57 by Bob Weiner
+;; Last-Mod: 28-Jul-24 at 12:33:29 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -67,8 +67,11 @@ Actual grep function used is given by the variable,
(defun hsys-org-roam-tags-view (&optional todo-only match view-buffer-name)
"Prompt for colon-separated Org Roam tags and display matching headlines.
With optional prefix arg TODO-ONLY, limit matches to Org Roam
-todo items only. With optional VIEW-BUFFER-NAME, use that rather
-than the default, \"*Org Roam Tags*\"."
+todo items only. With optional MATCH, an Org tags match selector
+string, e.g. \":tag1:tag2:tag3:\", match to sections that contain
+or inherit all of these tags, regardless of tag order. With
+optional VIEW-BUFFER-NAME, use that rather than the default,
+\"*Org Roam Tags*\"."
(interactive "P")
(require 'org-agenda)
(hypb:require-package 'org-roam)
diff --git a/hsys-org.el b/hsys-org.el
index 539f82d580..b2c80de83f 100644
--- a/hsys-org.el
+++ b/hsys-org.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 2-Jul-16 at 14:54:14
-;; Last-Mod: 7-Jul-24 at 21:52:26 by Bob Weiner
+;; Last-Mod: 28-Jul-24 at 12:33:05 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -154,7 +154,7 @@ an error."
;;;###autoload
(defun hsys-org-agenda-tags-p ()
- "When on an Org tag, return appropriate `org-tags-view' function.
+ "When on an Org tag, return appropriate `org-tags-view'-like function.
Use `default-directory' and buffer name to determine which function to
call."
(when (hsys-org-at-tags-p)
@@ -167,17 +167,19 @@ call."
((hyrolo-at-tags-p t)
#'hsys-org-hyrolo-agenda-tags))))
-(defun hsys-org-get-agenda-tags (org-consult-agenda-function)
- "When on an Org tag, call ORG-CONSULT-AGENDA-FUNCTION to find matches.
+(defun hsys-org-get-agenda-tags (agenda-tags-view-function)
+ "When on an Org tag, call AGENDA-TAGS-VIEW-FUNCTION to find matches.
If on a colon, match to sections with all tags around point;
otherwise, just match to the single tag around point.
The function determines the org files searched for matches and is
-given two arguments when called: a regexp of tags to match and a 0
-max-count which finds all matches within headlines only."
+given two arguments when called: a null value to tell it to match to
+all headlines, not just todos and an Org tags match selector string,
+e.g. \":tag1:tag2:tag3:\". Headlines that contain or inherit all of
+these tags will be displayed, regardless of tag order."
(interactive)
(when (hsys-org-at-tags-p)
- (funcall org-consult-agenda-function nil (hsys-org--agenda-tags-string))))
+ (funcall agenda-tags-view-function nil (hsys-org--agenda-tags-string))))
(defun hsys-org-hyrolo-agenda-tags ()
"When on a HyRolo tag, use `hyrolo-tags-view' to list all HyRolo tag matches.
@@ -211,8 +213,11 @@ otherwise, just match to the single tag around point."
(defun hsys-org-tags-view (&optional todo-only match view-buffer-name)
"Prompt for colon-separated Org tags and display matching Org headlines.
With optional prefix arg TODO-ONLY, limit matches to Org todo
-items only. With optional VIEW-BUFFER-NAME, use that rather than
-the default, \"*Org Tags*\"."
+items only. With optional MATCH, an Org tags match selector
+string, e.g. \":tag1:tag2:tag3:\", match to sections that contain
+or inherit all of these tags, regardless of tag order. With
+optional VIEW-BUFFER-NAME, use that rather than the default,
+\"*Org Tags*\"."
(interactive "P")
(require 'org-agenda)
(let* ((org-agenda-files (list org-directory))
@@ -658,24 +663,22 @@ TARGET must be a string."
(defun hsys-org--agenda-tags-string ()
"When on or between Org tags, return an agenda match string for them.
-If on a colon, match to headlines with all tags around point, in any order.
-e.g. \":tag1: :tag2: :tag3: \". Otherwise, just match to the single
-tag around point."
- (let (range
+If on a colon, return a match string for all tags around point,
+e.g. \":tag1:tag2:tag3:\", that will match to these tags in any order.
+Otherwise, just match to the single tag around point, e.g. tag2."
+ (let ((range (hproperty:char-property-range nil 'face 'org-tag))
tags)
- (if (equal (char-after) ?:)
- ;; On colon, search for HyWiki headings with all tags on line
- (setq range (hproperty:char-property-range nil 'face 'org-tag)
- tags (when range (buffer-substring-no-properties (car range) (cdr
range))))
- ;; Else on a specific tag, search for HyWiki headings with that tag
only
- (setq range (hargs:delimited ":" ":" nil nil t)
- tags (nth 0 range)
- range (cons (nth 1 range) (nth 2 range))))
- (when (and tags range)
- (ibut:label-set tags (car range) (cdr range))
- (concat ":" (string-join (mapcar (lambda (tag) (regexp-quote tag))
- (split-string tags ":" t))
- ":")))))
+ (when range
+ (if (equal (char-after) ?:)
+ ;; On colon, search for HyWiki headings with all tags on line
+ (setq tags (when range (buffer-substring-no-properties (car range)
(cdr range))))
+ ;; Else on a specific tag, search for HyWiki headings with that tag
only
+ (setq range (hargs:delimited ":" ":" nil nil t)
+ tags (nth 0 range)
+ range (cons (nth 1 range) (nth 2 range))))
+ (when (and tags range)
+ (ibut:label-set tags (car range) (cdr range))
+ tags))))
(defun hsys-org--set-fold-style ()
"Set `org-fold-core-style' to \\='overlays for `reveal-mode' compatibility.
diff --git a/hyrolo.el b/hyrolo.el
index 3973790437..22056cf3e4 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: 7-Jul-24 at 21:47:43 by Bob Weiner
+;; Last-Mod: 28-Jul-24 at 12:31:58 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1395,8 +1395,11 @@ the sort order."
(defun hyrolo-tags-view (&optional todo-only match view-buffer-name)
"Prompt for colon-separated Org tags and display matching HyRolo sections.
With optional prefix arg TODO-ONLY, limit matches to HyRolo Org
-todo items only. With optional VIEW-BUFFER-NAME, use that rather
-than the default, \"*HyRolo Tags*\"."
+todo items only. With optional MATCH, an Org tags match selector
+string, e.g. \":tag1:tag2:tag3:\", match to sections that contain
+or inherit all of these tags, regardless of tag order. With
+optional VIEW-BUFFER-NAME, use that rather than the default,
+\"*HyRolo Tags*\"."
(interactive "P")
(require 'org-agenda)
(let* ((org-agenda-files (hyrolo-get-file-list))
diff --git a/hywiki.el b/hywiki.el
index 31ca054699..52363f79df 100644
--- a/hywiki.el
+++ b/hywiki.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 21-Apr-24 at 22:41:13
-;; Last-Mod: 7-Jul-24 at 23:15:29 by Bob Weiner
+;; Last-Mod: 30-Jul-24 at 23:49:43 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -41,8 +41,9 @@
;; As HyWikiWords are typed, highlighting occurs after a trailing
;; whitespace or punctuation character is added, or when an opening
;; or closing parenthesis or curly brace is added to surround the
-;; HyWikiWord. Since Org links use square brackets and Org targets
-;; use angle brackets, HyWikiWords within these delimiters are ignored.
+;; HyWikiWord. Since Org links use double square brackets and Org
+;; targets use double or triple angle brackets, HyWikiWords within
+;; these delimiters are ignored.
;;
;; You can also create Org links to HyWikiWords in any non-special text
;; buffer by surrounding them with double square brackets and the
@@ -262,7 +263,7 @@ in `hywiki-mode'.")
(defconst hywiki--buttonize-character-regexp nil
"Regexp matching a single separating character following a HyWiki word.")
-(defconst hywiki--word-and-buttonize-character-regexp
+(defconst hywiki--word-and-buttonize-character-regexp nil
"Regexp matching HyWikiWord#section plus a valid word separating character.")
(defvar hywiki--directory-mod-time 0
@@ -291,7 +292,9 @@ in `hywiki-mode'.")
(defvar hywiki--but-start nil)
(defvar hywiki--current-page nil)
(defvar hywiki--end nil)
+(defvar hywiki--highlighting-done-flag t)
(defvar hywiki--page-name nil)
+(defvar hywiki--range nil)
(defvar hywiki--save-case-fold-search nil)
(defvar hywiki--save-org-link-type-required nil)
(defvar hywiki--start nil)
@@ -311,9 +314,19 @@ Triggered by `post-self-insert-hook' for self-inserting
characters."
"Turn any HyWikiWord before point into a highlighted Hyperbole button.
Triggered by `post-command-hook' for non-character-commands, e.g.
return/newline."
- (when (memq this-command hywiki-non-character-commands)
+ (when (or (memq this-command hywiki-non-character-commands)
+ (and (symbolp this-command)
+ (string-match-p "\\`\\(org-\\)?delete-" (symbol-name
this-command))))
(hywiki-maybe-highlight-page-name)))
+(defun hywiki-buttonize-word (func start end face)
+ "Create a HyWikiWord button by calling FUNC with START and END positions.
+Function may apply FACE to highlight the button or may transform it
+into an Org link, etc. Function operates on the current buffer and
+takes 3 arguments: `range-start', `range-end' and `face' to apply to
+the button."
+ (funcall func start end face))
+
(defun hywiki-get-buttonize-characters ()
"Return a string of Org self-insert keys that have punctuation/symbol
syntax."
(let (key
@@ -492,6 +505,15 @@ per file to the absolute value of MAX-MATCHES, if given
and not 0. If
(hsys-consult-grep grep-includes ripgrep-globs
regexp max-matches (or path-list (list
hywiki-directory)))))
+(defun hywiki-convert-words-to-org-links ()
+ "Convert all highlighted HyWiki words in current buffer to Org links."
+ (hywiki-map-words (lambda (overlay)
+ (goto-char (overlay-end overlay))
+ (insert "]]")
+ (goto-char (overlay-start overlay))
+ (insert "[[" hywiki-org-link-type ":")
+ (delete-overlay overlay))))
+
(defun hywiki-maybe-at-wikiword-beginning ()
"Return non-nil if previous character is one preceding a HyWiki word.
Does not test whether or not a page exists for the HyWiki word.
@@ -509,35 +531,42 @@ Does not test whether or not a page exists for the HyWiki
word; use
A call to `hywiki-active-in-current-buffer-p' must return non-nil or
this will return nil."
(when (hywiki-active-in-current-buffer-p)
- (let ((wikiword (ibut:label-p t "[[" "]]")))
- (if wikiword
- ;; Handle an Org link [[HyWikiWord]] [[hy:HyWikiWord]] or
[[HyWikiWord#section]].
- (progn
- ;; Don't use next line so don't have to load all of Org
- ;; mode just to check for HyWikiWords; however, disables
- ;; support for Org mode aliases.
- ;; (setq wikiword (org-link-expand-abbrev (org-link-unescape
(string-trim wikiword))))
- (setq wikiword (string-trim wikiword))
- ;; Ignore prefixed, typed hy:HyWikiWord since Org mode will display
those.
- (when (hywiki-is-wikiword wikiword)
- wikiword))
- ;; Handle a HyWiki word with optional #section; if it is an Org
- ;; link, it may optionally have a hy: link-type prefix.
- ;; Ignore wikiwords preceded by any non-whitespace
- ;; character, except any of these: "([\"'`'"
- (save-excursion
- (let ((case-fold-search nil))
- (skip-chars-backward "-_*#[:alnum:]")
- (when (hywiki-maybe-at-wikiword-beginning)
- (cond ((looking-at hywiki--word-and-buttonize-character-regexp)
- (string-trim
- (buffer-substring-no-properties (match-beginning 0)
- (1- (match-end 0)))))
- ((looking-at (concat
hywiki-word-with-optional-section-regexp "\\'"))
- ;; No following char
- (string-trim
- (buffer-substring-no-properties (match-beginning 0)
- (match-end 0))))))))))))
+ (if (setq hywiki--range
+ (hproperty:char-property-range (point) 'face hywiki-word-face))
+ (buffer-substring-no-properties (car hywiki--range) (cdr hywiki--range))
+ (save-excursion
+ (let ((wikiword (progn (when (looking-at "\\[\\[")
+ (goto-char (+ (point) 2)))
+ (ibut:label-p t "[[" "]]"))))
+ (if wikiword
+ ;; Handle an Org link [[HyWikiWord]] [[hy:HyWikiWord]] or
[[HyWikiWord#section]].
+ (progn
+ ;; Don't use next line so don't have to load all of Org
+ ;; mode just to check for HyWikiWords; however, disables
+ ;; support for Org mode aliases.
+ ;; (setq wikiword (org-link-expand-abbrev (org-link-unescape
(string-trim wikiword))))
+ (setq wikiword (string-trim wikiword
+ (format "[ \t\n\r]*\\(%s:\\)?"
+ hywiki-org-link-type)))
+ ;; Ignore prefixed, typed hy:HyWikiWord since Org mode will
display those.
+ (when (hywiki-is-wikiword wikiword)
+ wikiword))
+ ;; Handle a HyWiki word with optional #section; if it is an Org
+ ;; link, it may optionally have a hy: link-type prefix.
+ ;; Ignore wikiwords preceded by any non-whitespace
+ ;; character, except any of these: "([\"'`'"
+ (let ((case-fold-search nil))
+ (skip-chars-backward "-_*#[:alnum:]")
+ (when (hywiki-maybe-at-wikiword-beginning)
+ (cond ((looking-at hywiki--word-and-buttonize-character-regexp)
+ (string-trim
+ (buffer-substring-no-properties (match-beginning 0)
+ (1- (match-end 0)))))
+ ((looking-at (concat
hywiki-word-with-optional-section-regexp "\\'"))
+ ;; No following char
+ (string-trim
+ (buffer-substring-no-properties (match-beginning 0)
+ (match-end
0)))))))))))))
;;;###autoload
(defun hywiki-maybe-dehighlight-page-names (&optional region-start region-end)
@@ -567,35 +596,21 @@ interactively), limit dehighlighting to the region."
(or (zerop hywiki--directory-mod-time)
(/= hywiki--directory-mod-time (hywiki-directory-get-mod-time))))
-;;;###autoload
-(defun hywiki-tags-view (&optional todo-only match view-buffer-name)
- "Prompt for colon-separated Org tags and display matching HyWiki page
sections.
-With optional prefix arg TODO-ONLY, limit matches to HyWiki Org
-todo items only. With optional VIEW-BUFFER-NAME, use that rather
-than the default, \"*HyWiki Tags*\"."
- (interactive "P")
- (require 'org-agenda)
- (let* ((org-agenda-files (list hywiki-directory))
- (org-agenda-buffer-name (or view-buffer-name "*HyWiki Tags*"))
- ;; `org-tags-view' is mis-written to require setting this next
- ;; tmp-name or it will not properly name the displayed buffer.
- (org-agenda-buffer-tmp-name org-agenda-buffer-name))
- ;; This prompts for the tags to match and uses `org-agenda-files'.
- (org-tags-view todo-only match)
- (when (equal (buffer-name) org-agenda-buffer-name)
- ;; Set up {C-u r} redo cmd
- (let (buffer-read-only)
- (put-text-property (point-min) (point-max) 'org-redo-cmd
- `(hywiki-tags-view
- ,todo-only
- nil
- ,org-agenda-buffer-name)))
- (forward-line 2))))
-
(defun hywiki-highlight-on-yank (_prop-value start end)
"Used in `yank-handled-properties' called with START and END pos of the
text."
(hywiki-maybe-highlight-page-names start end))
+(defun hywiki-map-words (func)
+ "Apply FUNC across all HyWikiWords in the current buffer and return nil.
+FUNC takes 1 argument, the start and end buffer positions of each word
+and its option #section."
+ (save-excursion
+ (mapc (lambda (overlay)
+ (when (eq (overlay-get overlay 'face) hywiki-word-face)
+ (funcall func overlay)))
+ (overlays-in (point-min) (point-max)))
+ nil))
+
;;;###autoload
(defun hywiki-maybe-highlight-page-name (&optional on-page-name)
"Highlight any non-Org link HyWiki page#section at or one char before point.
@@ -617,100 +632,147 @@ the current page unless they have sections attached."
" _()<>$.\"'"))
(not executing-kbd-macro)
(not noninteractive))
- (with-syntax-table hbut:syntax-table
- (save-excursion
- (unless on-page-name
- ;; after page name
- (skip-syntax-backward "-"))
-
+ (setq hywiki--highlighting-done-flag nil)
+ (with-syntax-table hbut:syntax-table
(save-excursion
- (save-restriction
- ;; Limit sexp checks to a single line for speed since links and
- ;; targets should be on a single line.
- (narrow-to-region (line-beginning-position) (line-end-position))
- (cond ((memq (char-before) '(?\[ ?\<))
- ;; Clear any HyWikiWord highlighting within square or
- ;; angle brackets, as this may be a link or target.
- (ignore-errors
+ (unless on-page-name
+ ;; after page name
+ (skip-syntax-backward "-"))
+
+ (save-excursion
+ (save-restriction
+ ;; Limit sexp checks to a single line for speed since links and
+ ;; targets should be on a single line.
+ (narrow-to-region (line-beginning-position) (line-end-position))
+ (cond ((memq (char-before) '(?\[ ?\<))
(goto-char (1- (point)))
- (let* ((sexp-start (point))
- (sexp-end (scan-sexps sexp-start 1)))
- (when sexp-end
- (hproperty:but-clear-all-in-list
- (hproperty:but-get-all-in-region sexp-start sexp-end
'face hywiki-word-face))))))
- ((memq (char-before) '(?\( ?\{))
- ;; Highlight any HyWikiWords within parens or braces
- (ignore-errors
- (goto-char (1- (point)))
- (let* ((sexp-start (point))
- (sexp-end (scan-sexps sexp-start 1)))
- (when sexp-end
- (hywiki-maybe-highlight-page-names sexp-start
sexp-end)))))
- ((memq (char-before) '(?\] ?\>))
- ;; Clear any HyWikiWord highlighting within square or
- ;; angle brackets, as this may be a link or target.
- (ignore-errors
- (let* ((sexp-end (point))
- (sexp-start (scan-sexps sexp-end -1)))
- (when sexp-start
- (hproperty:but-clear-all-in-list
- (hproperty:but-get-all-in-region sexp-start sexp-end
'face hywiki-word-face))))))
- ((memq (char-before) '(?\) ?\}))
- ;; Highlight any HyWikiWords within parens or braces
- (ignore-errors
- (let* ((sexp-end (point))
- (sexp-start (scan-sexps sexp-end -1)))
- (when sexp-start
- (hywiki-maybe-highlight-page-names sexp-start
sexp-end))))))))
-
- (unless on-page-name
- ;; May be a closing delimiter that we have to skip past
- (skip-chars-backward (regexp-quote hywiki--buttonize-characters)))
- ;; Skip past HyWikiWord or section
- (skip-syntax-backward "^-$()<>._\"\'")
- (skip-chars-backward "-_*#[:alpha:]")
-
- (setq hywiki--save-case-fold-search case-fold-search
- case-fold-search nil
- hywiki--save-org-link-type-required hywiki-org-link-type-required
- hywiki-org-link-type-required t)
- (if (and (hywiki-maybe-at-wikiword-beginning)
- (looking-at hywiki--word-and-buttonize-character-regexp)
- (progn
- (setq hywiki--page-name (match-string-no-properties 1)
- hywiki--start (match-beginning 0)
- hywiki--end (1- (match-end 0)))
- (and (hywiki-get-page hywiki--page-name)
- ;; Ignore wikiwords preceded by any non-whitespace
character
- ;; (or (bolp) (memq (preceding-char) '(?\ ?\t)))
- )))
- (progn
- (setq hywiki--current-page (hywiki-get-buffer-page-name))
- ;; Don't highlight current-page matches unless they
- ;; include a #section.
- (unless (string-equal hywiki--current-page
- (buffer-substring-no-properties
hywiki--start hywiki--end))
- (if (setq hywiki--buts (hproperty:but-get-all-in-region
- hywiki--start hywiki--end
- 'face hywiki-word-face))
- (if (> (length hywiki--buts) 1)
- (progn (hproperty:but-clear-all-in-list hywiki--buts)
- (hproperty:but-add hywiki--start hywiki--end
hywiki-word-face))
- ;; There is only one existing button
- (setq hywiki--buts (car hywiki--buts)
- hywiki--but-start (hproperty:but-start hywiki--buts)
- hywiki--but-end (hproperty:but-end hywiki--buts))
- (unless (and (= hywiki--start hywiki--but-start)
- (= hywiki--end hywiki--but-end))
- (hproperty:but-delete hywiki--buts)
- (hproperty:but-add hywiki--start hywiki--end
hywiki-word-face)))
- (hproperty:but-add hywiki--start hywiki--end
hywiki-word-face))))
- ;; Remove any potential earlier highlighting since the
- ;; previous word may have changed.
- (skip-syntax-backward "^-$()<>._\"\'")
- (hproperty:but-clear-all-in-list
- (hproperty:but-get-all-in-region (point) (1+ (point))
- 'face hywiki-word-face)))))))
+ ;; Clear any HyWikiWord highlighting within double opening
+ ;; square or angle brackets, when this is a link or target
+ (hywiki-maybe-highlight-org-element-forward))
+ ((memq (char-after) '(?\[ ?\<))
+ ;; Clear any HyWikiWord highlighting within double opening
+ ;; square or angle brackets, when this is a link or target
+ (hywiki-maybe-highlight-org-element-forward))
+ ((memq (char-before) '(?\( ?\{))
+ ;; Highlight any HyWikiWords within opening parens or
braces
+ (ignore-errors
+ (goto-char (1- (point)))
+ (hywiki-maybe-highlight-sexp 1)))
+ ((memq (char-before) '(?\] ?\>))
+ ;; Clear any HyWikiWord highlighting within double closing
+ ;; square or angle brackets, as this may be a link or
target
+ (hywiki-maybe-highlight-org-element-backward))
+ ((memq (char-after) '(?\] ?\>))
+ (goto-char (1+ (point)))
+ ;; Clear any HyWikiWord highlighting within double closing
+ ;; square or angle brackets, as this may be a link or
target
+ (hywiki-maybe-highlight-org-element-backward))
+ ((memq (char-before) '(?\) ?\}))
+ ;; Highlight any HyWikiWords within closing parens or
braces
+ (ignore-errors
+ (hywiki-maybe-highlight-sexp -1))))))
+
+ (unless hywiki--highlighting-done-flag
+ (unless on-page-name
+ ;; May be a closing delimiter that we have to skip past
+ (skip-chars-backward (regexp-quote hywiki--buttonize-characters)))
+ ;; Skip past HyWikiWord or section
+ (skip-syntax-backward "^-$()<>._\"\'")
+ (skip-chars-backward "-_*#[:alpha:]")
+
+ (setq hywiki--save-case-fold-search case-fold-search
+ case-fold-search nil
+ hywiki--save-org-link-type-required
hywiki-org-link-type-required
+ hywiki-org-link-type-required t)
+ (if (and (hywiki-maybe-at-wikiword-beginning)
+ (looking-at hywiki--word-and-buttonize-character-regexp)
+ (progn
+ (setq hywiki--page-name (match-string-no-properties 1)
+ hywiki--start (match-beginning 0)
+ hywiki--end (1- (match-end 0)))
+ (and (hywiki-get-page hywiki--page-name)
+ ;; Ignore wikiwords preceded by any non-whitespace
character
+ ;; (or (bolp) (memq (preceding-char) '(?\ ?\t)))
+ )))
+ (progn
+ (setq hywiki--current-page (hywiki-get-buffer-page-name))
+ ;; Don't highlight current-page matches unless they
+ ;; include a #section.
+ (unless (string-equal hywiki--current-page
+ (buffer-substring-no-properties
hywiki--start hywiki--end))
+ (if (setq hywiki--buts (hproperty:but-get-all-in-region
+ hywiki--start hywiki--end
+ 'face hywiki-word-face))
+ (if (> (length hywiki--buts) 1)
+ (progn (hproperty:but-clear-all-in-list
hywiki--buts)
+ (hywiki-buttonize-word #'hproperty:but-add
hywiki--start hywiki--end hywiki-word-face))
+ ;; There is only one existing button
+ (setq hywiki--buts (car hywiki--buts)
+ hywiki--but-start (hproperty:but-start
hywiki--buts)
+ hywiki--but-end (hproperty:but-end
hywiki--buts))
+ (unless (and (= hywiki--start hywiki--but-start)
+ (= hywiki--end hywiki--but-end))
+ (hproperty:but-delete hywiki--buts)
+ (hywiki-buttonize-word #'hproperty:but-add
hywiki--start hywiki--end hywiki-word-face)))
+ (hywiki-buttonize-word #'hproperty:but-add hywiki--start
hywiki--end hywiki-word-face))))
+ ;; Remove any potential earlier highlighting since the
+ ;; previous word may have changed.
+ (skip-syntax-backward "^-$()<>._\"\'")
+ (hproperty:but-clear-all-in-list
+ (hproperty:but-get-all-in-region (point) (1+ (point))
+ 'face hywiki-word-face))))))))
+
+(defun hywiki-maybe-highlight-sexp (direction-number)
+ "Handle HyWikiWord highlighting on a single square/angle bracket.
+DIRECTION-NUMBER is 1 for forward scanning and -1 for backward scanning."
+ (let* ((sexp-start (point))
+ (sexp-end (scan-sexps sexp-start direction-number)))
+ (when (and sexp-start sexp-end)
+ (cl-destructuring-bind (sexp-start sexp-end)
+ ;; Point may be at end of sexp, so ensure start and end may
+ ;; need to be reversed
+ (list (min sexp-start sexp-end) (max sexp-start sexp-end))
+ ;; Need to include char after page name or regexp matching
+ ;; will not work
+ (hywiki-maybe-highlight-page-names (1+ sexp-start) sexp-end)
+ (setq hywiki--highlighting-done-flag t)))))
+
+(defun hywiki-maybe-highlight-org-element-backward ()
+ "De/Highlight HyWikiWords on a closing double/single square/angle bracket."
+ (ignore-errors
+ (unless (save-excursion
+ (when (or (eq (char-before) (char-before (1- (point))))
+ (and (char-after)
+ (goto-char (1+ (point)))
+ (eq (char-before) (char-before (1- (point))))))
+ (let* ((sexp-end (point))
+ (sexp-start (scan-sexps sexp-end -1)))
+ (when sexp-start
+ (hproperty:but-clear-all-in-list
+ (hproperty:but-get-all-in-region sexp-start sexp-end 'face
hywiki-word-face))
+ (setq hywiki--highlighting-done-flag t)))))
+ ;; In a single closing square or angle
+ ;; bracket, need to highlight HyWikiWords
+ (hywiki-maybe-highlight-sexp -1))))
+
+(defun hywiki-maybe-highlight-org-element-forward ()
+ "De/Highlight HyWikiWords on an opening double/single square/angle bracket."
+ (ignore-errors
+ (unless (save-excursion
+ (when (or (eq (char-after) (char-after (1+ (point))))
+ (and (char-before)
+ (goto-char (1- (point)))
+ (eq (char-after) (char-after (1+ (point))))))
+ (let* ((sexp-start (point))
+ (sexp-end (scan-sexps sexp-start 1)))
+ (when (and sexp-start sexp-end)
+ (hproperty:but-clear-all-in-list
+ (hproperty:but-get-all-in-region sexp-start sexp-end
+ 'face hywiki-word-face))
+ (setq hywiki--highlighting-done-flag t)))))
+ ;; In a single opening square or angle
+ ;; bracket, need to highlight HyWikiWords
+ (hywiki-maybe-highlight-sexp 1))))
;;;###autoload
(defun hywiki-maybe-highlight-page-names (&optional region-start region-end)
@@ -729,7 +791,8 @@ disabled. Highlight/dehighlight HyWiki page buffers when
;; Highlight HyWiki words in buffers where `hywiki-mode' is enabled
;; or with attached files below `hywiki-directory'.
(if (hywiki-active-in-current-buffer-p)
- (unless (eq hywiki-buffer-highlighted-state 'h)
+ (unless (and (null region-start) (null region-end)
+ (eq hywiki-buffer-highlighted-state 'h))
(unwind-protect
(save-excursion
(save-restriction
@@ -741,6 +804,8 @@ disabled. Highlight/dehighlight HyWiki page buffers when
(setq hywiki--any-page-regexp-list
(mapcar (lambda (page-sublist)
(concat (regexp-opt page-sublist 'words)
+ "\\("
+ hywiki-word-section-regexp "?\\)"
hywiki--buttonize-character-regexp))
(hypb:split-seq-into-sublists
(hywiki-get-page-list) 50))
@@ -844,7 +909,7 @@ If this is a HyWiki page and `hywiki-word-highlight-flag'
is non-nil
are typed in the buffer."
(or hywiki-page-flag
(when (string-prefix-p (expand-file-name hywiki-directory)
- (or buffer-file-name ""))
+ (or default-directory ""))
(setq hywiki-page-flag t))))
(defun hywiki-is-wikiword (word)
@@ -982,19 +1047,89 @@ Use `hywiki-get-page' to determine whether a HyWiki page
exists."
(link (concat
(when hywiki-org-link-type-required
(concat hywiki-org-link-type ":"))
- page-name))
- (description (format "HyWiki page for '%s'" page-name)))
+ page-name)))
(org-link-store-props
:type hywiki-org-link-type
:link link
- :description description))))
+ :description page-name))))
+
+;;; Next two functions derived from the denote package.
+;;;###autoload
+(defun hywiki-org-link-export (link description format)
+ "Export a HyWikiWord `hy:' link to various formats.
+The LINK, DESCRIPTION, and FORMAT are provided by the export
+backend."
+ (let* ((path-word-section (hywiki-org-link-resolve link :full-data))
+ (path (file-relative-name (nth 0 path-word-section)))
+ (path-stem (file-name-sans-extension path))
+ (word (nth 1 path-word-section))
+ (section (nth 2 path-word-section))
+ (desc (cond (description)
+ (section (format "%s:%s#%s"
+ hywiki-org-link-type word section))
+ (t (concat hywiki-org-link-type ":" word)))))
+ (pcase format
+ (`ascii (format "[%s] <%s:%s>" hywiki-org-link-type desc path))
+ (`html (format "<a href=\"%s.html%s\">%s</a>"
+ path-stem (if section (concat "#" section) "")
+ desc))
+ (`latex (format "\\href{%s}{%s}" (replace-regexp-in-string
"[\\{}$%&_#~^]" "\\\\\\&" path) desc))
+ (`md (format "[%s](%s)" desc path))
+ (`texinfo (format "@uref{%s,%s}" path desc))
+ (_ path))))
+
+(defun hywiki-org-link-resolve (link &optional full-data)
+ "Resolve HyWiki word LINK to page, with or without additional section.
+With optional FULL-DATA non-nil, return a list in the form of (path
+word section)."
+ (let* ((section (and (string-match "\\(#\\|::\\)\\(.*\\)\\'" link)
+ (match-string 2 link)))
+ (word (if (and section (not (string-empty-p section)))
+ (substring link 0 (match-beginning 0))
+ link))
+ (path (hywiki-get-page word)))
+ (cond
+ (full-data
+ (list path word section))
+ ((and section (not (string-empty-p section)))
+ (concat path "::" section))
+ (t path))))
(eval-after-load 'org
'(org-link-set-parameters hywiki-org-link-type
:complete #'hywiki-org-link-complete
+ :export #'hywiki-org-link-export
:follow #'hywiki-find-page
:store #'hywiki-org-link-store))
+;;;###autoload
+(defun hywiki-tags-view (&optional todo-only match view-buffer-name)
+ "Prompt for colon-separated Org tags and display matching HyWiki page
sections.
+With optional prefix arg TODO-ONLY, limit matches to HyWiki Org
+todo items only. With optional MATCH, an Org tags match selector
+string, e.g. \":tag1:tag2:tag3:\", match to sections that contain
+or inherit all of these tags, regardless of tag order. With
+optional VIEW-BUFFER-NAME, use that rather than the default,
+\"*HyWiki Tags*\"."
+ (interactive "P")
+ (require 'org-agenda)
+ (let* ((org-agenda-files (list hywiki-directory))
+ (org-agenda-buffer-name (or view-buffer-name "*HyWiki Tags*"))
+ ;; `org-tags-view' is mis-written to require setting this next
+ ;; tmp-name or it will not properly name the displayed buffer.
+ (org-agenda-buffer-tmp-name org-agenda-buffer-name))
+ ;; This prompts for the tags to match and uses `org-agenda-files'.
+ (org-tags-view todo-only match)
+ (when (equal (buffer-name) org-agenda-buffer-name)
+ ;; Set up {C-u r} redo cmd
+ (let (buffer-read-only)
+ (put-text-property (point-min) (point-max) 'org-redo-cmd
+ `(hywiki-tags-view
+ ,todo-only
+ nil
+ ,org-agenda-buffer-name)))
+ (forward-line 2))))
+
(defun hywiki-word-highlight-flag-changed (symbol set-to-value operation
_where)
"Watch function for variable ``hywiki-word-highlight-flag'.
Function is called with 4 arguments: (SYMBOL SET-TO-VALUE OPERATION WHERE).
