branch: externals/hyperbole
commit deb608fa5f37f641c92f57d4e7da4939f9a22f25
Author: bw <[email protected]>
Commit: bw <[email protected]>
hywiki.el - Many bug fixes and use section names for Org html ids
---
ChangeLog | 64 ++++++++
hpath.el | 18 ++-
hui-mini.el | 8 +-
hywiki.el | 518 +++++++++++++++++++++++++++++++++++++++++++-----------------
4 files changed, 454 insertions(+), 154 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 46b5c47b3e..85099acc42 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2025-02-23 Bob Weiner <[email protected]>
+
+* 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 <[email protected]>
+
+* 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'.
@@ -10,6 +25,16 @@
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
@@ -31,12 +56,33 @@
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-19 Bob Weiner <[email protected]>
+* 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.
@@ -58,6 +104,24 @@
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 <[email protected]>
+
+* 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 <[email protected]>
* hywiki.el (hywiki--sitemap-file): Helper function for getting the sitemap
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/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/hywiki.el b/hywiki.el
index ddd716e0e2..ff3d69cf9c 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 02:21:03 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,88 @@ 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
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 (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 +1526,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 +1884,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 +1953,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 +2179,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 +2315,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 +2621,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))
+ (`md (format "[%s](%s.md%s)" desc path-stem
+ (hpath:spaces-to-dashes-markup-anchor
+ (or suffix ""))))
(`texinfo (format "@uref{%s,%s}" path 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 +2654,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 +2731,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 +2752,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 +2842,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 +2857,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 +2954,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 +2982,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 +3053,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 +3181,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
;;; ************************************************************************
