branch: externals/hyperbole
commit 1d551be5bb8a9813e0092664473b0e8b7a477358
Author: Bob Weiner <r...@gnu.org>
Commit: Bob Weiner <r...@gnu.org>
hywiki.el - Fixes and performance improvements
---
ChangeLog | 21 ++++
hywiki.el | 326 ++++++++++++++++++++++++++++++++++----------------------------
2 files changed, 201 insertions(+), 146 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index d366717c57..71ce5e8ae6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,27 @@
+2024-04-24 Bob Weiner <r...@gnu.org>
+
2024-04-23 Bob Weiner <r...@gnu.org>
* hywiki.el: Remove autoload from defib and 'hywiki-open', fixing autoload
error.
+ (hywiki-company-hasht-backend): Complete words, not symbols
+ (no punctuation).
+ (hywiki-open): Rename to 'hywiki-find-page' and automatically
create
+ any non-existent page unless optional 'prompt-flag' is t, then prompt
+ whether to create. If 'prompt-flag' is 'exists, return an existing page
only,
+ else nil.
+ (hywiki-complete): Rename to 'hywiki-org-link-complete'. Insert
+ `hywiki-org-link-type' only when 'hywiki-org-link-type-required' is
non-nil.
+ (hywiki-store-link): Rename to 'hywiki-org-link-store'. Insert
+ `hywiki-org-link-type' only when 'hywiki-org-link-type-required' is
non-nil.
+ (hywiki-org-link-type): Change value from 'hy:' to 'hy'.
+ (hywiki-page-list): Rename to 'hywiki-get-page-list'.
+ (hywiki-get-pages): Rename to 'hywiki-get-page-hasht'.
+ (hywiki-word-section-regexp): Add.
+ (hywiki-get-page-files): Add missing '+' for multiple chars in
file suffix.
+ (hywiki-at-wikiword, hywiki-highlight-page-names): Allow for
numerics
+ in #section references.
+ (hywiki--word-face): Change foreground of HyWiki word to 'orange'
+ when on a dark background.
2024-04-22 Bob Weiner <r...@gnu.org>
diff --git a/hywiki.el b/hywiki.el
index 7c59b69614..83ea51d17f 100644
--- a/hywiki.el
+++ b/hywiki.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 21-Apr-24 at 22:41:13
-;; Last-Mod: 23-Apr-24 at 18:49:43 by Bob Weiner
+;; Last-Mod: 24-Apr-24 at 02:26:23 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -25,8 +25,7 @@
;; Org link in any buffer with the prefix "hy:" followed by a
;; capitalized alpha characters-only WikiWord, e.g. [[hy:Emacs]], and
;; then press the Action Key on the link to jump to the associated
-;; page. You will be prompted to create the page if it does not
-;; exist.
+;; page; new pages are automatically created.
;; If you set `hywiki-org-link-type-required' to `nil', then
;; you don't need the prefix, e.g. [[Emacs]] and existing HyWiki page
@@ -93,8 +92,8 @@ Applies only when the file is below `hywiki-directory'.")
(defconst hywiki-directory '"~/hywiki/"
"Directory in which to find HyWiki page files.")
-(defconst hywiki-org-link-type "hy:"
- "HyWiki string prefix type for Org links.")
+(defconst hywiki-org-link-type "hy"
+ "HyWiki string prefix type for Org links. Excludes trailing colon.")
(defvar hywiki-org-link-type-required t
"When non-nil, HyWiki Org links must start with `hywiki-org-link-type'.
@@ -107,8 +106,14 @@ override standard Org link lookups. See \"(org)Internal
Links\".")
"\\<\\([[:upper:]][[:alpha:]]+\\)\\>"
"Regexp that matches a HyWiki word only.")
+(defconst hywiki-word-section-regexp
+ "\\(#[^][# \t\n\r\f]+\\)"
+ "Regexp that matches a HyWiki word #section extension.
+After the first # character, this may contain any non-square-bracket,
+non-# and non-whitespace characters.")
+
(defconst hywiki-word-optional-section-regexp
- (concat hywiki-word-regexp "\\(#[^][ \t\n\r\f]+\\)?")
+ (concat hywiki-word-regexp hywiki-word-section-regexp "?")
"Regexp that matches a HyWiki word with an optional #section.
Section may not contain spaces or square brackets. Use '-' to
substitute for spaces in the section/headline name. Grouping 1 is
@@ -122,9 +127,9 @@ substitute for spaces in the section/headline name.
Grouping 1 is
the HyWiki word and grouping 2 is the #section with the # included.")
(defface hywiki--word-face
- '((((min-colors 88) (background dark)) (:foreground "mediumbrown"))
+ '((((min-colors 88) (background dark)) (:foreground "orange"))
(((background dark)) (:background "orange" :foreground "black"))
- (((min-colors 88)) (:foreground "darkbrown"))
+ (((min-colors 88)) (:foreground "orange"))
(t (:background "orange")))
"Face for HyWiki word highlighting."
:group 'hyperbole-buttons)
@@ -145,18 +150,23 @@ the HyWiki word and grouping 2 is the #section with the #
included.")
(when page-name
(ibut:label-set page-name (match-beginning 0) (match-end 0))
(hywiki-highlight-page-name t)
- (hact 'hywiki-open page-name))))
+ (hact 'hywiki-find-page page-name))))
-(defun hywiki-open (page-name)
- "Display HyWiki PAGE-NAME. Prompt to create if non-existent."
- (interactive (list (completing-read "HyWiki page: " (hywiki-page-list))))
+(defun hywiki-find-page (page-name &optional prompt-flag)
+ "Display HyWiki PAGE-NAME. By default, create any non-existent page.
+With optional PROMPT-FLAG t, prompt to create if non-existent. If
+PROMPT-FLAG is 'exists, return nil unless the page already exists."
+ (interactive (list (completing-read "Find HyWiki page: "
(hywiki-get-page-list))))
(let* ((section (when (string-match "#" page-name)
(substring page-name (match-beginning 0))))
(page-name (if (string-match "#" page-name)
- (substring page-name 0 (match-beginning 0))
- page-name))
+ (substring page-name 0 (match-beginning 0))
+ page-name))
(page-file (or (hywiki-get-page page-name)
- (when (y-or-n-p (concat "Create missing page, "
page-name "? "))
+ (if prompt-flag
+ (unless (eq prompt-flag 'exists)
+ (when (y-or-n-p (concat "Create new `" page-name
"' page? "))
+ (hywiki-add-page page-name)))
(hywiki-add-page page-name)))))
(when page-file
(hpath:find (concat page-file section)))))
@@ -165,8 +175,29 @@ the HyWiki word and grouping 2 is the #section with the #
included.")
;;; Public functions
;;; ************************************************************************
+(defun hywiki-add-to-page (page-name text start-flag)
+ "Add to PAGE-NAME TEXT at page start with START-FLAG non-nil, else end.
+Create page if it does not exist. If PAGE-NAME is invalid, return
+nil, else return the file name of the page."
+ (let* ((page-file (hywiki-add-page page-name))
+ (page-buf (when page-file (find-file-noselect page-file))))
+ (when page-buf
+ (save-excursion
+ (set-buffer page-buf)
+ (barf-if-buffer-read-only)
+ (save-restriction
+ (widen)
+ (goto-char (if start-flag (point-min) (point-max)))
+ (unless (bolp) (insert (newline)))
+ (insert text)
+ (unless (bolp) (insert (newline)))
+ (goto-char (if start-flag (point-min) (point-max)))
+ page-file)))))
+
(defun hywiki-at-wikiword (&optional org-link-flag)
- "Return HyWiki word and optional #section at point or nil if not on one."
+ "Return HyWiki word and optional #section at point or nil if not on one.
+Does not test whether or not a page exists for the HyWiki word.
+Use `hywiki-get-page' to determine whether a HyWiki page exists."
(let (wikiword)
(if (or org-link-flag (hsys-org-link-at-p))
;; Handle an Org link [[HyWiki word]] [[hy:HyWiki word]] or [[HyWiki
word#section]]
@@ -185,12 +216,25 @@ the HyWiki word and grouping 2 is the #section with the #
included.")
(or buffer-file-name ""))
(save-excursion
(let ((case-fold-search nil))
- (skip-chars-backward "-*#[:alpha:]")
+ (skip-chars-backward "-*#[:alnum:]")
;; Ignore wikiwords preceded by any non-whitespace character
(and (or (bolp) (memq (preceding-char) '(?\[ ?\ ?\t ?\n ?\r
?\f)))
(looking-at hywiki-word-optional-section-regexp)
(string-trim (match-string-no-properties 0)))))))))
+;; Globally set these values to avoid using 'let' with stack allocations
+;; within `hywiki-highlight-page-name' frequently.
+(setq hywiki--any-page-regexp nil
+ hywiki--but nil
+ hywiki--but-end nil
+ hywiki--but-start nil
+ hywiki--current-page nil
+ hywiki--end nil
+ hywiki--page-name nil
+ hywiki--save-case-fold-search nil
+ hywiki--save-org-link-type-required nil
+ hywiki--start nil)
+
(defun hywiki-highlight-page-names ()
"Highlight all non-Org link HyWiki page names in the buffer.
Use `hywiki-word-face' to highlight. Does not highlight references to
@@ -198,36 +242,40 @@ the current page unless they have sections attached.
Used as a `find-file-hook'."
(interactive)
+ ;; Avoid doing any lets in this `post-self-insert-function' for efficiency
+
;; Highlight HyWiki words only in files below `hywiki-directory'
(when (and hywiki-word-highlight-flag
(string-prefix-p (expand-file-name hywiki-directory)
(or buffer-file-name "")))
- (let ((any-page (string-join (hywiki-page-list) "\\|"))
- (case-fold-search nil)
- (hywiki-org-link-type-required t)
- current-page
- start
- end)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward (format "\\<\\(%s\\)\\>" any-page) nil t)
- (setq start (match-beginning 0)
- end (match-end 0))
- (save-excursion
- (goto-char start)
- ;; Ignore wikiwords preceded by any non-whitespace character
- (when (or (bolp) (memq (preceding-char) '(?\ ?\t)))
- ;; Include any #section
- (skip-chars-forward "-#[:alpha:]")
- (setq end (point)
- current-page (hywiki-get-buffer-page-name))
- ;; Don't highlight current-page matches unless
- ;; they include a #section.
- (unless (string-equal current-page
- (buffer-substring-no-properties start
end))
- (hproperty:but-add start end hywiki-word-face))))))))))
+ (save-excursion
+ (save-restriction
+ (setq hywiki--any-page-regexp (regexp-opt (hywiki-get-page-list) 'words)
+ hywiki--save-case-fold-search case-fold-search
+ case-fold-search nil
+ hywiki--save-org-link-type-required hywiki-org-link-type-required
+ hywiki-org-link-type-required t
+ hywiki--current-page (hywiki-get-buffer-page-name))
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward hywiki--any-page-regexp nil t)
+ (setq hywiki--start (match-beginning 0)
+ hywiki--end (match-end 0))
+ (save-excursion
+ (goto-char hywiki--start)
+ ;; Ignore wikiwords preceded by any non-whitespace character
+ (when (or (bolp) (memq (preceding-char) '(?\ ?\t)))
+ ;; Include any #section
+ (skip-syntax-forward "^-\)$\>.\"\'")
+ (skip-chars-forward "-#[:alnum:]")
+ (setq hywiki--end (point))
+ ;; Don't highlight current-page matches unless
+ ;; they include a #section.
+ (unless (string-equal hywiki--current-page
+ (buffer-substring-no-properties
hywiki--start hywiki--end))
+ (hproperty:but-add hywiki--start hywiki--end
hywiki-word-face)))))))
+ (setq case-fold-search hywiki--save-case-fold-search
+ hywiki-org-link-type-required hywiki--save-org-link-type-required)))
(defun hywiki-highlight-page-name (&optional on-page-name)
"Highlight any non-Org link HyWiki page name one character before point.
@@ -248,48 +296,45 @@ Used as a `post-self-insert-hook'."
(not noninteractive)
(string-prefix-p (expand-file-name hywiki-directory)
(or buffer-file-name "")))
- (let ((case-fold-search nil)
- (hywiki-org-link-type-required t)
- but
- current-page
- page-name
- start
- end)
- (save-excursion
- (if on-page-name
- (progn (skip-syntax-backward "^-\)$\>.\"\'")
- (skip-chars-backward "#[:alpha:]"))
- ;; after page name
- (goto-char (max (1- (point)) (point-min)))
- (skip-chars-backward "-#[:alpha:]"))
- (if (and (looking-at hywiki-word-optional-section-regexp)
- ;; Ignore wikiwords preceded by any non-whitespace character
- (or (bolp) (memq (preceding-char) '(?\ ?\t ?\n ?\r ?\f)))
- (progn
- (setq page-name (match-string-no-properties 1)
- start (match-beginning 0)
- end (match-end 0))
- (and (hywiki-get-page page-name)
- ;; Ignore wikiwords preceded by any non-whitespace
character
- (or (bolp) (memq (preceding-char) '(?\ ?\t))))))
- (progn
- (setq current-page (hywiki-get-buffer-page-name))
- ;; Don't highlight current-page matches unless
- ;; they include a #section.
- (unless (string-equal current-page
- (buffer-substring-no-properties start end))
- (if (setq but (hproperty:but-get (point) 'face
hywiki-word-face))
- (progn
- (setq but-start (hproperty:but-start but)
- but-end (hproperty:but-end but))
- (unless (and (= start but-start) (= end but-end))
- (hproperty:but-delete but)
- (hproperty:but-add start end hywiki-word-face)))
- (hproperty:but-add start end hywiki-word-face))))
- ;; Remove any potential earlier highlighting since the
- ;; previous word may have changed.
- (skip-syntax-backward "^-\)$\>.\"\'")
- (hproperty:but-clear (point) 'face hywiki-word-face))))))
+ (save-excursion
+ (unless on-page-name
+ ;; after page name
+ (goto-char (max (1- (point)) (point-min))))
+ (skip-syntax-backward "^-\)$\>.\"\'")
+ (skip-chars-backward "#[:alpha:]")
+
+ (setq hywiki--save-case-fold-search case-fold-search
+ case-fold-search nil
+ hywiki--save-org-link-type-required hywiki-org-link-type-required
+ hywiki-org-link-type-required t)
+ (if (and (looking-at hywiki-word-optional-section-regexp)
+ ;; Ignore wikiwords preceded by any non-whitespace character
+ (or (bolp) (memq (preceding-char) '(?\ ?\t ?\n ?\r ?\f)))
+ (progn
+ (setq hywiki--page-name (match-string-no-properties 1)
+ hywiki--start (match-beginning 0)
+ hywiki--end (match-end 0))
+ (and (hywiki-get-page hywiki--page-name)
+ ;; Ignore wikiwords preceded by any non-whitespace
character
+ (or (bolp) (memq (preceding-char) '(?\ ?\t))))))
+ (progn
+ (setq hywiki--current-page (hywiki-get-buffer-page-name))
+ ;; Don't highlight current-page matches unless
+ ;; they include a #section.
+ (unless (string-equal hywiki--current-page
+ (buffer-substring-no-properties hywiki--start
hywiki--end))
+ (if (setq hywiki--but (hproperty:but-get (point) 'face
hywiki-word-face))
+ (progn
+ (setq hywiki--but-start (hproperty:but-start hywiki--but)
+ hywiki--but-end (hproperty:but-end hywiki--but))
+ (unless (and (= hywiki--start hywiki--but-start) (=
hywiki--end hywiki--but-end))
+ (hproperty:but-delete hywiki--but)
+ (hproperty:but-add hywiki--start hywiki--end
hywiki-word-face)))
+ (hproperty:but-add hywiki--start hywiki--end
hywiki-word-face))))
+ ;; Remove any potential earlier highlighting since the
+ ;; previous word may have changed.
+ (skip-syntax-backward "^-\)$\>.\"\'")
+ (hproperty:but-clear (point) 'face hywiki-word-face)))))
(defun hywiki-is-wikiword (word)
"Return non-nil if WORD is a HyWiki word and optional #section.
@@ -306,26 +351,6 @@ to determine whether a HyWiki word page exists."
(file-name-sans-extension (file-name-nondirectory
(or buffer-file-name (buffer-name)))))
-(defun hywiki-get-pages ()
- (or hywiki-pages-hasht (hywiki-make-pages-hasht)))
-
-(defun hywiki-get-page-files ()
- "Return the list of existing HyWiki page file names.
-These may have any alphanumeric file suffix, if files were added manually."
- (directory-files-recursively hywiki-directory (concat "^" hywiki-word-regexp
"\\.[A-Za-z0-9]$")))
-
-(defun hywiki-get-page-file (page-name)
- "Return possibly non-existent file name for PAGE NAME.
-No validation of PAGE-NAME is done."
- (concat (expand-file-name page-name hywiki-directory) hywiki-file-suffix))
-
-(defun hywiki-make-pages-hasht ()
- (let* ((page-files (hywiki-get-page-files))
- (page-elts (mapcar (lambda (file)
- (cons file (file-name-sans-extension
(file-name-nondirectory file))))
- page-files)))
- (setq hywiki-pages-hasht (hash-make page-elts))))
-
(defun hywiki-get-page (page-name)
"Return the absolute path of HyWiki PAGE-NAME or nil if it does not exist."
(if (and (stringp page-name) (not (string-empty-p page-name))
@@ -335,12 +360,29 @@ No validation of PAGE-NAME is done."
;; Remove any #section suffix in PAGE-NAME.
(setq page-name (match-string-no-properties 1 page-name)))
- (or (hash-get page-name (hywiki-get-pages))
+ (or (hash-get page-name (hywiki-get-page-hasht))
;; If page exists but not yet in lookup hash table, add it.
(when (file-readable-p (hywiki-get-page-file page-name))
(hywiki-add-page page-name))))
(user-error "(hywiki-get-page): Invalid page name: '%s'; must be
capitalized, all alpha" page-name)))
+(defun hywiki-get-page-file (page-name)
+ "Return possibly non-existent file name for PAGE NAME.
+No validation of PAGE-NAME is done."
+ (concat (expand-file-name page-name hywiki-directory) hywiki-file-suffix))
+
+(defun hywiki-get-page-files ()
+ "Return the list of existing HyWiki page file names.
+These may have any alphanumeric file suffix, if files were added manually."
+ (directory-files-recursively hywiki-directory (concat "^" hywiki-word-regexp
"\\.[A-Za-z0-9]+$")))
+
+(defun hywiki-get-page-hasht ()
+ "Return hash table of existing HyWiki pages."
+ (or hywiki-pages-hasht (hywiki-make-pages-hasht)))
+
+(defun hywiki-get-page-list ()
+ (hash-map #'cdr (hywiki-get-page-hasht)))
+
(defun hywiki-add-page (page-name)
"Add the HyWiki page for PAGE-NAME and return its file.
If file exists already, just return it. If PAGE-NAME is invalid,
@@ -355,7 +397,7 @@ Use `hywiki-get-page' to determine whether a HyWiki page
exists."
(setq page-name (match-string-no-properties 1 page-name)))
(let ((page-file (hywiki-get-page-file page-name))
- (pages-hasht (hywiki-get-pages)))
+ (pages-hasht (hywiki-get-page-hasht)))
(unless (file-readable-p page-file)
;; Create any parent dirs necessary to create empty file
(make-empty-file page-file t))
@@ -364,68 +406,60 @@ Use `hywiki-get-page' to determine whether a HyWiki page
exists."
page-file))
(user-error "(hywiki-add-page): Invalid page name: '%s'; must be
capitalized, all alpha" page-name)))
-(defun hywiki-add-to-page (page-name text start-flag)
- "Add to PAGE-NAME TEXT at page start with START-FLAG non-nil, else end.
-Create page if it does not exist. If PAGE-NAME is invalid, return
-nil, else return the file name of the page."
- (let* ((page-file (hywiki-add-page page-name))
- (page-buf (when page-file (find-file-noselect page-file))))
- (when page-buf
- (save-excursion
- (set-buffer page-buf)
- (barf-if-buffer-read-only)
- (save-restriction
- (widen)
- (goto-char (if start-flag (point-min) (point-max)))
- (unless (bolp) (insert (newline)))
- (insert text)
- (unless (bolp) (insert (newline)))
- (goto-char (if start-flag (point-min) (point-max)))
- page-file)))))
-
-(defun hywiki-page-list ()
- (hash-map #'cdr (hywiki-get-pages)))
+(defun hywiki-make-pages-hasht ()
+ (let* ((page-files (hywiki-get-page-files))
+ (page-elts (mapcar (lambda (file)
+ (cons file (file-name-sans-extension
(file-name-nondirectory file))))
+ page-files)))
+ (setq hywiki-pages-hasht (hash-make page-elts))))
-(defun hywiki-company-hasht-backend (command &optional arg &rest ignored)
+(defun hywiki-company-hasht-backend (command &optional _arg &rest ignored)
"A `company-mode` backend that completes from the keys of a hash table."
(interactive (list 'interactive))
(when (hywiki-at-wikiword)
(case command
('interactive (company-begin-backend 'company-hash-table-backend))
- ('prefix (company-grab-symbol))
+ ('prefix (company-grab-word))
('candidates
- (let ((prefix (company-grab-symbol)))
+ (let ((prefix (company-grab-word)))
(when prefix
- (cl-loop for key being the hash-keys in (hywiki-page-list)
+ (cl-loop for key being the hash-keys in (hywiki-get-page-list)
when (string-prefix-p prefix key)
collect key))))
('sorted t))))
-;; HyWiki org link type, abbreviated as 'hy'
-(org-link-set-parameters "hy"
- :complete #'hywiki-complete
- :follow #'hywiki-open
- :store #'hywiki-store-link)
-
-(defun hywiki-complete (&optional _arg)
+(defun hywiki-org-link-complete (&optional _arg)
"Complete HyWiki page names for `org-insert-link'."
(concat
- hywiki-org-link-type
+ (when hywiki-org-link-type-required
+ (concat hywiki-org-link-type ":"))
(let ((completion-ignore-case t))
- (completing-read "HyWiki page: " (hywiki-page-list) nil t))))
+ (completing-read "HyWiki page: " (hywiki-get-page-list) nil t))))
-(defun hywiki-store-link ()
+(defun hywiki-org-link-store ()
"Store a link to a HyWiki word at point, if any."
(when (hywiki-at-wikiword)
(let* ((page-name (hywiki-at-wikiword))
- (link (concat "hy:" page-name))
- (description (format "HyWiki page for %s" page-name)))
+ (link (concat
+ (when hywiki-org-link-type-required
+ (concat hywiki-org-link-type ":"))
+ page-name))
+ (description (format "HyWiki page for '%s'" page-name)))
(org-link-store-props
:type hywiki-org-link-type
:link link
:description description))))
-(add-hook 'find-file-hook #'hywiki-highlight-page-names t)
-(add-hook 'post-self-insert-hook #'hywiki-highlight-page-name t)
+(org-link-set-parameters hywiki-org-link-type
+ :complete #'hywiki-org-link-complete
+ :follow #'hywiki-find-page
+ :store #'hywiki-org-link-store)
+
+(add-hook 'org-mode-hook
+ (lambda ()
+ (make-local-variable 'find-file-hook)
+ (make-local-variable 'post-self-insert-hook)
+ (add-hook 'find-file-hook #'hywiki-highlight-page-names t)
+ (add-hook 'post-self-insert-hook #'hywiki-highlight-page-name t)))
(provide 'hywiki)
