branch: externals/hyperbole
commit 2f2886784dd9748c3be4562da3381e9e3411d436
Merge: 734b0ffbea 49ecbd80b9
Author: Robert Weiner <r...@gnu.org>
Commit: GitHub <nore...@github.com>
Merge pull request #674 from rswgnu/rsw
hywiki Org export to html - use modified section titles as href ids;
hkey-help display actype info at the top
---
ChangeLog | 116 ++++++++++++
hmouse-drv.el | 114 ++++++-----
hpath.el | 18 +-
hsys-ert.el | 16 +-
hui-mini.el | 8 +-
hui-mouse.el | 12 +-
hui-select.el | 115 +++++------
hycontrol.el | 7 +-
hywiki.el | 523 ++++++++++++++++++++++++++++++++++++---------------
test/hact-tests.el | 6 +-
test/hywiki-tests.el | 22 +--
11 files changed, 669 insertions(+), 288 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 4777de1206..bb88bfdddb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,79 @@
+2025-02-23 Bob Weiner <r...@gnu.org>
+
+* test/hywiki-tests.el (hywiki-tests--convert-words-to-org-link): Fix to not
+ expect 'hy:' prefix in HyWiki Org links.
+ (hywiki-tests--add-org-roam-node): Handle all calls to
+ 'org-roam-node-title'.
+
+* hywiki.el (hywiki-get-referent): Fix suffix match to use group 3 and add
+ suffix to referent-value here.
+ (hywiki-display-referent): Remove adding suffix to referent-value
here.
+
+2025-02-22 Bob Weiner <r...@gnu.org>
+
+* hywiki.el (hywiki-publish-to-html): Advise 'org-export-get-reference' to use
+ modified Org headings as html ids.
+ (hywiki--org-export-get-reference,
+ hywiki--org-export-new-title-reference,
+ hywiki--org-format-reference): Add to implement the above new html
+ id generation scheme.
+
+* hui-select.el (hui-select-punctuation): Add 'hui-select-markup-pair' so if
+ on the opening char of an HTML tag for example with punctuation syntax,
+ it is treated as a markup pair from `hui-select-thing'.
+ (hui-select-thing): Change return value to be the region
selected
+ so can be used as a delimited regional selection predicate like so:
+ (hui-select-delimited-thing-call #'hui-select-thing).
+
+* hui-mouse.el (hkey-alist): Change action for
'hui-select-at-delimited-thing-p'
+ condition to call 'hui-select-thing' instead of
'hui-select-delimited-thing'
+ so does not include extra whitespace and matches the result when
+ 'hui-select-thing' is called interactively.
+
+* hywiki.el (hywiki-referent-exists-p):
+ Fix bug where 'word' was given as the symbol :range to use as a flag
+ but then the call to 'hywiki-strip-org-link' mistakenly set it to nil.
+ (hywiki-word-set-auto-highlighting): Add so can call interactively
+ to restore HyWikiWord auto-highlighting after a command hook error. Call
+ when enabling 'hywiki-mode'.
+
+ Fix bug where :range flag was not passed to 'hywiki-word-at' call;
+ manifested as selecting an entire string rather than the wikiword at point.
+
+* hsys-ert.el (ert-should): Constrain matches for this ibtype to the current
+ line when not in 'ert-results-mode'. This fixes a problem of having this
+ ibtype trigger in the "*scratch*" buffer for example where an
+ 'ert-test-failed match is found but it is far way and unconnected to the
+ current point.
+
+* hmouse-drv.el (hkey-help):
+ Update {C-h A} Hyperbole help so button information is displayed at
+ the top before long Action/Assist Key behavior description.
+
+ In cases like the multi-context 'smart-org' handler where a specific
+ action type is triggered without defining an implicit button, display
+ the action type information at the top as well, so it is clear the
+ specific action that will be taken at point.
+
+ Fix bug where 'categ' is nil and 'htype:names' returns a list of all
+ type names to 'concat' since expecting only a single name.
+
+ When displaying Assist Key help, remove actype and action attributes
+ from button or actype display.
+
+* hywiki.el (hywiki-directory-dired-edit): Remove bash-specific file
+ filtering since names the dir after the filter regex and this is
+ unattractive. Using directory-files to filter instead works fine.
+ Also, use 'hywiki-word-regexp' to match to page names rather than
+ a hardcoded regexp.
+
+* hycontrol.el (require 'zoom-frm): Wrap in an 'ignore-errors' so if its
+ required library, 'frame-cmds' is not installed, no error occurs and
+ HyControl behaves works without the library.
+
+* test/hact-tests.el (hact-tests--action-params-with-lambdas): Eliminate
+ byte compiler 'unused args' errors by starting args with underscore.
+
2025-02-21 Mats Lidell <ma...@gnu.org>
* test/hywiki-tests.el (hywiki-tests--delete-parenthesised-char): Verify
@@ -5,6 +81,18 @@
2025-02-19 Bob Weiner <r...@gnu.org>
+* hywiki.el (hywiki-maybe-dehighlight-page-name,
+ hywiki-maybe-highlight-page-name,
+ hywiki-maybe-highlight-page-names): In
+ non-'hywiki-highlight-all-in-prog-modes', highlight only in strings
+ as well as comments.
+ (hywiki-buttonize-non-character-commands,
+ hywiki-debuttonize-non-character-commands): Don't trigger these
+ pre- and post-command hooks in non-'hywiki-highlight-all-in-prog-modes'
when
+ outside of strings and comments.
+ (hywiki-word-at): Whe match to wikiword via face highlight, ensure
+ it matches to the wikiword format regexp.
+
* hyrolo.el (hyrolo-expand-path-list): Fix to include a default file name
even when the file does not yet exist.
@@ -16,6 +104,34 @@
(hyrolo-get-file-list): Return a default rolo file when `hyrolo-
file-list' is nil.
+2025-02-16 Bob Weiner <r...@gnu.org>
+
+* hui-select.el (hui-select-punctuation): Add (hui-select-string pos) call
+ when on a double quote since sometimes double quotes have punctuation
syntax,
+ e.g. text-mode.
+ (hui-select-string-p): Fix off-by-one error when scan-sexps
+ backwards with point after an ending double quote.
+ When compile, add (require 'hbut) for 'hbut:syntax-table'. Fix string
+ selection in 'text-mode' by using 'hbut:syntax-table'.
+
+* hywiki.el (hywiki-org-link-export): In html and markdown conversion, call
+ 'hpath:spaces-to-dashes-markup-anchor'.
+ (hywiki-referent-menu): Fix missing s typo in
'hywiki-add-sexpression'.
+ (hywiki-convert-words-to-org-links, hywiki-org-link-export):
+ Update doc string with specific formatting.
+ (hywiki-org-link-resolve): Rewrite to return full referent when not
+ a pathname.
+ (hywiki-referent-menu): Rename 'LinkPath' to 'pathLink' and
properly
+ alphabetize entries by invocation character (first capital letter).
+ (hywiki-word-to-org-link): Add to convert a single HyWikiWord
reference
+ to an Org link for use during publishing. Use in
`hywiki-convert-words-to-org-links'.
+
+2025-02-09 Bob Weiner <r...@gnu.org>
+
+* hpath.el hpath:spaces-to-dashes-markup-anchor): Add.
+ (hpath:normalize-markup-anchor): Rename to
+ 'hpath:dashes-to-spaces-markup-anchor'.
+
2025-02-08 Mats Lidell <ma...@gnu.org>
* hywiki.el (hywiki--sitemap-file): Helper function for getting the sitemap
diff --git a/hmouse-drv.el b/hmouse-drv.el
index e9a3583353..bacb22e1ce 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-90
-;; Last-Mod: 15-Dec-24 at 22:38:04 by Bob Weiner
+;; Last-Mod: 22-Feb-25 at 11:52:57 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1115,47 +1115,32 @@ documentation is found."
(format "%s %sKey"
(if assisting "Assist" "Action")
(if mouse-flag "Mouse " "")))
- (princ (format "A %s of the %s %sKey"
- (if mouse-flag
- (if mouse-drag-flag "drag" "click")
- "press")
- (if assisting "Assist" "Action")
- (if mouse-flag "Mouse " "")))
- (terpri)
- (princ "WHEN ")
- (princ
- (or condition
- "there is no matching context"))
- (terpri)
-
- (mapc (lambda (c)
- (when (and (> (length calls) 1)
- (not (eq (car calls) c)))
- ;; Is an 'or' set of calls
- (princ "OR "))
- (princ "CALLS ") (princ (if (consp c) c (list c)))
- (when (and (fboundp (setq call (if (consp c) (car
c) c)))
- (setq doc (documentation call)))
- (princ " WHICH")
- (princ (if (string-match
"\\`[a-zA-Z]*[a-rt-zA-RT-Z]+s[ [:punct:]]" doc)
- ":" " WILL:"))
- (terpri) (terpri)
- (princ (replace-regexp-in-string "^" " " doc nil
t))
- (terpri) (terpri)))
- calls)
;; Print Hyperbole button attributes
- (when (memq cmd-sym '(hui:hbut-act hui:hbut-help))
- (let ((actype (or (actype:elisp-symbol (hattr:get
'hbut:current 'actype))
- (hattr:get 'hbut:current 'actype)))
- ;; (lbl-key (hattr:get 'hbut:current 'lbl-key))
- (categ (hattr:get 'hbut:current 'categ))
- (attributes (nthcdr 2 (hattr:list 'hbut:current))))
-
- (princ (format "%s %s BUTTON SPECIFICS:\n"
- (htype:def-symbol
- (if (eq categ 'explicit) actype categ))
- (if (eq categ 'explicit) "EXPLICIT"
"IMPLICIT")))
+ (when (or (memq cmd-sym '(hui:hbut-act hui:hbut-help))
+ (hattr:get 'hbut:current 'actype))
+ (let* ((actype (or (actype:elisp-symbol (hattr:get
'hbut:current 'actype))
+ (hattr:get 'hbut:current 'actype)))
+ ;; (lbl-key (hattr:get 'hbut:current 'lbl-key))
+ (categ (hattr:get 'hbut:current 'categ))
+ (attributes (nthcdr 2 (hattr:list 'hbut:current)))
+ (but-def-symbol (htype:def-symbol
+ (if (eq categ 'explicit) actype
categ))))
+
+ (princ (format "%s %s SPECIFICS:\n"
+ (or but-def-symbol
+ (htype:def-symbol actype))
+ (cond ((eq categ 'explicit)
+ "EXPLICIT BUTTON")
+ (categ
+ "IMPLICIT BUTTON")
+ (t "ACTION TYPE"))))
+ (when (and assisting
+ (or (plist-member attributes 'actype)
+ (plist-member attributes 'action)))
+ (setq attributes (copy-sequence attributes))
+ (hypb:remove-from-plist attributes 'actype)
+ (hypb:remove-from-plist attributes 'action))
(hattr:report attributes)
(unless (or assisting
(eq categ 'explicit)
@@ -1167,13 +1152,15 @@ documentation is found."
(replace-regexp-in-string "^" " "
(documentation categ)
nil t))))
(if assisting
- (let* ((custom-help-func (intern-soft
- (concat (htype:names
'ibtypes categ)
- ":help")))
- (type-help-func (or (and custom-help-func
(fboundp custom-help-func)
+ (let* ((ibtype-name (htype:names 'ibtypes categ))
+ (custom-help-func (when (stringp ibtype-name)
+ (intern-soft
+ (concat ibtype-name
":help"))))
+ (type-help-func (or (and custom-help-func
+ (fboundp
custom-help-func)
custom-help-func)
'hbut:report)))
- (princ (format "\n%s ASSIST SPECIFICS:\n%s\n"
+ (princ (format "\n%s ASSIST KEY SPECIFICS:\n%s\n"
type-help-func
(replace-regexp-in-string
"^" " " (documentation
type-help-func)
@@ -1181,10 +1168,11 @@ documentation is found."
(when (and (symbolp actype)
(fboundp actype)
(documentation actype))
- (princ (format "\n%s ACTION SPECIFICS:\n%s\n"
+ (princ (format "\n%s ACTION KEY SPECIFICS:\n%s\n"
(or (actype:def-symbol actype)
actype)
(replace-regexp-in-string "^" " "
(documentation actype)
- nil
t)))))))
+ nil t)))))
+ (terpri)))
;; Print Emacs push-button attributes
(when (memq cmd-sym '(smart-push-button
smart-push-button-help))
@@ -1199,9 +1187,37 @@ documentation is found."
(princ (format "\n%s ACTION SPECIFICS:\n%s\n"
(plist-get attributes 'action)
(replace-regexp-in-string "^" " "
(actype:doc button t)
- nil
t)))))))
+ nil t))))
+ (terpri))))
- (terpri)))
+ (princ (format "A %s of the %s %sKey"
+ (if mouse-flag
+ (if mouse-drag-flag "drag" "click")
+ "press")
+ (if assisting "Assist" "Action")
+ (if mouse-flag "Mouse " "")))
+ (terpri)
+ (princ "WHEN ")
+ (princ
+ (or condition
+ "there is no matching context"))
+ (terpri)
+
+ (mapc (lambda (c)
+ (when (and (> (length calls) 1)
+ (not (eq (car calls) c)))
+ ;; Is an 'or' set of calls
+ (princ "OR "))
+ (princ "CALLS ") (princ (if (consp c) c (list c)))
+ (when (and (fboundp (setq call (if (consp c) (car
c) c)))
+ (setq doc (documentation call)))
+ (princ " WHICH")
+ (princ (if (string-match
"\\`[a-zA-Z]*[a-rt-zA-RT-Z]+s[ [:punct:]]" doc)
+ ":" " WILL:"))
+ (terpri) (terpri)
+ (princ (replace-regexp-in-string "^" " " doc nil
t))
+ (terpri) (terpri)))
+ calls)))
"")
(message "No %s Key command for current context."
(if assisting "Assist" "Action"))))
diff --git a/hpath.el b/hpath.el
index eafe1f2171..0b9a54822d 100644
--- a/hpath.el
+++ b/hpath.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 1-Nov-91 at 00:44:23
-;; Last-Mod: 2-Feb-25 at 07:38:26 by Bob Weiner
+;; Last-Mod: 16-Feb-25 at 10:04:57 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1612,8 +1612,18 @@ but locational suffixes within the file are utilized."
(kotl-mode:to-valid-position))
(current-buffer)))))))))))
-(defun hpath:normalize-markup-anchor (anchor)
- "Convert ANCHOR from current buffer into a a string matching its referent."
+(defun hpath:spaces-to-dashes-markup-anchor (anchor)
+ "Replace dashes with spaces in ANCHOR if not a prog mode and no existing
dashes."
+ (if (or (derived-mode-p 'prog-mode)
+ (string-match-p "-.* \\| .*-" anchor))
+ anchor
+ ;; In Markdown or outline modes '-' characters in `anchor' are
+ ;; converted to dashes in references unless anchor contains both
+ ;; '-' and space characters, in which case no conversion occurs.
+ (subst-char-in-string ?\ ?- anchor)))
+
+(defun hpath:dashes-to-spaces-markup-anchor (anchor)
+ "Replace spaces with dashes with spaces in ANCHOR if not a prog mode and no
existing dashes."
(if (or (derived-mode-p 'prog-mode)
(string-match-p "-.* \\| .*-" anchor))
anchor
@@ -1652,7 +1662,7 @@ of the buffer."
;; Markdown or outline link ids are case
;; insensitive.
(case-fold-search (not prog-mode))
- (anchor-name (hpath:normalize-markup-anchor
anchor))
+ (anchor-name
(hpath:dashes-to-spaces-markup-anchor anchor))
(referent-regexp (format
(cond ((or
(derived-mode-p 'outline-mode) ;; Includes Org mode
;; Treat all
caps filenames without suffix like outlines, e.g. README, INSTALL.
diff --git a/hsys-ert.el b/hsys-ert.el
index 81024f0a1d..c7adeef4b9 100644
--- a/hsys-ert.el
+++ b/hsys-ert.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 19-Jan-25
-;; Last-Mod: 20-Jan-25 at 23:57:21 by Mats Lidell
+;; Last-Mod: 22-Feb-25 at 12:20:29 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -57,11 +57,15 @@
"Jump to the source code definition of a should expr from an ert test
failure.
If on the first line of a failure, jump to the source definition of the
associated test."
- (when (or (derived-mode-p 'ert-results-mode)
- (save-excursion
- (forward-line 0)
- (or (search-backward "(ert-test-failed\n" nil t)
- (search-forward "(ert-test-failed\n" nil t))))
+ (when (or (and (derived-mode-p 'ert-results-mode)
+ (save-excursion
+ (forward-line 0)
+ (or (search-backward "(ert-test-failed\n" nil t)
+ (search-forward "(ert-test-failed\n" nil t))))
+ ;; In any other mode, consider only the current line
+ (save-excursion
+ (forward-line 0)
+ (search-forward "(ert-test-failed" (line-end-position) t)))
(catch 'exit
(save-excursion
(save-restriction
diff --git a/hui-mini.el b/hui-mini.el
index b5187ee54c..75a12aedab 100644
--- a/hui-mini.el
+++ b/hui-mini.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 15-Oct-91 at 20:13:17
-;; Last-Mod: 30-Jan-25 at 19:44:11 by Mats Lidell
+;; Last-Mod: 22-Feb-25 at 22:15:38 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1035,13 +1035,13 @@ support underlined faces as well."
(list
'("HyWiki>")
'("Act" hywiki-word-activate
- "Activate HyWikiWord link at point or emulate a press of a Smart
Key.")
+ "Create and display page for HyWikiWord at point or when none,
emulate a press of a Smart Key.")
'("Create" hywiki-word-create-and-display
- "Create and display a new HyWiki referent, prompting with any
existing referent names.")
+ "Create and display a new or existing HyWikiWord referent,
prompting with any existing referent names.")
'("EditPages" hywiki-directory-edit
"Display and edit HyWiki directory.")
'("FindReferent" hywiki-find-referent
- "Prompt with completion for and display a HyWiki page ready for
editing.")
+ "Prompt with completion for and display a HyWikiWord referent.")
(when (fboundp 'consult-grep) ;; allow for autoloading
'("GrepConsult" hywiki-consult-grep
"Grep over HyWiki pages with interactive consult-grep."))
diff --git a/hui-mouse.el b/hui-mouse.el
index da5a730829..8f5b775234 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-89
-;; Last-Mod: 19-Jan-25 at 16:40:13 by Bob Weiner
+;; Last-Mod: 22-Feb-25 at 16:18:02 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -292,7 +292,8 @@ Its default value is `smart-scroll-down'. To disable it,
set it to
(smart-helm-alive-p)))
. ((funcall (key-binding (kbd "RET"))) . (funcall (key-binding (kbd
"RET")))))
;;
- ;; If at the end of a line (eol), invoke the associated Smart Key handler
EOL handler.
+ ;; If at the end of a line (eol), invoke the associated Smart Key
+ ;; handler EOL handler.
((and (smart-eolp)
(not (and (funcall hsys-org-mode-function)
(not (equal hsys-org-enable-smart-keys t)))))
@@ -390,8 +391,8 @@ Its default value is `smart-scroll-down'. To disable it,
set it to
;; ends at point. For markup pairs, point must be at the first
;; character of the opening or closing tag.
((hui-select-at-delimited-thing-p)
- . ((hui-select-delimited-thing) . (progn (hui-select-delimited-thing)
- (hmouse-kill-region))))
+ . ((hui-select-thing) . (progn (hui-select-thing)
+ (hmouse-kill-region))))
;;
;; If the prior test failed and point is at the start or end of an
;; sexpression, mark it for editing or kill it (assist key). This
@@ -413,7 +414,8 @@ Its default value is `smart-scroll-down'. To disable it,
set it to
((eq major-mode 'kotl-mode)
. ((kotl-mode:action-key) . (kotl-mode:assist-key)))
;;
- ;; If in the flymake linter list of issues buffer, jump to or show issue
at point
+ ;; If in the flymake linter list of issues buffer, jump to or show
+ ;; issue at point.
((eq major-mode 'flymake-diagnostics-buffer-mode)
. ((flymake-goto-diagnostic (point)) . (flymake-show-diagnostic (point)
t)))
;;
diff --git a/hui-select.el b/hui-select.el
index fd949b42f8..e2556b7d90 100644
--- a/hui-select.el
+++ b/hui-select.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 19-Oct-96 at 02:25:27
-;; Last-Mod: 7-Feb-25 at 00:15:47 by Bob Weiner
+;; Last-Mod: 22-Feb-25 at 22:15:12 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -564,6 +564,7 @@ Also, add language-specific syntax setups to aid in thing
selection."
If invoked repeatedly, this selects bigger and bigger things.
If `hui-select-display-type' is non-nil and this is called
interactively, the type of selection is displayed in the minibuffer.
+The region selected is returned in (start . end) form.
If the key that invokes this command in `hyperbole-minor-mode' is
also bound in the current major mode map, then interactively
@@ -603,7 +604,7 @@ invoke that command instead. Typically prevents clashes
over
(and (called-interactively-p 'interactive)
hui-select-display-type
(message "%s" hui-select-previous))
(run-hooks 'hui-select-thing-hook)
- t))))))
+ region))))))
;;;###autoload
(defun hui-select-thing-with-mouse (event)
@@ -783,8 +784,8 @@ The character at POS is selected if no other thing is
matched."
(mapc
(lambda (sym-func)
(setq region
- (when (car (cdr sym-func))
- (funcall (car (cdr sym-func)) pos)))
+ (when (cadr sym-func)
+ (funcall (cadr sym-func) pos)))
(when (and region (car region)
(hui-select-region-bigger-p
hui-select-old-region region)
@@ -1037,7 +1038,6 @@ Return the updated cons cell."
nil
hui-select-region))
-
(defun hui-select-string-p (&optional start-delim end-delim)
"Return (start . end) of a string.
Works when on a delim or on the first line with point in the
@@ -1047,55 +1047,55 @@ and END-DELIM (strings) are given. Returns nil if not
within a
string."
(unless start-delim (setq start-delim "\""))
(unless end-delim (setq end-delim "\""))
- (or (and (equal start-delim "\"") (equal end-delim "\"")
- (ignore-errors
- (cond ((and (= (char-after) ?\")
- (/= (char-before) ?\\))
- (if (hypb:in-string-p)
- (hui-select-set-region (scan-sexps (1+ (point)) -1)
- (1+ (point)))
- (hui-select-set-region (point) (scan-sexps (point) 1))))
- ((and (= (char-before) ?\")
- (/= (char-before (1- (point))) ?\\))
- (if (hypb:in-string-p)
- (hui-select-set-region (1- (point)) (scan-sexps (1-
(point)) 1))
- (hui-select-set-region (scan-sexps (1- (point)) -1)
- (point)))))))
- (let ((opoint (point))
- (count 0)
- bol start delim-regexp start-regexp end-regexp)
- ;; Special case for the empty string.
- (if (looking-at (concat (regexp-quote start-delim)
- (regexp-quote end-delim)))
- (hui-select-set-region (point) (match-end 0))
- (setq start-regexp (concat "\\(^\\|[^\\]\\)\\("
- (regexp-quote start-delim) "\\)")
- end-regexp (concat "[^\\]\\(" (regexp-quote end-delim) "\\)")
- delim-regexp (concat start-regexp "\\|" end-regexp))
- (save-excursion
- (beginning-of-line)
- (setq bol (point))
- (while (re-search-forward delim-regexp opoint t)
- (setq count (1+ count))
- ;; This is so we don't miss the closing delimiter of an empty
- ;; string.
- (if (and (= (point) (1+ bol))
- (looking-at (regexp-quote end-delim)))
- (setq count (1+ count))
- (unless (bobp)
- (backward-char 1))))
- (goto-char opoint)
- ;; If found an even # of starting and ending delimiters before
- ;; opoint, then opoint is at the start of a string, where we want
it.
- (if (zerop (mod count 2))
- (unless (bobp)
- (backward-char 1))
- (re-search-backward start-regexp nil t))
- ;; Point is now before the start of the string.
- (when (re-search-forward start-regexp nil t)
- (setq start (match-beginning 2))
- (when (re-search-forward end-regexp nil t)
- (hui-select-set-region start (point)))))))))
+ (with-syntax-table hbut:syntax-table
+ (or (and (equal start-delim "\"") (equal end-delim "\"")
+ (ignore-errors
+ (cond ((and (= (char-after) ?\")
+ (/= (char-before) ?\\))
+ (if (hypb:in-string-p)
+ (hui-select-set-region (1+ (point))
+ (scan-sexps (1+ (point)) -1))
+ (hui-select-set-region (point) (scan-sexps (point) 1))))
+ ((and (= (char-before) ?\")
+ (/= (char-before (1- (point))) ?\\))
+ (if (hypb:in-string-p)
+ (hui-select-set-region (1- (point)) (scan-sexps (1-
(point)) 1))
+ (hui-select-set-region (point) (scan-sexps (point)
-1)))))))
+ (let ((opoint (point))
+ (count 0)
+ bol start delim-regexp start-regexp end-regexp)
+ ;; Special case for the empty string.
+ (if (looking-at (concat (regexp-quote start-delim)
+ (regexp-quote end-delim)))
+ (hui-select-set-region (point) (match-end 0))
+ (setq start-regexp (concat "\\(^\\|[^\\]\\)\\("
+ (regexp-quote start-delim) "\\)")
+ end-regexp (concat "[^\\]\\(" (regexp-quote end-delim)
"\\)")
+ delim-regexp (concat start-regexp "\\|" end-regexp))
+ (save-excursion
+ (beginning-of-line)
+ (setq bol (point))
+ (while (re-search-forward delim-regexp opoint t)
+ (setq count (1+ count))
+ ;; This is so we don't miss the closing delimiter of an empty
+ ;; string.
+ (if (and (= (point) (1+ bol))
+ (looking-at (regexp-quote end-delim)))
+ (setq count (1+ count))
+ (unless (bobp)
+ (backward-char 1))))
+ (goto-char opoint)
+ ;; If found an even # of starting and ending delimiters before
+ ;; opoint, then opoint is at the start of a string, where we want
it.
+ (if (zerop (mod count 2))
+ (unless (bobp)
+ (backward-char 1))
+ (re-search-backward start-regexp nil t))
+ ;; Point is now before the start of the string.
+ (when (re-search-forward start-regexp nil t)
+ (setq start (match-beginning 2))
+ (when (re-search-forward end-regexp nil t)
+ (hui-select-set-region start (point))))))))))
;;;
;;; Code selections
;;;
@@ -1336,7 +1336,12 @@ included in the list, hui-select-brace-modes."
(defun hui-select-punctuation (pos)
"Return (start . end) region when at a punctuation character.
The region includes sexpressions before and after POS"
- (or (hui-select-comment pos)
+ (or (hui-select-markup-pair pos)
+ (hui-select-delimited-thing-call #'hui-select-thing)
+ (and (or (and (= (char-after) ?\") (/= (char-before) ?\\))
+ (and (= (char-before) ?\") (/= (char-before (1- (point))) ?\\)))
+ (hui-select-string pos))
+ (hui-select-comment pos)
(hui-select-preprocessor-def pos)
(hui-select-brace-def-or-declaration pos) ;; Might be on a C++
destructor ~.
(save-excursion
diff --git a/hycontrol.el b/hycontrol.el
index 6ab38cd7a8..bb2adb5b8f 100644
--- a/hycontrol.el
+++ b/hycontrol.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 1-Jun-16 at 15:35:36
-;; Last-Mod: 29-Jan-25 at 19:05:16 by Mats Lidell
+;; Last-Mod: 22-Feb-25 at 09:41:32 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -135,7 +135,10 @@
(require 'windmove))
;; Frame face enlarging/shrinking (zooming) requires this separately available
library.
;; Everything else works fine without it, so don't make it a required
dependency.
-(require 'zoom-frm nil t)
+;; It also requires the separate library, 'frame-cmds', so ignore any
+;; errors if that library is not found as well.
+(ignore-errors
+ (require 'zoom-frm nil t))
;;; ************************************************************************
;;; Public declarations
diff --git a/hywiki.el b/hywiki.el
index ddd716e0e2..2649b17b12 100644
--- a/hywiki.el
+++ b/hywiki.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 21-Acpr-24 at 22:41:13
-;; Last-Mod: 9-Feb-25 at 10:10:14 by Bob Weiner
+;; Last-Mod: 23-Feb-25 at 11:05:28 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -36,7 +36,8 @@
;; the following contexts:
;; - HyWiki page buffers;
;; - non-special text buffers, when `hywiki-mode' is enabled;
-;; - comments of programming buffers, when `hywiki-mode' is enabled.
+;; - comments and strings in programming buffers, when
+;; `hywiki-mode' is enabled.
;;
;; As HyWikiWords are typed, highlighting occurs after a trailing
;; whitespace or punctuation character is added, or when it is
@@ -70,22 +71,29 @@
;; The custom setting, `hywiki-word-highlight-flag' (default = t),
;; means HyWikiWords will be auto-highlighted within HyWiki pages.
;; Outside of such pages, `hywiki-mode' must also be enabled for such
-;; auto-highlighting.
-;;
+;; auto-highlighting. Auto-highlighting depends on pre- and
+;; `post-command-hook' settings. If an error occurs running one of
+;; these, the associated hook is removed. To restore the auto-highlight
+;; hooks either use {M-x hywiki-word-set-auto-highlighting RET} or
+;; {C-u C-h h h h m} to toggle `hywiki-mode'; this also enables
+;; auto-highlighting if `hywiki-word-highlight-flag' is non-nil.
+
;; The custom setting, `hywiki-exclude-major-modes' (default = nil), is
;; a list of major modes to exclude from HyWikiWord auto-highlighting
;; and recognition.
;;
;; Within programming modes, HyWikiWords are highlighted/hyperlinked
-;; within comments only. For programming modes in which you want
-;; HyWikiWords recognized everywhere, add them to the custom setting,
-;; `hywiki-highlight-all-in-prog-modes' (default =
-;; '(lisp-interaction-mode)).
+;; within comments and double-quoted strings only. For programming
+;; modes in which you want HyWikiWords recognized everywhere, add
+;; them to the custom setting, `hywiki-highlight-all-in-prog-modes'
+;; (default = '(lisp-interaction-mode)).
;;
-;; HyWiki adds one implicit button type to Hyperbole:
-;; `hywiki-word' - creates and displays HyWikiWord pages;
-;; This is one of the lowest priority implicit button types so that
-;; it triggers only when other types are not recognized first.
+;; HyWiki adds two implicit button types to Hyperbole:
+;; `hywiki-word' - creates and displays HyWikiWord referents;
+;; `hywiki-existing-word' - display an existing HyWikiWord referent.
+;;
+;; `hywiki-word' is one of the lowest priority implicit button types
+;; so that it triggers only when other types are not recognized first.
;;
;; A HyWiki can be exported to HTML for publishing to the web via Org
;; mode's publish a project feature. {M-x hywiki-publish-to-html RET}
@@ -128,7 +136,7 @@
;;; Other required Elisp libraries
;;; ************************************************************************
-(require 'cl-lib) ;; For `cl-find'
+(require 'cl-lib) ;; For `cl-find' and `cl-incf'
(require 'hactypes) ;; For `link-to-file-interactively'
(require 'hargs)
(require 'hasht)
@@ -451,7 +459,8 @@ Nil by default."
(defconst hywiki-word-regexp
"\\<\\([[:upper:]][[:alpha:]]+\\)\\>"
- "Regexp that matches a HyWiki word only.")
+ "Regexp that matches a HyWiki word only.
+Do not use a start or end line/string anchor in this regexp.")
(defconst hywiki-word-section-regexp
"\\(#[^][# \t\n\r\f]+\\)"
@@ -561,35 +570,40 @@ Triggered by `post-command-hook' for
non-character-commands, including
deletion commands and those in `hywiki-non-character-commands'."
(unless (or (minibuffer-window-active-p (selected-window))
(and (boundp 'edebug-active) edebug-active
- (active-minibuffer-window)))
+ (active-minibuffer-window))
+ (and (derived-mode-p 'prog-mode)
+ (not (apply #'derived-mode-p
hywiki-highlight-all-in-prog-modes))
+ ;; Not inside a comment or a string
+ (not (or (nth 4 (syntax-ppss)) (hypb:in-string-p)))))
(when (or (memq this-command hywiki-non-character-commands)
(and (symbolp this-command)
(string-match-p
"^\\(org-\\)?\\(delete-\\|kill-\\)\\|\\(-delete\\|-kill\\|insert\\)\\(-\\|$\\)"
(symbol-name this-command))))
- (if (and (marker-position hywiki--buttonize-start)
- (marker-position hywiki--buttonize-end))
- ;; This means the command just deleted an opening or closing
- ;; delimiter of a range that now needs any HyWikiWords
- ;; inside to be re-highlighted.
- (save-excursion
+ (when (and (marker-position hywiki--buttonize-start)
+ (marker-position hywiki--buttonize-end))
+ ;; This means the command just deleted an opening or closing
+ ;; delimiter of a range that now needs any HyWikiWords
+ ;; inside to be re-highlighted.
+ (save-excursion
+ (goto-char hywiki--buttonize-start)
+ (let ((opening-char (char-after))
+ closing-char)
+ (when (memq opening-char '(?\( ?\"))
+ (delete-char 1))
+ (goto-char hywiki--buttonize-end)
+ (setq closing-char (char-before))
+ (when (memq closing-char '(?\) ?\"))
+ (delete-char -1)
+ (insert " "))
(goto-char hywiki--buttonize-start)
- (let ((opening-char (char-after))
- closing-char)
- (when (memq opening-char '(?\( ?\"))
- (delete-char 1))
- (goto-char hywiki--buttonize-end)
- (setq closing-char (char-before))
- (when (memq closing-char '(?\) ?\"))
- (delete-char -1)
- (insert " "))
- (goto-char hywiki--buttonize-start)
- (hywiki-maybe-highlight-between-page-names)
- (when (memq opening-char '(?\( ?\"))
- (insert opening-char))
- (when (memq closing-char '(?\) ?\"))
- (goto-char (1+ hywiki--buttonize-end))
- (delete-char -1)
- (insert closing-char))))
- (hywiki-maybe-highlight-between-page-names)))))
+ (hywiki-maybe-highlight-between-page-names)
+ (when (memq opening-char '(?\( ?\"))
+ (insert opening-char))
+ (when (memq closing-char '(?\) ?\"))
+ (goto-char (1+ hywiki--buttonize-end))
+ (delete-char -1)
+ (insert closing-char)
+ ))))
+ (hywiki-maybe-highlight-between-page-names))))
(defun hywiki-debuttonize-non-character-commands ()
"Dehighlight any HyWikiWord before or after point.
@@ -598,10 +612,15 @@ deletion commands and those in
`hywiki-non-character-commands'."
(when (and (markerp hywiki--buttonize-start) (markerp hywiki--buttonize-end))
(set-marker hywiki--buttonize-start nil)
(set-marker hywiki--buttonize-end nil))
- (when (or (memq this-command hywiki-non-character-commands)
- (and (symbolp this-command)
- (string-match-p
"\\`\\(org-\\)?\\(delete-\\|kill-\\)\\|-delete-\\|-kill-"
- (symbol-name this-command))))
+ (when (and (or (memq this-command hywiki-non-character-commands)
+ (and (symbolp this-command)
+ (string-match-p
"\\`\\(org-\\)?\\(delete-\\|kill-\\)\\|-delete-\\|-kill-"
+ (symbol-name this-command))))
+ (or (not (derived-mode-p 'prog-mode))
+ (apply #'derived-mode-p hywiki-highlight-all-in-prog-modes)
+ ;; Inside a comment or a string
+ (nth 4 (syntax-ppss))
+ (hypb:in-string-p)))
(cl-destructuring-bind (start end)
(hywiki-get-delimited-range) ;; includes delimiters
;; Use these to store any range of a delimited HyWikiWord#section
@@ -694,7 +713,8 @@ See the Info documentation at \"(hyperbole)HyWiki\".
(unless hywiki-mode-map
(setq hywiki-mode-map (make-sparse-keymap)))
;; Next line triggers a call to
`hywiki-maybe-highlight-wikiwords-in-frame'
- (set-variable 'hywiki-word-highlight-flag t))
+ (set-variable 'hywiki-word-highlight-flag t)
+ (hywiki-word-set-auto-highlighting 1))
;; disable mode
;; Dehighlight HyWikiWords in this buffer when 'hywiki-mode' is
;; disabled and this is not a HyWiki page buffer. If this is a
@@ -760,8 +780,8 @@ After successfully finding a page and reading it into a
buffer, run
(unless (hypb:buffer-file-name)
(error "(hywiki-display-referent): No `wikiword' given; buffer
must have an attached file"))
(setq wikiword (file-name-sans-extension (file-name-nondirectory
(hypb:buffer-file-name)))))
- (let* ((suffix (when (string-match hywiki-word-suffix-regexp wikiword)
- (substring wikiword (match-beginning 0))))
+ (let* ((_suffix (when (string-match hywiki-word-suffix-regexp
wikiword)
+ (substring wikiword (match-beginning 0))))
(referent (cond (prompt-flag
(hywiki-create-referent wikiword))
((hywiki-get-referent wikiword))
@@ -769,9 +789,6 @@ After successfully finding a page and reading it into a
buffer, run
(if (not referent)
(error "(hywiki-display-referent): Invalid `%s' referent: %s"
wikiword referent)
- ;; If a referent type that can include a # or :L line
- ;; number suffix, append it to the referent-value.
- (setq referent (hywiki--add-suffix-to-referent suffix referent))
;; Ensure highlight any page name at point in case called as a
;; Hyperbole action type
(hywiki-maybe-highlight-page-name t)
@@ -810,28 +827,25 @@ After successfully finding a page and reading it into a
buffer, run
"Add a HyWikiWord that activates a named Hyperbole global button.")
'("HyRolo" (hywiki-add-hyrolo hkey-value)
"Add a HyWikiWord that searches `hyrolo-file-list' for matches.")
- ;; "{key series}" wikiword)
- '("Keys" (hywiki-add-key-series hkey-value)
- "Add a HyWikiWord that executes a key series.")
;; "(hyperbole)action implicit button"
'("InfoIndex" (hywiki-add-info-index hkey-value)
"Add a HyWikiWord that displays an Info index item.")
;; "(hyperbole)Smart Keys"
+ '("pathLink" (hywiki-add-path-link hkey-value)
+ "Add a HyWikiWord that links to a path and possible position.")
'("infoNode" (hywiki-add-info-node hkey-value)
"Add a HyWikiWord that displays an Info node.")
- '("LinkPath" (hywiki-add-path-link hkey-value)
- "Add a HyWikiWord that links to a path and possible position.")
;; "ID: org-id"
'("OrgID" (hywiki-add-org-id hkey-value)
"Add a HyWikiWord that displays an Org section given its Org ID.")
- '("orgRoamNode" (hywiki-add-org-roam-node hkey-value)
- "Add a HyWikiWord that displays an Org Roam node given its title.")
;; "pathname:line:col"
;; "#in-buffer-section"
'("Page" (hywiki-add-page hkey-value)
"Add/Reset a HyWikiWord to link to its standard HyWiki page.")
;; e.g. (kbd "key sequence")
- '("Sexp" (hywiki-add-sexpresion hkey-value)
+ '("orgRoamNode" (hywiki-add-org-roam-node hkey-value)
+ "Add a HyWikiWord that displays an Org Roam node given its title.")
+ '("Sexp" (hywiki-add-sexpression hkey-value)
"Add a HyWikiWord that evaluates an Elisp sexpression.")))
"*Menu of HyWikiWord custom referent types of the form:
\(LABEL-STRING ACTION-SEXP DOC-STR)."
@@ -1294,7 +1308,7 @@ Use `hywiki-get-referent' to determine whether a HyWiki
page exists."
(called-interactively-p 'interactive))
(setq prompt-flag t))
(let* ((normalized-word (hywiki-get-singular-wikiword wikiword))
- (referent (hywiki-find-referent normalized-word prompt-flag)))
+ (referent (hywiki-find-referent wikiword prompt-flag)))
(cond (referent)
((and (null referent) (hywiki-word-is-p normalized-word))
(when (hywiki-add-page normalized-word)
@@ -1408,28 +1422,89 @@ per file to the absolute value of MAX-MATCHES, if given
and not 0. If
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."
+ "Convert all highlighted HyWiki words in current buffer to Org links.
+Use when publishing a HyWiki file to another format, e.g. html.
+
+For example, the link:
+ \"WikiWord#Multi-Word Section\"
+or
+ \"[[hy:WikiWord#Multi-Word Section]]\"
+is converted to:
+ \"[[file:<hywiki-directory>/WikiWord.org::Multi-Word
Section][WikiWord#Multi-Word Section]]\".
+
+If the reference is in a file within the `hywiki-directory', it
+simplifies to:
+ \"[[file:WikiWord.org::Multi-Word Section][WikiWord#Multi-Word Section]]\".
+
+If the reference is within the WikiWord page to which it refers, it
+simplifies to:
+ \"[[Multi-Word Section]]\".
+
+The finalized Org link is then exported to html format by the Org
+publish process."
(barf-if-buffer-read-only)
(hywiki-maybe-highlight-page-names)
(let ((make-index (hywiki-org-get-publish-property :makeindex))
- wiki-word)
+ org-link
+ wikiword-and-section
+ wikiword)
(hywiki-map-words (lambda (overlay)
- (goto-char (overlay-end overlay))
- (if make-index
- (progn
- (setq wiki-word (buffer-substring-no-properties
- (overlay-start overlay)
- (overlay-end overlay)))
- (when (string-match (concat hywiki-org-link-type
":")
- wiki-word)
- (setq wiki-word (substring wiki-word (match-end
0))))
- (insert "]]\n#+INDEX: " wiki-word "\n"))
- (insert "]]"))
+ (setq wikiword-and-section
+ (buffer-substring-no-properties
+ (overlay-start overlay)
+ (overlay-end overlay)))
(goto-char (overlay-start overlay))
- (if (looking-at (concat hywiki-org-link-type ":"))
- (insert "[[")
- (insert "[[" hywiki-org-link-type ":"))
- (delete-overlay overlay)))))
+ (delete-region (overlay-start overlay)
+ (overlay-end overlay))
+ (delete-overlay overlay)
+ (if (setq org-link (hywiki-word-to-org-link
wikiword-and-section nil))
+ (insert org-link)
+ (message
+ "(hywiki-convert-words-to-org-links): \"%s\" in
\"%s\" produced nil org link output"
+ wikiword-and-section (buffer-name)))
+ (when make-index
+ (when (string-match (concat hywiki-org-link-type ":")
+ wikiword-and-section)
+ (setq wikiword (substring wikiword-and-section
(match-end 0))))
+ (insert "\n#+INDEX: " wikiword "\n"))))))
+
+(defun hywiki-word-to-org-link (link &optional description)
+;; \"[[file:<hywiki-directory>/WikiWord.org::Multi-Word
Section][WikiWord#Multi-Word Section]]\".
+ (let ((resolved-link (hywiki-org-link-resolve link :full-data)))
+ (when (stringp (car resolved-link))
+ (let* ((path-word-suffix resolved-link)
+ (path (file-relative-name (nth 0 path-word-suffix)))
+ (path-stem (when path
+ (file-name-sans-extension path)))
+ (word (nth 1 path-word-suffix))
+ (suffix (nth 2 path-word-suffix))
+ (desc (cond (description)
+ (suffix (when word
+ (format "%s%s" word suffix)))
+ (word)))
+ suffix-no-hashmark)
+ (unless (and suffix (not (string-empty-p suffix)))
+ (setq suffix nil))
+ (setq suffix-no-hashmark (when suffix (substring suffix 1)))
+ (when (or (not buffer-file-name)
+ (string-equal path (file-name-nondirectory buffer-file-name)))
+ (setq path nil))
+ (cond (desc
+ (if path
+ (if suffix
+ ;; "[[file:path-stem.org::suffix][desc]"
+ (format "[[file:%s.org::%s][%s]]"
+ path-stem suffix-no-hashmark desc)
+ ;; "[[file:path-stem.org][desc]]")
+ (format "[[file:%s.org][%s]]" path-stem desc))
+ (if suffix
+ ;; "[[suffix][desc]]"
+ (format "[[%s][%s]]" suffix desc)
+ ;; "[[desc]]"
+ (format "[[%s]]" desc))))
+ (path
+ ;; "[[file:path-stem.org][word]]"
+ (format "[[file:%s.org][%s]]" path-stem word)))))))
(defun hywiki-maybe-at-wikiword-beginning ()
"Return non-nil if previous character is one preceding a HyWiki word.
@@ -1452,16 +1527,12 @@ Use `dired' unless
`action-key-modeline-buffer-id-function' is set to
(defun hywiki-directory-dired-edit ()
"Use `dired' to edit HyWiki pages in current `hywiki-directory'."
(interactive)
- (let ((case-fold-search nil)
- (shell-name (or shell-file-name "")))
- (if (string-match-p "bash\\(\\.exe\\)?$" shell-name)
- (dired (concat hywiki-directory
- "[[:upper:]][[:alpha:]]*"
- (regexp-quote hywiki-file-suffix)))
- (dired (cons hywiki-directory
- (directory-files hywiki-directory nil
- (format "^[A-Z][A-Za-z]*%s$"
- (regexp-quote
hywiki-file-suffix))))))))
+ (let ((case-fold-search nil))
+ (dired (cons hywiki-directory
+ (directory-files hywiki-directory nil
+ (format "^%s%s$"
+ hywiki-word-regexp
+ (regexp-quote
hywiki-file-suffix)))))))
(defun hywiki-directory-treemacs-edit ()
"Use `treemacs' to edit HyWiki pages in current `hywiki-directory'."
@@ -1814,8 +1885,8 @@ If in a programming mode, must be within a comment. Use
(when (and (hywiki-active-in-current-buffer-p)
(if (and (derived-mode-p 'prog-mode)
(not (apply #'derived-mode-p
hywiki-highlight-all-in-prog-modes)))
- ;; Non-nil if match is inside a comment
- (nth 4 (syntax-ppss))
+ ;; Non-nil if match is inside a comment or a string
+ (or (nth 4 (syntax-ppss)) (hypb:in-string-p))
t)
(or on-page-name
(cl-find (char-syntax last-command-event)
@@ -1883,7 +1954,7 @@ the current page unless they have sections attached."
(if (and (derived-mode-p 'prog-mode)
(not (apply #'derived-mode-p
hywiki-highlight-all-in-prog-modes)))
;; Non-nil if match is inside a comment
- (nth 4 (syntax-ppss))
+ (or (nth 4 (syntax-ppss)) (hypb:in-string-p))
t)
;; (or on-page-name
;; (cl-find (char-syntax last-command-event)
@@ -2109,13 +2180,13 @@ value of `hywiki-word-highlight-flag' is changed."
(hywiki-maybe-dehighlight-page-names))
(dolist (hywiki-words-regexp hywiki--any-wikiword-regexp-list)
(goto-char (point-min))
- (let ((highlight-in-comments-only
+ (let ((highlight-in-comments-and-strings-only
(and (derived-mode-p 'prog-mode)
(not (apply #'derived-mode-p
hywiki-highlight-all-in-prog-modes)))))
(while (re-search-forward hywiki-words-regexp nil t)
- (when (if highlight-in-comments-only
- ;; Non-nil if match is inside a comment
- (nth 4 (syntax-ppss))
+ (when (if highlight-in-comments-and-strings-only
+ ;; Non-nil if match is inside a comment or a
string
+ (or (nth 4 (syntax-ppss)) (hypb:in-string-p))
t)
(setq hywiki--start (match-beginning 1)
hywiki--end (match-end 1))
@@ -2245,18 +2316,20 @@ value returns nil."
If it is a pathname, expand it relative to `hywiki-directory'."
(when (and (stringp wikiword) (not (string-empty-p wikiword))
(string-match hywiki-word-with-optional-suffix-exact-regexp
wikiword))
- (let* ((_suffix (cond ((match-beginning 2)
+ (let* ((suffix (cond ((match-beginning 2)
(prog1 (substring wikiword (match-beginning 2))
;; Remove any #section suffix in `wikiword'.
(setq wikiword (match-string-no-properties 1
wikiword))))
- ((match-beginning 4)
- (prog1 (substring wikiword (match-beginning 4))
+ ((match-beginning 3)
+ (prog1 (substring wikiword (match-beginning 3))
;; Remove any :Lnum:Cnum suffix in `wikiword'.
(setq wikiword (match-string-no-properties
1 wikiword))))))
(referent (hash-get (hywiki-get-singular-wikiword wikiword)
(hywiki-get-referent-hasht))))
- referent)))
+ ;; If a referent type that can include a # or :L line
+ ;; number suffix, append it to the referent-value.
+ (setq referent (hywiki--add-suffix-to-referent suffix referent)))))
(defun hywiki-get-page-files ()
"Return the list of existing HyWiki page file names.
@@ -2549,22 +2622,28 @@ backend."
(pcase format
(`ascii (format "[%s] <%s:%s>" hywiki-org-link-type desc path))
(`html (format "<a href=\"%s.html%s\">%s</a>"
- path-stem (or suffix "")
+ path-stem
+ (hpath:spaces-to-dashes-markup-anchor
+ (or suffix ""))
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))
+ (`latex (format "\\href{%s.latex}{%s}" (replace-regexp-in-string
"[\\{}$%&_#~^]" "\\\\\\&" path-stem) desc))
+ (`md (format "[%s](%s.md%s)" desc path-stem
+ (hpath:spaces-to-dashes-markup-anchor
+ (or suffix ""))))
+ (`texinfo (format "@uref{%s.texi,%s}" path-stem desc))
(_ path))
link)))
(defun hywiki-org-link-resolve (link &optional full-data)
- "Resolve HyWiki word LINK to page.
+ "Resolve HyWikiWord LINK to its referent file or other type of referent.
+If the referent is not a file type, return (referent-type . referent-value).
+
+Otherwise:
Link may end with optional suffix of the form: (#|::)section:Lnum:Cnum.
-With optional FULL-DATA non-nil, return a list in the form of (filename
-word suffix); otherwise, with a section, return filename::section, with
-just line and optionally column numbers, return filename:Lnum:Cnum and
-without any suffix, return just the filename. Filename excludes the path.
-If the page is not found, return nil."
+With optional FULL-DATA non-nil, return a list in the form of (pathname
+word suffix); otherwise, with a section, return pathname::section, with
+just line and optionally column numbers, return pathname:Lnum:Cnum and
+without any suffix, return just the pathname."
(when (stringp link)
(when (string-match (concat "\\`" hywiki-org-link-type ":") link)
;; Remove hy: link prefix
@@ -2576,16 +2655,19 @@ If the page is not found, return nil."
(substring link 0 (match-beginning 0))
link))
(referent (and word (hywiki-get-referent word)))
- (filename (cdr referent)))
- (when (stringp filename)
- (cond
- (full-data
- (list filename word (concat suffix-type suffix)))
- ((and suffix (not (string-empty-p suffix)))
- (if (equal suffix-type ":L")
- (concat filename suffix-type suffix)
- (concat filename "::" suffix)))
- (t filename))))))
+ (referent-type (car referent))
+ (pathname (when (memq referent-type '(page path-link))
+ (cdr referent))))
+ (if (stringp pathname)
+ (cond
+ (full-data
+ (list pathname word (concat suffix-type suffix)))
+ ((and suffix (not (string-empty-p suffix)))
+ (if (equal suffix-type ":L")
+ (concat pathname suffix-type suffix)
+ (concat pathname "::" suffix)))
+ (t pathname))
+ referent))))
(defun hywiki-org-link-store ()
"Store a link to a HyWiki word at point, if any."
@@ -2650,7 +2732,14 @@ Files are saved in:
Customize this directory with:
{M-x customize-variable RET hywiki-org-publishing-directory RET}."
(interactive "P")
- (org-publish-project "hywiki" all-pages-flag))
+ ;; Export Org to html with useful link ids.
+ ;; Instead of random ids like \"orga1b2c3\", use heading titles,
+ ;; made unique when necessary."
+ (unwind-protect
+ (progn
+ (advice-add #'org-export-get-reference :override
#'hywiki--org-export-get-reference)
+ (org-publish-project "hywiki" all-pages-flag))
+ (advice-remove #'org-export-get-reference
#'hywiki--org-export-get-reference)))
(defun hywiki-referent-exists-p (&optional word start end)
"Return an optional HyWiki WORD or word at point, if has an existing
referent.
@@ -2664,10 +2753,11 @@ Word may be of form:
When using the word at point, a call to `hywiki-active-in-current-buffer-p'
at point must return non-nil or this function will return nil."
- (setq hywiki--page-name word
- word (hywiki-strip-org-link word))
+ (setq hywiki--page-name word)
+ (when (stringp word)
+ (setq word (hywiki-strip-org-link word)))
(if (or (stringp word)
- (setq word (hywiki-word-at)))
+ (setq word (hywiki-word-at word)))
(unless (hywiki-get-referent word)
(setq word nil))
(setq word nil))
@@ -2753,7 +2843,7 @@ Action Key press; with a prefix ARG, emulate an Assist
Key press."
(hkey-either arg))))
(defun hywiki-word-at (&optional range-flag)
- "Return HyWikiWord and optional #section:Lnum:Cnum at point or nil.
+ "Return potential HyWikiWord and optional #section:Lnum:Cnum at point or nil.
Point should be on the HyWikiWord itself.
With optional RANGE-FLAG, return a list of (HyWikiWord start-position
@@ -2768,9 +2858,10 @@ or this will return nil."
(if (setq hywiki--range
(hproperty:char-property-range (point) 'face hywiki-word-face))
(let ((wikiword (buffer-substring-no-properties (car hywiki--range)
(cdr hywiki--range))))
+ (when (string-match hywiki-word-with-optional-suffix-exact-regexp
wikiword)
(if range-flag
(list wikiword (car hywiki--range) (cdr hywiki--range))
- wikiword))
+ wikiword)))
(save-excursion
;; Don't use `cl-destructuring-bind' here since the `hargs:delimited'
call
;; can return nil rather than the 3 arg list that would be required
@@ -2864,9 +2955,11 @@ these are handled by the Org mode link handler."
(and (stringp word) (not (string-empty-p word))
(let (case-fold-search)
(or (string-match hywiki-word-with-optional-suffix-exact-regexp word)
- ;; For now this next version allows spaces and tabs in the suffix
part
- (eq (string-match
hywiki-word-with-optional-spaces-suffix-exact-regexp word)
- 0)))))
+ ;; For now this next version allows spaces and tabs in
+ ;; the suffix part
+ (eq 0 (string-match
+ hywiki-word-with-optional-spaces-suffix-exact-regexp
+ word))))))
(defun hywiki-word-read (&optional prompt)
"Prompt with completion for and return an existing HyWikiWord.
@@ -2890,27 +2983,46 @@ Function is called with 4 arguments: (SYMBOL
SET-TO-VALUE OPERATION WHERE).
Highlight/dehighlight HyWiki page names across all frames on change."
(unless (memq operation '(let unlet)) ;; not setting global value
(set symbol set-to-value)
- (if set-to-value
- ;; enabled
- (progn (add-hook 'pre-command-hook
'hywiki-debuttonize-non-character-commands 95)
- (add-hook 'post-command-hook
'hywiki-buttonize-non-character-commands 95)
- (add-hook 'post-self-insert-hook
'hywiki-buttonize-character-commands)
- (add-hook 'window-buffer-change-functions
- 'hywiki-maybe-highlight-wikiwords-in-frame)
- (add-to-list 'yank-handled-properties
- '(hywiki-word-face . hywiki-highlight-on-yank))
- (hywiki-maybe-highlight-wikiwords-in-frame t))
- ;; disabled
- (remove-hook 'pre-command-hook
'hywiki-debuttonize-non-character-commands)
- (remove-hook 'post-command-hook
'hywiki-buttonize-non-character-commands)
- (remove-hook 'post-self-insert-hook 'hywiki-buttonize-character-commands)
- (hywiki-mode 0) ;; also dehighlights HyWiki words outside of HyWiki pages
- (remove-hook 'window-buffer-change-functions
- 'hywiki-maybe-highlight-wikiwords-in-frame)
- (hywiki-maybe-highlight-wikiwords-in-frame t)
- (setq yank-handled-properties
- (delete '(hywiki-word-face . hywiki-highlight-on-yank)
- yank-handled-properties)))))
+ (hywiki-word-set-auto-highlighting set-to-value)))
+
+(defun hywiki-word-set-auto-highlighting (arg)
+ "With a prefix ARG, turn on HyWikiWord auto-highlighting.
+Otherwise, turn it off.
+
+Auto-highlighting uses pre- and post-command hooks. If an error
+occurs with one of these hooks, the problematic hook is removed.
+Invoke this command with a prefix argument to restore the
+auto-highlighting."
+ (interactive "P")
+ (if arg
+ ;; enable
+ (progn
+ (when hywiki-word-highlight-flag
+ (add-hook 'pre-command-hook
'hywiki-debuttonize-non-character-commands 95)
+ (add-hook 'post-command-hook
'hywiki-buttonize-non-character-commands 95)
+ (add-hook 'post-self-insert-hook 'hywiki-buttonize-character-commands)
+ (add-hook 'window-buffer-change-functions
+ 'hywiki-maybe-highlight-wikiwords-in-frame)
+ (add-to-list 'yank-handled-properties
+ '(hywiki-word-face . hywiki-highlight-on-yank))
+ (hywiki-maybe-highlight-wikiwords-in-frame t))
+ (when (called-interactively-p 'interactive)
+ (if hywiki-word-highlight-flag
+ (message "HyWikiWord page auto-highlighting enabled")
+ (message "`hywiki-word-highlight-flag' must first be set to t to
enable auto-highlighting"))))
+ ;; disable
+ (remove-hook 'pre-command-hook
'hywiki-debuttonize-non-character-commands)
+ (remove-hook 'post-command-hook
'hywiki-buttonize-non-character-commands)
+ (remove-hook 'post-self-insert-hook 'hywiki-buttonize-character-commands)
+ (hywiki-mode 0) ;; also dehighlights HyWiki words outside of HyWiki pages
+ (remove-hook 'window-buffer-change-functions
+ 'hywiki-maybe-highlight-wikiwords-in-frame)
+ (hywiki-maybe-highlight-wikiwords-in-frame t)
+ (setq yank-handled-properties
+ (delete '(hywiki-word-face . hywiki-highlight-on-yank)
+ yank-handled-properties))
+ (when (called-interactively-p 'interactive)
+ (message "HyWikiWord page auto-highlighting disabled"))))
;;; ************************************************************************
;;; Private functions
@@ -2942,8 +3054,9 @@ invalid. Appended only if the referent-type supports
suffixes."
referent))))))
(defun hywiki--extend-yanked-region (start end)
- "Return a list of (START END) with the specified range extended to include
any delimited regions.
-Typically used to extend a yanked region to fully include any strings or
balanced pair delimiters."
+ "Extend range (START END) with any delimited regions and return the new
range.
+Typically used to extend a yanked region to fully include any strings
+or balanced pair delimiters."
(let ((delim-distance 0)
(result (list start end))
opoint)
@@ -3069,6 +3182,120 @@ DIRECTION-NUMBER is 1 for forward scanning and -1 for
backward scanning."
(funcall func (1+ start) end)
(setq hywiki--highlighting-done-flag nil)))))
+;;; ************************************************************************
+;;; Private Org export override functions
+;;; ************************************************************************
+
+;; Thanks to alphapapa for the GPLed code upon which these hywiki--org
+;; functions are based. These change the html ids that Org export
+;; generates to use the text of headings rather than randomly
+;; generated ids.
+
+(require 'cl-extra) ;; for `cl-some'
+(require 'ox) ;; for `org-export-get-reference'
+(require 'url-util) ;; for `url-hexify-string'
+
+(defun hywiki--org-export-get-reference (datum info)
+ "Return a unique reference for DATUM, as a string.
+Like `org-export-get-reference' but uses modified heading strings as
+link ids rather than generated ids. To form an id, spaces in headings
+are replaces with dashes and to make each id unique, heading parent
+ids are prepended separated by '--'.
+
+DATUM is either an element or an object. INFO is the current
+export state, as a plist.
+
+References for the current document are stored in
+‘:internal-references’ property. Its value is an alist with
+associations of the following types:
+
+ (REFERENCE . DATUM) and (SEARCH-CELL . ID)
+
+REFERENCE is the reference string to be used for object or
+element DATUM. SEARCH-CELL is a search cell, as returned by
+‘org-export-search-cells’. ID is a number or a string uniquely
+identifying DATUM within the document.
+
+This function also checks ‘:crossrefs’ property for search cells
+matching DATUM before creating a new reference."
+ (let ((cache (plist-get info :internal-references)))
+ (or (car (rassq datum cache))
+ (let* ((crossrefs (plist-get info :crossrefs))
+ (cells (org-export-search-cells datum))
+ ;; Preserve any pre-existing association between
+ ;; a search cell and a reference, i.e., when some
+ ;; previously published document referenced a location
+ ;; within current file (see
+ ;; `org-publish-resolve-external-link').
+ ;;
+ ;; However, there is no guarantee that search cells are
+ ;; unique, e.g., there might be duplicate custom ID or
+ ;; two headings with the same title in the file.
+ ;;
+ ;; As a consequence, before reusing any reference to
+ ;; an element or object, we check that it doesn't refer
+ ;; to a previous element or object.
+ (new (or (when (org-element-property :raw-value datum)
+ ;; Heading with a title
+ (hywiki--org-export-new-title-reference datum cache))
+ (cl-some
+ (lambda (cell)
+ (let ((stored (cdr (assoc cell crossrefs))))
+ (when stored
+ (let ((old (org-export-format-reference
stored)))
+ (and (not (assoc old cache)) stored)))))
+ cells)
+ (org-export-format-reference
+ (org-export-new-reference cache))))
+ (reference-string new))
+ ;; Cache contains both data already associated to
+ ;; a reference and in-use internal references, so as to make
+ ;; unique references.
+ (dolist (cell cells) (push (cons cell new) cache))
+ ;; Retain a direct association between reference string and
+ ;; DATUM since (1) not every object or element can be given
+ ;; a search cell (2) it permits quick lookup.
+ (push (cons reference-string datum) cache)
+ (plist-put info :internal-references cache)
+ reference-string))))
+
+(defun hywiki--org-export-new-title-reference (datum cache)
+ "Return new heading title reference for DATUM that is unique in CACHE."
+ (let* ((title (org-element-property :raw-value datum))
+ (ref (hywiki--org-format-reference title))
+ (parent (org-element-property :parent datum))
+ raw-parent)
+ (while (--any (equal ref (car it))
+ cache)
+ ;; Title not unique: make it so.
+ (if parent
+ ;; Append ancestor title.
+ (setq raw-parent (org-element-property :raw-value parent)
+ title (if (and (stringp raw-parent) (not (string-empty-p
raw-parent)))
+ (concat raw-parent "--" title)
+ title)
+ ref (hywiki--org-format-reference title)
+ parent (org-element-property :parent parent))
+ ;; No more ancestors: add and increment a number.
+ (when (string-match "\\`\\([[:unibyte:]]\\)+?\\(--\\([0-9]+\\)\\)?\\'"
+ ref)
+ (let ((num (match-string 3 ref)))
+ (setq parent (match-string 1 ref)
+ parent (if (stringp parent) (concat parent "--") "")
+ num (if num
+ (string-to-number num)
+ 0)
+ ref (format "%s%s" parent (cl-incf num)))))))
+ ref))
+
+(defun hywiki--org-format-reference (title)
+ "Format TITLE string as an html id."
+ (url-hexify-string
+ (replace-regexp-in-string "\\[\\[\\([a-z]+:\\)?\\|\\]\\[\\|\\]\\]" ""
+ (subst-char-in-string
+ ?\ ?-
+ (substring-no-properties title)))))
+
;;; ************************************************************************
;;; Private initializations
;;; ************************************************************************
diff --git a/test/hact-tests.el b/test/hact-tests.el
index 00c37b1e0c..7564b3ce10 100644
--- a/test/hact-tests.el
+++ b/test/hact-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell
;;
;; Orig-Date: 16-May-24 at 00:29:22
-;; Last-Mod: 16-May-24 at 23:51:18 by Mats Lidell
+;; Last-Mod: 22-Feb-25 at 09:35:56 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -23,8 +23,8 @@
(ert-deftest hact-tests--action-params-with-lambdas ()
"Lambda used with `action:params' should return the lambda parameters."
(should (equal nil (action:params (lambda () nil))))
- (should (equal '(x) (action:params (lambda (x) nil))))
- (should (equal '(x y) (action:params (lambda (x y) nil)))))
+ (should (equal '(_x) (action:params (lambda (_x) nil))))
+ (should (equal '(_x _y) (action:params (lambda (_x _y) nil)))))
(ert-deftest hact-tests--actype-act-with-lambdas ()
"Lambda with `actype:act' should work over versions of Emacs.
diff --git a/test/hywiki-tests.el b/test/hywiki-tests.el
index 89107ceee0..f897d95658 100644
--- a/test/hywiki-tests.el
+++ b/test/hywiki-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell
;;
;; Orig-Date: 18-May-24 at 23:59:48
-;; Last-Mod: 7-Feb-25 at 10:01:25 by Mats Lidell
+;; Last-Mod: 23-Feb-25 at 11:04:10 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -621,7 +621,7 @@ Both mod-time and checksum must be changed for a test to
return true."
(with-hywiki-buttonize-and-insert-hooks (insert "WikiWord "))
(goto-char 4)
(hywiki-convert-words-to-org-links)
- (should (string= "[[hy:WikiWord]] "
+ (should (string= "[[WikiWord]] "
(buffer-substring-no-properties (point-min)
(point-max)))))
(with-temp-buffer
(hywiki-mode 1)
@@ -630,7 +630,7 @@ Both mod-time and checksum must be changed for a test to
return true."
(newline nil t))
(goto-char 4)
(hywiki-convert-words-to-org-links)
- (should (string= "[[hy:WikiWord]]\n"
+ (should (string= "[[WikiWord]]\n"
(buffer-substring-no-properties (point-min)
(point-max))))))
(hywiki-tests--add-hywiki-hooks)
(hywiki-mode 0)
@@ -694,24 +694,24 @@ Both mod-time and checksum must be changed for a test to
return true."
"Verify `hywiki-org-link-export' output for different formats."
(let* ((hywiki-directory (make-temp-file "hywiki" t))
(wikipage (cdr (hywiki-add-page "WikiWord")))
- (filename (when wikipage (file-name-nondirectory wikipage))))
+ (filename (when wikipage (file-name-nondirectory wikipage)))
+ (filename-stem (when filename (file-name-sans-extension filename))))
(unwind-protect
(progn
(should (string-match-p
(format "\\[hy\\] <doc:.*%s>" filename)
(hywiki-org-link-export "WikiWord" "doc" 'ascii)))
(should (string-match-p
- (format "<a href=\".*%s\">doc</a>"
- (replace-regexp-in-string "\\.org" ".html"
filename))
+ (format "<a href=\".*%s.html\">doc</a>" filename-stem)
(hywiki-org-link-export "WikiWord" "doc" 'html)))
(should (string-match-p
- (format "\\[doc\\](.*%s)" filename)
+ (format "\\[doc\\](.*%s.md)" filename-stem)
(hywiki-org-link-export "WikiWord" "doc" 'md)))
(should (string-match-p
- (format "\\href{.*%s}{doc}" filename)
+ (format "\\href{.*%s.latex}{doc}" filename-stem)
(hywiki-org-link-export "WikiWord" "doc" 'latex)))
(should (string-match-p
- (format "@uref{.*%s,doc}" filename)
+ (format "@uref{.*%s.texi,doc}" filename-stem)
(hywiki-org-link-export "WikiWord" "doc" 'texinfo)))
(should (string-match-p
(format ".*%s" filename)
@@ -892,16 +892,14 @@ Note special meaning of `hywiki-allow-plurals-flag'."
(ert-deftest hywiki-tests--add-org-roam-node ()
"Verify `hywiki-add-org-roam-node'."
(let* ((hywiki-directory (make-temp-file "hywiki" t))
- (wiki-page (cdr (hywiki-add-page "FirstWord")))
(wikiword (hy-make-random-wikiword)))
(unwind-protect
(mocklet (((hypb:require-package 'org-roam) => t)
((org-roam-node-read) => "node")
- ((org-roam-node-title "node") => "node-title"))
+ (org-roam-node-title => "node-title"))
(hywiki-add-org-roam-node wikiword)
(should (equal '(org-roam-node . "node-title")
(hywiki-get-referent wikiword))))
- (hy-delete-file-and-buffer wiki-page)
(hy-delete-dir-and-buffer hywiki-directory))))
;;; FIXME
