branch: externals/hyperbole
commit 36e6dc66d39c5de82338c9220e643555bad29bc5
Merge: 61937530ea 232ed572d8
Author: Robert Weiner <r...@gnu.org>
Commit: GitHub <nore...@github.com>
Merge pull request #521 from rswgnu/rsw
Add initial version of "hywiki.el" and the hywiki ibtype
---
ChangeLog | 167 ++++++++++++++
MANIFEST | 4 +
Makefile | 10 +-
hact.el | 14 +-
hasht.el | 432 ++++++++++++++++++++++++++++++++++++
hbut.el | 24 +-
hibtypes.el | 35 ++-
hpath.el | 162 +++++++-------
hsys-org.el | 21 +-
hui-em-but.el | 81 +++++--
hui.el | 8 +-
hyrolo.el | 67 +++---
hywiki.el | 601 +++++++++++++++++++++++++++++++++++++++++++++++++++
test/hyrolo-tests.el | 14 +-
14 files changed, 1462 insertions(+), 178 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index fd0d468bee..4abf34d01b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,96 @@
+2024-05-25 Bob Weiner <r...@gnu.org>
+
+* hbut.el (ibtype:delete): Fix interactive call.
+
+* hywiki.el (hywiki-remap-buttonize-characters): Add <tab>.
+ (hywiki-highlight-page-name): Fix to highlight page
+ name regardless of how much whitespace comes after the name.
+ (hywiki-mode): Expand doc and add/remove 'post-self-insert-hook'
+ call of 'hywiki-buttonize'.
+ (hywiki-remap-buttonize-characters, hywiki-initialize-mode-map):
+ Remove these and move keymap init into 'hywiki-mode' definition.
+ (hywiki-buttonize): Rewrite to highlight hywiki word to the left of
+ point iff last inserted char is in the set of
'hywiki--buttonize-characters'.
+ Rename to 'hywiki-buttonize-character-commands'.
+ (hywiki-buttonize-non-character-commands): Add.
+
+* hbut.el (gbut:act): Set 'loc to current-buffer, not the gbut's
+ source buffer.
+ (hbut:key-src-set-buffer): Clarify doc.
+ (hbut:funcall): Change to use 'hbut:key-src-set-buffer' to
+ temporarily set current-buffer to button's loc attribute.
+
+* hywiki.el (hywiki-get-page-files): Check that 'hywiki-directory'
+ exists and is readable.
+ (hywiki-is-wikiword): Make case-sensitive.
+ (hywiki-at-wikiword): Remove optional 'org-link-flag' arg
+ use 'ibut:label-p' to get HyWikiWord.
+
+2024-05-23 Bob Weiner <r...@gnu.org>
+
+* hact.el (actype:delete): Fix interactive spec, eliminating use of
+ 'hui:htype-delete'.
+
+* hui.el (hui:htype-delete): Fix doc.
+
+2024-05-19 Bob Weiner <r...@gnu.org>
+
+* hywiki.el (hywiki-remap-buttonize-characters): Move initialization of
+ 'hywiki--buttonize-characters' here instead of at variable definition
+ to eliminate circular load dependency.
+ (find-file-hook): Remove add-hook on 'org-mode-hook'.
+ (hywiki-find-page): Add post 'hywiki-find-page-hook' and return
+ absolute path to the found page.
+
+* hibtypes.el (grep-msg): Fix that when no source-loc, file path was not
+ expanded.
+ (find-func): Add require of this library for native compiler
+ grep-msg library name expansion.
+
+* hywiki.el (hywiki-initialize-mode-map): Fix call of old function name.
+ (hywiki-remap-remap-buttonize-characters): Remove extra remap-.
+ (hywiki-find-page): Remove unused let of 'page-buffer'.
+
+2024-05-18 Bob Weiner <r...@gnu.org>
+
+* test/hyrolo-tests.el (hyrolo-tests--goto-kotl-header-with-slash-match): Start
+ to try to fix this test.
+
+* hpath.el (hpath:find, hpath:to-markup-anchor): Fix for directory pathnames so
+ properly handles anchors, line numbers, column numbers and 'hpath-find'
returns
+ the buffer found. Also, make 'hpath:to-markup-anchor' handle any special
buffer
+ types without attached buffers.
+
+* hywiki.el (hywiki-get-org-insertion-punctuation-keys): Allow for symbol
syntax
+ chars and rename to 'hywiki-get-buttonize-characters'.
+ (hywiki-remap-org-insertion-punctuation-keys): Rename to
+ 'hywiki-remap-buttonize-characters'.
+ (hywiki--buttonize-characters): Add as a computed string of single
+ characters that each trigger prior hywiki word highlighting when it is
enabled.
+ (hywiki-highlight-page-name, hywiki-highlight-page-names): Don't
skip
+ back over symbol chars.
+ (hywiki-find-page): Use this function as the 'find-file-hook'
instead
+ of 'hywiki-highlight-page-names'; make 'page-name' optional for this use
since
+ the current buffer will be the page, so the page name can be derived. If
calling
+ this function creates the page buffer, then enable hywiki-mode and call
+ 'hywiki-highlight-page-names'.
+
+* hui-em-but.el (hproperty:but-clear-all-in-list,
hproperty:but-get-all-in-region):
+ Add.
+
+* hywiki.el (org-mode-hook): Don't make 'find-file-hook' buffer local, as this
+ is not recommended.
+ (hywiki-pages-hasht): Rename to 'hywiki--pages-hasht'.
+ (hywiki-at-wikiword): Allow preceding char to be whitespace or
+ additionally any of these chars: (["'`'
+ ((hywiki-highlight-page-names, hywiki-at-wikiword,
+ hywiki-highlight-page-name): Don't limit to files within
'hywiki-directory';
+ use whenever 'hywiki-mode' is enabled.
+ (hywiki-at-wikiword): Remove 'hywiki-allowed-modes' since now test
+ that hywiki-mode is enabled.
+ (hywiki-initialize-mode-map): Add and make punct. and
non-square-bracket
+ and non-angle-bracket balanced expressions highlight HyWiki page name
references.
+
2024-05-18 Mats Lidell <ma...@gnu.org>
* hypb.el (hypb:configuration): Add info about Emacs native comp.
@@ -15,6 +108,80 @@
* hact.el (actype:act): Add Emacs 30 closure support.
+2024-05-15 Bob Weiner <r...@gnu.org>
+
+* hywiki.el (org-mode-hook): Remove 'post-self-insert-hook' and instead
highlight
+ HyWikiWords via new 'hywiki-mode' minor-mode and its SPC and RET key
bindings
+ bound to hywiki-buttonize.
+
+2024-05-12 Bob Weiner <r...@gnu.org>
+
+* hact.el (actype:act, action:params): Add Emacs 30 closure support.
+
+2024-05-06 Bob Weiner <r...@gnu.org>
+
+* hyrolo.el (hyrolo-name-at-p): Fix to test point is in
'hyrolo-display-buffer'.
+
+2024-05-05 Bob Weiner <r...@gnu.org>
+
+* hpath.el (hpath:delimited-possible-path): Rewrite to expand both delimited
+ and non-delimited shell pathnames.
+
+ For non-delimited strings, remove any leading or trailing spaces;
+ otherwise, may prepend a dir with an extra space in there when
+ extracting paths from an ls command that are indented to match the
+ column indent of filenames with quotes around them. Also, remove
+ requirement that shell buffer filenames be tab delimited and require
+ that filenames with spaces in their names have quotes around them.
+ (hpath:at-p): If file is readable, ignore whether it has "::" in it.
+
+* hui-em-but.el: Comment out non-load when non-interactive so does not created
+ errors when used in "hywiki.el".
+
+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>
+
+* hywiki.el: Add new auto-wikiword note-taking system with `hywiki' ibtype.
+ hasht.el: Temporarily add this for hywiki hash table support.
+ hibtypes.el (load "hywiki"): Add at lowest ibtype priority.
+ hsys-org.el (hsys-org-link-at-p): Support HyWiki word handling.
+ Makefile (EL_COMPILE):
+ MANIFEST: Add hywiki.el and hasht.el.
+
+* hui-em-but.el (hproperty:but-start, hproperty:but-end, hproperty:but-delete):
+ Add these functions and use in hywiki.el.
+
+2024-04-21 Bob Weiner <r...@gnu.org>
+
+* hui-em-but.el (hproperty:but-clear): Add optional args 'property' and
'value'.
+ When 'property' is given, clear the button only when property's value
+ matches 'value'.
+ (hproperty:but-p, hproperty:but-get): Add optional args
+ 'property' and 'value', matching only when 'property' equals 'value', if
+ given.
+
2024-04-20 Bob Weiner <r...@gnu.org>
* hui-select.el (hui-c++-defun-prompt-regexp): Add to eliminate an Emacs
diff --git a/MANIFEST b/MANIFEST
index 3fc33c06fa..f40aa462e9 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -73,6 +73,10 @@ hsmail.el - GNU Hyperbole buttons in mail
composer: mail
kotl/MANIFEST - Summary of Koutliner files
kotl/EXAMPLE.kotl - Sample Koutline document explaining Koutliner features
+* --- HYPERBOLE NOTES ---
+hywiki.el - Hyperbole's auto-wikiword note-taking system
+hasht.el - Create hash tables from lists and operate on them.
+
* --- HYPERBOLE ROLO ---
hyrolo.el - Hierarchical, multi-file, easy-to-use record management
system
hyrolo.py - Output file header and matching entries from HyRolo
files via the command-line
diff --git a/Makefile b/Makefile
index 5c69528ac8..b72306f74e 100644
--- a/Makefile
+++ b/Makefile
@@ -3,7 +3,7 @@
# Author: Bob Weiner
#
# Orig-Date: 15-Jun-94 at 03:42:38
-# Last-Mod: 6-May-24 at 00:25:45 by Mats Lidell
+# Last-Mod: 19-May-24 at 10:58:02 by Bob Weiner
#
# Copyright (C) 1994-2023 Free Software Foundation, Inc.
# See the file HY-COPY for license information.
@@ -190,8 +190,9 @@ EL_COMPILE = hact.el hactypes.el hargs.el hbdata.el
hbmap.el hbut.el \
hsys-org-roam.el hsys-www.el hsys-xref.el hsys-youtube.el htz.el \
hycontrol.el hui-jmenu.el hui-menu.el hui-mini.el hui-mouse.el
hui-select.el \
hui-treemacs.el hui-window.el hui.el hvar.el hversion.el hypb.el
hyperbole.el \
- hyrolo-demo.el hyrolo-logic.el hyrolo-menu.el hyrolo.el
hywconfig.el set.el hypb-ert.el \
- hui-dired-sidebar.el hypb-maintenance.el hui-em-but.el
hui-register.el
+ hyrolo-demo.el hyrolo-logic.el hyrolo-menu.el hyrolo.el
hywconfig.el hywiki.el \
+ hasht.el set.el hypb-ert.el hui-dired-sidebar.el
hypb-maintenance.el hui-em-but.el \
+ hui-register.el
EL_SRC = $(EL_COMPILE)
@@ -546,7 +547,8 @@ lint:
# Run a build using a dockerized version of Emacs
#
# Usage:
-# make dockerized version=28.1 targets='clean bin test'
+# make dockerized version=master targets='clean bin test'
+# make dockerized version=28.2 targets='clean bin test'
# Specify version and targets to run
ifeq ($(origin targets), command line)
diff --git a/hact.el b/hact.el
index 46fabbeb72..3e66e7d477 100644
--- a/hact.el
+++ b/hact.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 18-Sep-91 at 02:57:09
-;; Last-Mod: 16-May-24 at 23:00:41 by Mats Lidell
+;; Last-Mod: 23-May-24 at 23:18:43 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -366,7 +366,9 @@ Autoloads action function if need be to get the parameter
list."
(compiled-function-arglist action)
(action:params-emacs action)))
((symbolp action)
- (car (cdr (and (fboundp action) (hypb:indirect-function action)))))))
+ (car (cdr (and (fboundp action) (hypb:indirect-function action)))))
+ ((and (fboundp #'closurep) (closurep action))
+ (aref action 0))))
(defun action:param-list (action)
"Return list of actual ACTION parameters (remove `&' special forms)."
@@ -518,8 +520,12 @@ Return symbol created when successful, else nil."
(defun actype:delete (type)
"Delete an action TYPE (a symbol). Return TYPE's symbol if it existed."
- (interactive (list (hui:htype-delete 'actypes))
- (htype:delete type 'actypes)))
+ (interactive
+ (list (intern (hargs:read-match
+ "Delete from actypes: "
+ (mapcar 'list (htype:names 'actypes))
+ nil t nil 'actypes))))
+ (htype:delete type 'actypes))
(defun actype:doc (but &optional full)
"Return first line of action doc for BUT.
diff --git a/hasht.el b/hasht.el
new file mode 100644
index 0000000000..17d0c5e51f
--- /dev/null
+++ b/hasht.el
@@ -0,0 +1,432 @@
+;;!emacs
+;;
+;; FILE: hasht.el
+;; SUMMARY: Create hash tables from lists and operate on them.
+;; USAGE: GNU Emacs Lisp Library
+;; KEYWORDS: extensions, tools
+;;
+;; AUTHOR: Bob Weiner
+;;
+;; ORIG-DATE: 16-Mar-90 at 03:38:48
+;; LAST-MOD: 30-Jul-16 at 08:50:38 by Bob Weiner
+;;
+;; Copyright (C) 1990-1995, 1997, 2016 Free Software Foundation, Inc.
+;; See the file BR-COPY for license information.
+;;
+;; This file is part of the OO-Browser.
+
+;; The OO-Browser is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; The OO-Browser is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with the OO-Browser. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Featureful set of hash table operators for use in personal programs.
+;;
+;; `hash-make' creates a hash table from an association list, `hash-add'
+;; adds a value-key pair to a hash table, and `hash-lookup' finds the value
+;; associated with a given key in a hash table, if any.
+;;
+;; `hash-map' does the same thing as `mapcar' but operates on hash tables
+;; instead.
+;;
+;; For a list of 300 items, these hash tables improve lookup times by a
+;; factor of between 8 and 10 to 1 over those for an unsorted list.
+;;
+;; Public and private function names are alphabetized for easy location.
+
+;;; Code:
+;;; ************************************************************************
+;;; Public variables
+;;; ************************************************************************
+
+(defvar hash-merge-values-function 'hash-merge-values
+ "*Function to call in hash-merge to merge the values from 2 hash tables that
contain the same key.
+It is sent the two values as arguments.")
+
+;;; ************************************************************************
+;;; Public functions
+;;; ************************************************************************
+
+(defun hash-add (value key hash-table)
+ "Add VALUE, any lisp object, referenced by KEY, a string, to HASH-TABLE.
+Replaces any VALUE previously referenced by KEY."
+ (if (hashp hash-table)
+ (let* ((obarray (hash-obarray hash-table))
+ (sym (intern key obarray)))
+ (if sym (set sym value)))))
+
+(defun hash-copy (hash-table)
+ "Return a copy of HASH-TABLE, list and vector elements are shared across
both tables."
+ (if (not (hashp hash-table))
+ (error "(hash-copy): Invalid hash-table: `%s'" hash-table))
+ (let ((htable-copy (hash-make (length (hash-obarray hash-table)))))
+ (hash-map
+ (lambda (elt) (hash-add (car elt) (cdr elt) htable-copy))
+ hash-table)
+ htable-copy))
+
+(defun hash-count (hash-table)
+ "Return number of elements stored in HASH-TABLE or nil if not a valid hash
table."
+ (if (hashp hash-table)
+ (let ((obarray (hash-obarray hash-table))
+ (count 0))
+ (mapatoms (lambda (sym)
+ (and (boundp sym) sym (setq count (1+ count))))
+ obarray)
+ count)))
+
+(defun hash-delete (key hash-table)
+ "Delete element referenced by KEY, a string, from HASH-TABLE.
+Return nil if KEY is not in HASH-TABLE or non-nil otherwise."
+ (if (hashp hash-table)
+ (let* ((obarray (hash-obarray hash-table))
+ (sym (intern-soft key obarray)))
+ (if sym
+ (progn (makunbound sym)
+ (unintern sym nil))))))
+
+(defun hash-deep-copy (obj)
+ "Return a copy of OBJ with new copies of all elements, except symbols."
+ (cond ((null obj) nil)
+ ((stringp obj)
+ (copy-sequence obj))
+ ((hashp obj)
+ (let ((htable-copy (hash-make (length (hash-obarray obj)))))
+ (mapc
+ (lambda (elt) (hash-add (car elt) (cdr elt) htable-copy))
+ (hash-map 'hash-deep-copy obj))
+ htable-copy))
+ ((vectorp obj)
+ ;; convert to list for mapping
+ (setq obj (append obj nil))
+ ;; Return as a vector
+ (vconcat (mapcar 'hash-deep-copy obj)))
+ ((atom obj) obj)
+ ((nlistp obj)
+ (error "(hash-deep-copy): Invalid type, `%s'" obj))
+ (t ;; list
+ (cons (hash-deep-copy (car obj)) (hash-deep-copy (cdr obj))))))
+
+(defun hash-empty-p (hash-table)
+ "Return t if HASH-TABLE is empty, else nil."
+ (and (hashp hash-table) (equal hash-table hash-empty-htable)))
+
+(defalias 'hash-get 'hash-lookup)
+
+(defun hash-key-p (key hash-table)
+ "Return non-nil iff KEY is in HASH-TABLE. KEY's hash table symbol is
returned."
+ (if (hashp hash-table)
+ (let* ((obarray (hash-obarray hash-table))
+ (sym (intern-soft key obarray)))
+ (if (boundp sym) sym))))
+
+(defun hash-lookup (key hash-table)
+ "Lookup KEY in HASH-TABLE and return associated value.
+If value is nil, this function does not tell you whether or not KEY is in the
+hash table. Use `hash-key-p' instead for that function."
+ (if (hashp hash-table)
+ (let* ((obarray (hash-obarray hash-table))
+ (sym (intern-soft key obarray)))
+ (if (boundp sym) (symbol-value sym)))))
+
+(defun hash-make (initializer &optional reverse)
+ "Create a hash table from INITIALIZER.
+INITIALIZER may be an alist with elements of the form (<value> . <key>) from
+which the hash table is built. Alternatively, it may be a non-negative
+integer which is used as the minimum size of a new, empty hash table.
+Optional non-nil second argument REVERSE means INITIALIZER has elements of
+form (<key> . <value>)."
+ (cond ((integerp initializer)
+ (if (>= initializer 0)
+ (cons 'hasht (make-vector (hash-next-prime initializer) 0))
+ (error "(hash-make): Initializer must be >= 0, not `%s'"
+ initializer)))
+ ((numberp initializer)
+ (error "(hash-make): Initializer must be a positive integer, not `%f'"
+ initializer))
+ (t (let* ((vlen (hash-next-prime (length initializer)))
+ (obarray (make-vector vlen 0))
+ key value sym)
+ (mapc
+ (lambda (cns)
+ (if (consp cns)
+ (if reverse
+ (setq key (car cns) value (cdr cns))
+ (setq key (cdr cns) value (car cns))))
+ (if (setq sym (intern key))
+ (set sym value)))
+ initializer)
+ (cons 'hasht obarray)))))
+
+(defun hash-make-prepend (initializer &optional reverse)
+ "Create a hash table from INITIALIZER.
+INITIALIZER may be an alist with elements of the form (<value> . <key>) from
+which the hash table is built. Optional non-nil second argument REVERSE
+means INITIALIZER has elements of form (<key> . <value>).
+
+The resultant value associated with a <key> is a list of all of the <values>
+given in INITIALIZER entries which contain the <key>. The values are listed
+in reverse order of occurrence (they are prepended to the list)."
+ (let* ((vlen (hash-next-prime (length initializer)))
+ (obarray (make-vector vlen 0))
+ key value sym)
+ (mapc
+ (lambda (cns)
+ (if (consp cns)
+ (if reverse
+ (setq key (car cns) value (cdr cns))
+ (setq key (cdr cns) value (car cns))))
+ (setq sym (intern key))
+ (if (boundp sym)
+ (set sym (cons value (symbol-value sym)))
+ (set sym (cons value nil))))
+ initializer)
+ (cons 'hasht obarray)))
+
+(defun hash-map (func hash-table)
+ "Return a list of the results of applying FUNC to each (<value> . <key>)
element of HASH-TABLE."
+ (if (not (hashp hash-table))
+ (error "(hash-map): Invalid hash-table: `%s'" hash-table))
+ (let ((result))
+ (mapatoms (lambda (sym)
+ (and (boundp sym)
+ sym
+ (setq result (cons (funcall
+ func
+ (cons (symbol-value sym)
+ (symbol-name sym)))
+ result))))
+ (hash-obarray hash-table))
+ result))
+
+(defun hash-merge (&rest hash-tables)
+ "Merge any number of HASH-TABLES. Return resultant hash table.
+A single argument consisting of a list of hash tables may also be given.
+Return an empty hash table if any argument from the merge list is other
+than nil or a hash table.
+
+Use the value of `hash-merge-values-function' to merge the values of entries
+whose keys are the same."
+ (let ((empty-ht (hash-make 1)))
+ (and (not (hashp (car hash-tables)))
+ (listp (car hash-tables))
+ ;; Handle situation where a list of hash-tables is passed in as a
+ ;; single argument, rather than as multiple arguments.
+ (setq hash-tables (car hash-tables)))
+ (if (memq nil (mapcar (lambda (ht) (or (null ht) (hashp ht)))
+ hash-tables))
+ empty-ht
+ (setq hash-tables
+ (delq nil (mapcar (lambda (ht)
+ (if (hash-empty-p ht) nil ht))
+ hash-tables)))
+ (let ((len (length hash-tables)))
+ (cond ((= len 0) empty-ht)
+ ((= len 1) (car hash-tables))
+ ;; Make the merged hash-table be 20% larger than the number of
+ ;; entries filled in all hash-tables to be merged, so that
+ ;; hash misses are minimized.
+ (t (let ((htable (hash-make
+ (ceiling
+ (* 1.2 (apply '+ (mapcar 'hash-count
+ hash-tables))))))
+ key value)
+ (mapc
+ (lambda (ht)
+ (hash-map (lambda (val-key-cons)
+ (setq value (car val-key-cons)
+ key (cdr val-key-cons))
+ (if (not (hash-key-p key htable))
+ (hash-add value key htable)
+ ;; Merge values
+ (hash-add
+ (funcall hash-merge-values-function
+ (hash-get key htable)
+ value)
+ key htable)))
+ ht))
+ hash-tables)
+ htable)))))))
+
+(defun hash-merge-first-value (value1 value2)
+ "Return a copy of VALUE1 for use in a hash table merge.
+
+This is suitable for use as a value of `hash-merge-values-function'."
+ ;; Copy list so that merged result does not share structure with the
+ ;; hash tables being merged.
+ (if (listp value1) (copy-sequence value1) value1))
+
+(defun hash-merge-values (value1 value2)
+ "Return a list from merging VALUE1 and VALUE2 or creating a new list.
+Nil values are thrown away. If both arguments are lists, their elements are
+assumed to be strings and the result is a set of ordered strings.
+
+This is suitable for use as a value of `hash-merge-values-function'."
+ ;; Copy lists so that merged result does not share structure with the
+ ;; hash tables being merged.
+ (if (listp value1) (setq value1 (copy-sequence value1)))
+ (if (listp value2) (setq value2 (copy-sequence value2)))
+ (cond ((and (listp value1) (listp value2))
+ ;; Assume desired result is a set of strings.
+ (hash-set-of-strings (sort (append value1 value2) 'string-lessp)))
+ ((null value1)
+ value2)
+ ((null value2)
+ value1)
+ ((listp value1)
+ (cons value2 value1))
+ ((listp value2)
+ (cons value1 value2))
+ (t (list value1 value2))))
+
+(make-obsolete 'hash-new 'hash-make "19.0")
+(defun hash-new (size)
+ "Return a new hash table of SIZE elements.
+This is obsolete. Use `hash-make' instead."
+ (hash-make size))
+
+(defun hash-prepend (value key hash-table)
+ "Prepend VALUE onto the list value referenced by KEY, a string, in
HASH-TABLE.
+If KEY is not found in HASH-TABLE, it is added with a value of (list VALUE)."
+ (if (hashp hash-table)
+ (let* ((obarray (hash-obarray hash-table))
+ (sym (intern key obarray)))
+ (if (boundp sym)
+ (if (listp (symbol-value sym))
+ (set sym (cons value (symbol-value sym)))
+ (error "(hash-prepend): `%s' key's value is not a list."
+ key))
+ (set sym (cons value nil))))))
+
+(defun hash-prin1 (hash-table &optional stream)
+ "Output the printed representation of HASH-TABLE as a list.
+Quoting characters are printed when needed to make output that `read'
+can handle, whenever this is possible.
+Output stream is STREAM, or value of `standard-output'."
+ (if (not (hashp hash-table))
+ (progn (prin1 hash-table stream)
+ (princ "\n" stream))
+ (princ "\(\n" stream)
+ (hash-map
+ (lambda (val-key-cons)
+ (prin1 val-key-cons stream)
+ (princ "\n" stream))
+ hash-table)
+ (princ "\)\n" stream)))
+
+(defun hash-replace (value key hash-table)
+ "Replace VALUE referenced by KEY, a string, in HASH-TABLE.
+An error will occur if KEY is not found in HASH-TABLE."
+ (if (hashp hash-table)
+ (let* ((obarray (hash-obarray hash-table))
+ (sym (intern-soft key obarray)))
+ (if (and (boundp sym) sym)
+ (set sym value)
+ (error "(hash-replace): `%s' key not found in hash table." key)))))
+
+(defun hash-resize (hash-table new-size)
+ "Resize HASH-TABLE to NEW-SIZE without losing any elements and return new
table.
+NEW-SIZE must be greater than 0. Hashing works best if NEW-SIZE is a prime
+number. See also `hash-next-prime'."
+ (if (< new-size 1)
+ (error "(hash-resize): Cannot resize hash table to size %d" new-size))
+ (let ((htable (hash-make new-size)))
+ (hash-map (lambda (elt)
+ (hash-add (car elt) (cdr elt) htable))
+ hash-table)
+ htable))
+
+(defun hash-resize-p (hash-table)
+ "Resizes HASH-TABLE to 1.5 times its size if above 80% full.
+Returns new hash table when resized, else nil."
+ (if (hashp hash-table)
+ (let ((count (hash-count hash-table))
+ (size (length (hash-obarray hash-table))))
+ (if (> (* count (/ count 5)) size)
+ (hash-resize hash-table (hash-next-prime (+ size (/ size 2))))))))
+
+(defun hash-size (hash-table)
+ "Return size of HASH-TABLE which is >= number of elements in the table.
+Return nil if not a valid hash table."
+ (if (hashp hash-table)
+ (length (hash-obarray hash-table))))
+(defalias 'hash-length 'hash-size)
+
+(defun hashp (object)
+ "Return non-nil if OBJECT is a hash-table."
+ (and (listp object) (eq (car object) 'hasht)
+ (vectorp (cdr object))))
+
+;;; ************************************************************************
+;;; Private functions
+;;; ************************************************************************
+
+(defun hash-next-prime (n)
+ "Return next prime number >= N."
+ (if (<= n 2)
+ 2
+ (and (= (% n 2) 0) (setq n (1+ n)))
+ (while (not (hash-prime-p n))
+ (setq n (+ n 2)))
+ n))
+
+(defun hash-obarray (hash-table)
+ "Return symbol table (object array) portion of HASH-TABLE."
+ (cdr hash-table))
+
+(defun hash-prime-p (n)
+ "Return non-nil iff N is prime."
+ (if (< n 0) (setq n (- n)))
+ (let ((small-primes '(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67
71 73 79 83 89)))
+ (cond ((< n 2) nil)
+ ((< n 91) (if (memq n small-primes) t))
+ ((< n 7921) ;; 89, max small-prime, squared
+ (let ((prime t)
+ (pr-list small-primes))
+ (while (and (setq pr-list (cdr pr-list))
+ (setq prime (/= (% n (car pr-list)) 0))))
+ prime))
+ ((or (= (% n 3) 0) (= (% n 2) 0)) nil)
+ ((let ((factor1 5)
+ (factor2 7)
+ (is-prime))
+ (while (and (<= (* factor1 factor1) n)
+ (setq is-prime (and (/= (% n factor1) 0)
+ (/= (% n factor2) 0))))
+ (setq factor1 (+ factor1 6)
+ factor2 (+ factor2 6)))
+ is-prime)))))
+
+(defun hash-set-of-strings (sorted-strings &optional count)
+ "Return SORTED-STRINGS list with any duplicate entries removed.
+Optional COUNT conses number of duplicates on to front of list before return."
+ (and count (setq count 0))
+ (let ((elt1) (elt2) (lst sorted-strings)
+ (test (if count
+ (lambda (a b) (if (string-equal a b)
+ (setq count (1+ count))))
+ (lambda (a b) (string-equal a b)))))
+ (while (setq elt1 (car lst) elt2 (car (cdr lst)))
+ (if (funcall test elt1 elt2)
+ (setcdr lst (cdr (cdr lst)))
+ (setq lst (cdr lst)))))
+ (if count (cons count sorted-strings) sorted-strings))
+
+;;; ************************************************************************
+;;; Private variables
+;;; ************************************************************************
+
+(defvar hash-empty-htable (hash-make 1)
+ "Empty hash table used to test whether other hash tables are empty.")
+
+(provide 'hasht)
diff --git a/hbut.el b/hbut.el
index bb13b033a5..5acf3bc783 100644
--- a/hbut.el
+++ b/hbut.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 18-Sep-91 at 02:57:09
-;; Last-Mod: 14-Apr-24 at 13:52:20 by Bob Weiner
+;; Last-Mod: 25-May-24 at 16:30:50 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -762,7 +762,11 @@ Insert INSTANCE-FLAG after END, before ending delimiter."
(t (let* ((lbl-key (hbut:label-to-key label))
(but (gbut:get lbl-key)))
(if but
- (hbut:act but)
+ (progn
+ ;; Ensure gbut is activated with current-buffer as
+ ;; the context, not the gbut's source buffer.
+ (hattr:set but 'loc (current-buffer))
+ (hbut:act but))
(error "(gbut:act): No global button found for label: %s"
label))))))
(defun gbut:delete (&optional lbl-key)
@@ -1234,7 +1238,7 @@ hbut:current's 'loc attribute to KEY-SRC."
(hattr:set 'hbut:current 'loc key-src)
(let ((loc (hattr:get 'hbut:current 'loc)))
(when loc
- (set-buffer (or (get-buffer loc) (find-file-noselect loc)))))
+ (hbut:key-src-set-buffer loc)))
(setq key-src (hbut:to-key-src 'full)
;; `hbut:to-key-src' sets current buffer to key-src buffer.
buffer (or buffer (current-buffer))))
@@ -1352,9 +1356,9 @@ represent the output of particular document formatters."
((current-buffer))))))
(defun hbut:key-src-set-buffer (src)
- "Set buffer to SRC, a buffer, buffer name, file, directory or symlink.
-If SRC is a directory, simply return it; otherwise, return SRC or
-nil if invalid."
+ "Temporarily set current buffer to SRC, a buffer, buffer name, or file.
+If SRC is a directory, simply return it; otherwise, return set current
+buffer to SRC and return it or return nil if SRC is invalid/unreadable."
(cond ((null src) nil)
((or (bufferp src) (get-buffer src))
(set-buffer src)
@@ -1368,7 +1372,8 @@ nil if invalid."
(set-buffer (find-file-noselect src))
src)
;; Buffer may be newly created with an attached file that has
- ;; not yet been saved, so it can't be read.
+ ;; not yet been saved, so the file does not exist and cannot
+ ;; be read.
((get-file-buffer src)
(set-buffer (get-file-buffer src))
src)))
@@ -3170,7 +3175,10 @@ is returned."
(defun ibtype:delete (type)
"Delete an implicit button TYPE (a symbol).
Return TYPE's symbol if it existed, else nil."
- (interactive (list (hui:htype-delete 'ibtypes)))
+ (interactive (list (intern (hargs:read-match
+ (concat "Delete from " (symbol-name 'ibtypes) ":
")
+ (mapcar 'list (htype:names 'ibtypes))
+ nil t nil 'ibtypes))))
(htype:delete type 'ibtypes))
;; Return the full Elisp symbol for IBTYPE, which may be a string or symbol.
diff --git a/hibtypes.el b/hibtypes.el
index 8246fbd355..ed2156f614 100644
--- a/hibtypes.el
+++ b/hibtypes.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 19-Sep-91 at 20:45:31
-;; Last-Mod: 7-Apr-24 at 15:12:46 by Bob Weiner
+;; Last-Mod: 25-May-24 at 10:11:05 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -11,6 +11,7 @@
;; See the "HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
+
;;; Commentary:
;;
;; Implicit button types (ibtypes) in this file are defined in increasing
@@ -37,6 +38,7 @@
;;; ************************************************************************
(require 'cl-lib) ;; for cl-count
+(require 'find-func) ;; used by grep-msg ibtype
(eval-when-compile (require 'hversion))
(require 'hactypes)
(require 'hypb)
@@ -88,6 +90,12 @@
;; them. Use load instead to ensure are reloaded when resetting
;; ibtype priorities.
+;;; ========================================================================
+;;; Creates and display personal wiki pages with auto-wikiword links
+;;; ========================================================================
+
+(load "hywiki")
+
;;; ========================================================================
;;; Jumps to source line from Python traceback lines
;;; ========================================================================
@@ -358,16 +366,17 @@ attached file."
(let ((chr (aref (buffer-name) 0)))
(not (or (eq chr ?\ ) (eq chr ?*))))
(not (apply #'derived-mode-p '(prog-mode c-mode objc-mode c++-mode
java-mode markdown-mode org-mode)))
- (let ((ref (hattr:get 'hbut:current 'lbl-key))
- (lbl-start (hattr:get 'hbut:current 'lbl-start)))
- (and ref
- lbl-start
- (eq ?w (char-syntax (aref ref 0)))
- (not (string-match "[#@]" ref))
- (save-excursion
- (goto-char lbl-start)
- (ibut:label-p t "[" "]" t))
- (hact 'annot-bib ref)))))
+ (unless (ibut:label-p t "[[" "]]" t) ;; Org link
+ (let ((ref (hattr:get 'hbut:current 'lbl-key))
+ (lbl-start (hattr:get 'hbut:current 'lbl-start)))
+ (and ref
+ lbl-start
+ (eq ?w (char-syntax (aref ref 0)))
+ (not (string-match "[#@]" ref))
+ (save-excursion
+ (goto-char lbl-start)
+ (ibut:label-p t "[" "]" t))
+ (hact 'annot-bib ref))))))
;;; ========================================================================
;;; Follows Org links that are in non-Org mode buffers
@@ -1041,7 +1050,9 @@ in grep and shell buffers."
(hbut:to-key-src t))))
(if (stringp source-loc)
(setq file (expand-file-name file (file-name-directory
source-loc)))
- (setq file (or (hpath:prepend-shell-directory file) file)))
+ (setq file (or (hpath:prepend-shell-directory file)
+ (ignore-errors (find-library-name file))
+ (expand-file-name file))))
(when (file-exists-p file)
(setq line-num (string-to-number line-num))
(ibut:label-set but-label)
diff --git a/hpath.el b/hpath.el
index 541e547750..d4abba08ae 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: 31-Mar-24 at 00:23:02 by Bob Weiner
+;; Last-Mod: 18-May-24 at 19:06:22 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -955,43 +955,43 @@ Absolute pathnames must begin with a `/' or `~'."
(when (and path (not non-exist) (string-match hpath:prefix-regexp path)
(not (string-equal (match-string 0 path) path)))
(setq non-exist t))
- (unless (and path (or (string-empty-p path)
- (string-match "::" path)))
- (cond ((and path (file-readable-p path))
- path)
- ((and path
- ;; Don't allow more than one set of grouping chars
- (not (string-match-p "\)\\s-*\(\\|\\]\\s-*\\[\\|\}\\s-*\{"
path))
- ;; With point inside a path variable, return the path that
point is on or to the right of.
- (setq subpath (or (and (setq subpath (hargs:delimited
"[:\"\']\\|^\\s-*" "[:\"\']\\|\\s-*$" t t nil "[\t\n\r\f]\\|[;:] \\| [;:]"))
- (not (string-match-p "[:;\t\n\r\f]"
subpath))
- subpath)
- (and (setq subpath (hargs:delimited
"[;\"\']\\|^\\s-*" "[;\"\']\\|\\s-*$" t t nil "[\t\n\r\f]\\|[;:] \\| [;:]"))
- (not (string-match-p
"[;\t\n\r\f]\\|:[^:]*:" subpath))
- subpath)))
- ;; Handle anchored or action prefix char paths in the
- ;; following clause; otherwise, might just be looking
- ;; at part of the path
- (and subpath (not (or (string-match-p "#" subpath)
- (string-match-p hpath:prefix-regexp
subpath))))
- (setq subpath
- (if subpath
- (cond ((and (string-match "\\`\\s-*\\([^; \t]+\\)"
subpath)
- (executable-find (match-string 1
subpath)))
- ;; Could be a shell command from a semicolon
separated
- ;; list; ignore if so
- nil)
- (t (expand-file-name subpath)))
- ;; Only default to current path if know are within a
PATH value
- (when (string-match-p
hpath:path-variable-value-regexp path)
- ".")))
- (hpath:is-p subpath type non-exist))
- subpath)
- ((hpath:is-p path type non-exist))
- ;; Local file URLs
- ;; ((hpath:is-p (hargs:delimited "file://" "[ \t\n\r\"\'\}]" nil
t)))
- ((hpath:remote-at-p))
- ((hpath:www-at-p) nil)))))
+ (if (and path (not (string-empty-p path)) (file-readable-p path))
+ path
+ (unless (and path (or (string-empty-p path)
+ (string-match "::" path)))
+ (cond ((and path
+ ;; Don't allow more than one set of grouping chars
+ (not (string-match-p "\)\\s-*\(\\|\\]\\s-*\\[\\|\}\\s-*\{"
path))
+ ;; With point inside a path variable, return the path that
point is on or to the right of.
+ (setq subpath (or (and (setq subpath (hargs:delimited
"[:\"\']\\|^\\s-*" "[:\"\']\\|\\s-*$" t t nil "[\t\n\r\f]\\|[;:] \\| [;:]"))
+ (not (string-match-p "[:;\t\n\r\f]"
subpath))
+ subpath)
+ (and (setq subpath (hargs:delimited
"[;\"\']\\|^\\s-*" "[;\"\']\\|\\s-*$" t t nil "[\t\n\r\f]\\|[;:] \\| [;:]"))
+ (not (string-match-p
"[;\t\n\r\f]\\|:[^:]*:" subpath))
+ subpath)))
+ ;; Handle anchored or action prefix char paths in the
+ ;; following clause; otherwise, might just be looking
+ ;; at part of the path
+ (and subpath (not (or (string-match-p "#" subpath)
+ (string-match-p hpath:prefix-regexp
subpath))))
+ (setq subpath
+ (if subpath
+ (cond ((and (string-match "\\`\\s-*\\([^;
\t]+\\)" subpath)
+ (executable-find (match-string 1
subpath)))
+ ;; Could be a shell command from a
semicolon separated
+ ;; list; ignore if so
+ nil)
+ (t (expand-file-name subpath)))
+ ;; Only default to current path if know are within
a PATH value
+ (when (string-match-p
hpath:path-variable-value-regexp path)
+ ".")))
+ (hpath:is-p subpath type non-exist))
+ subpath)
+ ((hpath:is-p path type non-exist))
+ ;; Local file URLs
+ ;; ((hpath:is-p (hargs:delimited "file://" "[ \t\n\r\"\'\}]" nil
t)))
+ ((hpath:remote-at-p))
+ ((hpath:www-at-p) nil))))))
(defun hpath:call (func path &optional non-exist)
"Call FUNC with a PATH and optional NON-EXIST flag.
@@ -1125,44 +1125,47 @@ With optional INCLUDE-POSITIONS, return a triplet list
of (path start-pos
end-pos) or nil."
(unless (eolp)
;; Prevents MSWindows to Posix path substitution
- (let ((hyperb:microsoft-os-p t))
- (or (hargs:delimited "file://" "\\s-" nil t include-positions)
- ;; Filenames in HTML
- (hargs:delimited """ """ nil nil include-positions "[`'’]")
- ;; Embedded double quoted filenames
- (hargs:delimited "\\\"" "\\\"" nil nil include-positions "[`'’]")
- ;; Double quoted filenames
- (hargs:delimited "\"" "\"" nil nil include-positions "[`'’]")
- ;; Filenames in Info docs or Python files
- (hargs:delimited "[`'‘]" "[`'’]" t t include-positions "\"")
- ;; Filenames in TexInfo docs
- (hargs:delimited "@file{" "}" nil nil include-positions)
- ;; if `non-exist' is nil, look for any existing whitespace
- ;; delimited filename at point. If match consists of punctuation
- ;; only, like . or .., don't treat it as a pathname.
- ;; In shell modes, it must be tab delimited.
- (unless non-exist
- (let* ((space-delimiter (if (derived-mode-p #'shell-mode)
- "\t"
- "[ \t]"))
- (triplet (hargs:delimited (format
"^\\|\\(%s\\|[\]\[()<>\;&,@]\\)+"
- space-delimiter)
-
"\\([\]\[()<>\;&,@]\\|:*\\s-\\)+\\|$"
- t t t))
- (p (car triplet))
- (punc (char-syntax ?.)))
- ;; May have matched to a string with an embedded double
- ;; quote or surrounded by braces; if so, don't consider it a path.
- ;; Also ignore whitespace delimited root dirs, e.g. " / ".
- (when (and (stringp p) (not (string-match-p
"\\`{.*}\\'\\|\"\\|\\`[/\\]+\\'" p))
- (delq nil (mapcar (lambda (c) (/= punc (char-syntax
c))) p)))
- ;; Prepend proper directory from cd, ls *, recursive ls or dir
file
- ;; listings when needed.
- (setq p (or (hpath:prepend-shell-directory p) p))
- (setcar triplet p)
- (if include-positions
- triplet
- p))))))))
+ (let* ((hyperb:microsoft-os-p t)
+ (triplet (or (hargs:delimited "file://" "\\s-" nil t
include-positions)
+ ;; Filenames in HTML
+ (hargs:delimited """ """ nil nil
include-positions "[`'’]")
+ ;; Embedded double quoted filenames
+ (hargs:delimited "\\\"" "\\\"" nil nil
include-positions "[`'’]")
+ ;; Filenames in TexInfo docs
+ (hargs:delimited "@file{" "}" nil nil include-positions)
+ ;; Double quoted filenames
+ (hargs:delimited "\"" "\"" nil nil include-positions
"[`'’]")
+ ;; Filenames in Info docs, Python files or 'ls' listing
files in
+ ;; single quotes
+ (hargs:delimited "[`'‘]" "[`'’]" t t include-positions
"\"")))
+ (p (if (listp triplet) (car triplet) triplet)))
+ (if non-exist
+ ;; This may be a triplet of (path start-pos end-pos) or just path
+ triplet
+ ;; If `non-exist' and 'triplet' are nil, look for any
+ ;; existing whitespace delimited filename at point. If
+ ;; match consists of punctuation only, like . or ..,
+ ;; don't treat it as a pathname.
+ (when (null triplet)
+ (let* ((space-delimiter "[ \t]"))
+ (setq triplet (hargs:delimited (format
"^\\|\\(%s\\|[\]\[()<>\;&,@]\\)+"
+ space-delimiter)
+ "\\([\]\[()<>\;&,@]\\|:*\\s-\\)+\\|$"
+ t t t)
+ p (car triplet))))
+ ;; May have matched to a string with an embedded double
+ ;; quote or surrounded by braces; if so, don't consider it a path.
+ ;; Also ignore whitespace delimited root dirs, e.g. " / ".
+ (when (and (stringp p) (not (string-match-p
"\\`{.*}\\'\\|\"\\|\\`[/\\]+\\'" p))
+ (delq nil (mapcar (lambda (c) (/= (char-syntax ?.)
(char-syntax c))) p)))
+ ;; Prepend proper directory from cd, ls *, recursive ls or dir file
+ ;; listings when needed.
+ (setq p (string-trim p)
+ p (or (hpath:prepend-shell-directory p) p))
+ (if include-positions
+ (progn (setcar triplet p)
+ triplet)
+ p))))))
;;;###autoload
(defun hpath:display-buffer (buffer &optional display-where)
@@ -1568,9 +1571,10 @@ but locational suffixes within the file are utilized."
;; matching of path is likely to be wrong in
;; certain cases, e.g. with mount point or os path
;; alterations.
- (when (and buffer-file-name
+ (when (or (null buffer-file-name)
+ (and buffer-file-name
(equal (file-name-nondirectory path)
- (file-name-nondirectory
buffer-file-name)))
+ (file-name-nondirectory
buffer-file-name))))
(cond ((and anchor kotl-flag)
(klink:act path-with-anchor
anchor-start-pos))
((or hash anchor)
@@ -1634,7 +1638,7 @@ of the buffer."
(and
buffer-file-name
(string-match-p "\\`[A-Z][A-Z0-9]+\\'" buffer-file-name)))
hpath:outline-section-pattern)
- (prog-mode
+ ((or prog-mode
(null buffer-file-name))
"%s")
((or (and
buffer-file-name
(string-match-p hpath:markdown-suffix-regexp buffer-file-name))
diff --git a/hsys-org.el b/hsys-org.el
index d847ba05c5..853a88aeb6 100644
--- a/hsys-org.el
+++ b/hsys-org.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 2-Jul-16 at 14:54:14
-;; Last-Mod: 14-Apr-24 at 11:37:50 by Bob Weiner
+;; Last-Mod: 25-May-24 at 10:22:57 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -398,10 +398,25 @@ Return the (start . end) buffer positions of the region."
(defun hsys-org-link-at-p ()
"Return non-nil iff point is on a square-bracketed Org mode link.
Assume caller has already checked that the current buffer is in `org-mode'
-or are looking for an Org link in another buffer type."
+or is looking for an Org link in another buffer type."
(unless (or (smart-eolp) (smart-eobp))
(with-suppressed-warnings nil
- (org-in-regexp org-link-bracket-re nil t))))
+ (let ((in-org-link (org-in-regexp org-link-bracket-re nil t)))
+ (when in-org-link
+ (save-match-data
+ ;; If this Org link matches a HyWiki word, let Org handle
+ ;; it with its normal internal link handling only if it
+ ;; has a `hywiki-org-link-type' prefix or if
+ ;; `hywiki-org-link-type-required' is non-nil. Otherwise,
+ ;; return nil from this function and let ibtypes handle this
+ ;; as a HyWiki word.
+ (if (fboundp 'hywiki-at-wikiword)
+ (if (hywiki-at-wikiword)
+ (when (or hywiki-org-link-type-required
+ (hyperb:stack-frame '(hywiki-at-wikiword)))
+ in-org-link)
+ in-org-link)
+ in-org-link)))))))
;; Assume caller has already checked that the current buffer is in org-mode.
(defun hsys-org-heading-at-p (&optional _)
diff --git a/hui-em-but.el b/hui-em-but.el
index 73d0aeaf88..689da05227 100644
--- a/hui-em-but.el
+++ b/hui-em-but.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 21-Aug-92
-;; Last-Mod: 20-Jan-24 at 20:09:40 by Mats Lidell
+;; Last-Mod: 18-May-24 at 10:42:36 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -19,10 +19,10 @@
;;; Code:
-(when noninteractive
- ;; Don't load this library
- (with-current-buffer " *load*"
- (goto-char (point-max))))
+;; (when noninteractive
+;; ;; Don't load this library
+;; (with-current-buffer " *load*"
+;; (goto-char (point-max))))
;;; ************************************************************************
;;; Other required Elisp libraries
@@ -159,10 +159,13 @@ moves over it."
(when hproperty:but-emphasize-flag
(overlay-put but 'mouse-face 'highlight))))
-(defun hproperty:but-clear (&optional pos)
- "Remove highlighting from any named Hyperbole button at point or POS."
- (let ((but (hproperty:but-get pos)))
- (when but (delete-overlay but))))
+(defun hproperty:but-clear (&optional pos property value)
+ "Remove highlighting from any named Hyperbole button at point or POS.
+If optional PROPERTY and VALUE are given, remove highlighting only if
+the PROPERTY at the position matches VALUE."
+ (let ((but (hproperty:but-get pos property value)))
+ (when but
+ (delete-overlay but))))
(defun hproperty:but-clear-all (&optional regexp-match)
"Remove highlighting from all named Hyperbole buttons in buffer.
@@ -179,6 +182,10 @@ de-highlighted."
(remove-overlays nil nil 'face hproperty:but-face)
(remove-overlays nil nil 'face hproperty:ibut-face)))
+(defun hproperty:but-clear-all-in-list (hbut-list)
+ "Delete all HBUT-LIST hproperties."
+ (mapc #'delete-overlay hbut-list))
+
(defun hproperty:but-create (&optional regexp-match)
"Highlight all named Hyperbole buttons in buffer.
De-highlight buttons unless `hproperty:but-highlight-flag' is set.
@@ -217,23 +224,47 @@ moves over it."
(narrow-to-region start end)
(hproperty:but-create-all)))
+(defun hproperty:but-delete (hproperty-but)
+ "Remove HPROPERTY-BUT. See `hproperty:but-get'."
+ (delete-overlay hproperty-but))
+
+(defun hproperty:but-end (hproperty-but)
+ "Return the start position of an HPROPERTY-BUT.
+See `hproperty:but-get'."
+ (overlay-end hproperty-but))
+
+(defun hproperty:but-get-all-in-region (start end &optional property value)
+ "Return all buttons in the current buffer between START and END.
+If optional PROPERTY and VALUE are given, return only the first button
+with that PROPERTY and VALUE."
+ (delq nil
+ (mapcar (lambda (overlay)
+ (when (memq (overlay-get overlay (or property 'face))
+ (if property
+ (list value)
+ (list hproperty:but-face
+ hproperty:ibut-face
+ hproperty:flash-face)))
+ overlay))
+ (overlays-in start end))))
+
+(defun hproperty:but-get (&optional pos property value)
+ "Return button at optional POS or point.
+If optional PROPERTY and VALUE are given, return only the first button
+with that PROPERTY and VALUE."
+ (car (hproperty:but-get-all-in-region pos (1+ pos) property value)))
+
+(defun hproperty:but-start (hproperty-but)
+ "Return the end position of an HPROPERTY-BUT.
+See `hproperty:but-get'."
+ (overlay-start hproperty-but))
+
(add-to-list 'yank-handled-properties '(hproperty:but-face .
hproperty:but-create-on-yank))
;;; ************************************************************************
;;; Private functions
;;; ************************************************************************
-(defun hproperty:but-get (&optional pos)
- "Get button property at optional POS or point."
- (car (delq nil
- (mapcar (lambda (props)
- (if (memq (overlay-get props 'face)
- (list hproperty:but-face
- hproperty:ibut-face
- hproperty:flash-face))
- props))
- (overlays-at (or pos (point)))))))
-
(defsubst hproperty:list-cycle (list-ptr list)
"Move LIST-PTR to next element in LIST or when at end to first element."
(or (and list-ptr (setq list-ptr (cdr list-ptr)))
@@ -277,11 +308,13 @@ hproperty:color-ptr."
(redisplay t)
t))
-(defun hproperty:but-p (&optional pos)
+(defun hproperty:but-p (&optional pos property value)
"Return non-nil at point or optional POS iff on a highlighted Hyperbole
button."
- (memq t (mapcar (lambda (props)
- (when (memq (overlay-get props 'face)
- (list hproperty:but-face hproperty:ibut-face))
+ (memq t (mapcar (lambda (overlay)
+ (when (memq (overlay-get overlay (or property 'face))
+ (if property
+ (list value)
+ (list hproperty:but-face
hproperty:ibut-face)))
t))
(overlays-at (or pos (point))))))
diff --git a/hui.el b/hui.el
index 3ba334a777..87adf7e2c6 100644
--- a/hui.el
+++ b/hui.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 19-Sep-91 at 21:42:03
-;; Last-Mod: 21-Mar-24 at 15:30:24 by Bob Weiner
+;; Last-Mod: 25-May-24 at 11:19:06 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1623,8 +1623,8 @@ completion of all labeled buttons within the current
buffer."
(hproperty:but-create))))
(defun hui:htype-delete (htype-sym)
- "Delete HTYPE-SYM from use in current Hyperbole session.
-HTYPE-SYM must be redefined for use again."
+ "Delete a prompted-for Hyperbole type from HTYPE-SYM (actypes or ibtypes).
+The type must be redefined for use again."
(and htype-sym (symbolp htype-sym)
(let ((type
(intern (hargs:read-match
@@ -1753,7 +1753,7 @@ button's source file name when the button data is stored
externally."
If EDIT-FLAG is non-nil, edit button at point in BUT-WINDOW,
otherwise, prompt for button label and create a button.
LBL-KEY is internal form of button label. BUT-LOC is the file or buffer
-in which to create button. BUT-DIR is the directory of BUT-LOC.
+in which to create the button. BUT-DIR is the directory of BUT-LOC.
TYPE-AND-ARGS is the action type for the button followed by any
arguments it requires. Any text properties are removed from string
arguments."
diff --git a/hyrolo.el b/hyrolo.el
index 1c8b5316eb..136a330ff6 100644
--- a/hyrolo.el
+++ b/hyrolo.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 7-Jun-89 at 22:08:29
-;; Last-Mod: 7-Apr-24 at 18:40:47 by Bob Weiner
+;; Last-Mod: 6-May-24 at 00:20:13 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -3080,38 +3080,39 @@ Name is returned as `last, first-and-middle'."
(defun hyrolo-name-at-p ()
"Iff point is at or within an entry in `hyrolo-display-buffer', return
non-nil.
Any non-nil value returned is a cons of (<entry-name> . <entry-source>)."
- (let ((entry-source (hbut:get-key-src t))
- (col-num (current-column))
- (line-start (line-beginning-position))
- (line-end (line-end-position)))
- (when entry-source
- (save-excursion
- (forward-line 0)
- (let (case-fold-search
- entry-line
- entry-name)
- (if (and (or (looking-at hyrolo-hdr-and-entry-regexp)
- (re-search-backward hyrolo-hdr-and-entry-regexp nil t))
- (save-match-data (not (looking-at hyrolo-hdr-regexp))))
- (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")
- (when (or (looking-at "[^ \t\n\r]+ ?, ?[^ \t\n\r]+")
- (looking-at "\\( ?[^ \t\n\r]+\\)+"))
- (setq entry-name (match-string-no-properties 0)
- entry-line (buffer-substring-no-properties
line-start line-end))
- ;; Add a text-property of 'hyrolo-name-entry with
- ;; value of (entry-line . current-column) to entry-name.
- (put-text-property 0 1 'hyrolo-name-entry
- (cons entry-line col-num)
- entry-name)
- (cons entry-name entry-source)))
- ;; If not blank, return the current line as the name with
- ;; a text-property of 'hyrolo-line-entry with value of
(current-column).
- (goto-char line-start)
- (when (not (looking-at "[ \t\f]*$"))
- (setq entry-line (buffer-substring-no-properties line-start
line-end))
- (put-text-property 0 1 'hyrolo-line-entry col-num entry-line)
- (cons entry-line entry-source))))))))
+ (when (eq (current-buffer) (get-buffer hyrolo-display-buffer))
+ (let ((entry-source (hbut:get-key-src t))
+ (col-num (current-column))
+ (line-start (line-beginning-position))
+ (line-end (line-end-position)))
+ (when entry-source
+ (save-excursion
+ (forward-line 0)
+ (let (case-fold-search
+ entry-line
+ entry-name)
+ (if (and (or (looking-at hyrolo-hdr-and-entry-regexp)
+ (re-search-backward hyrolo-hdr-and-entry-regexp nil t))
+ (save-match-data (not (looking-at hyrolo-hdr-regexp))))
+ (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (when (or (looking-at "[^ \t\n\r]+ ?, ?[^ \t\n\r]+")
+ (looking-at "\\( ?[^ \t\n\r]+\\)+"))
+ (setq entry-name (match-string-no-properties 0)
+ entry-line (buffer-substring-no-properties
line-start line-end))
+ ;; Add a text-property of 'hyrolo-name-entry with
+ ;; value of (entry-line . current-column) to
entry-name.
+ (put-text-property 0 1 'hyrolo-name-entry
+ (cons entry-line col-num)
+ entry-name)
+ (cons entry-name entry-source)))
+ ;; If not blank, return the current line as the name with
+ ;; a text-property of 'hyrolo-line-entry with value of
(current-column).
+ (goto-char line-start)
+ (when (not (looking-at "[ \t\f]*$"))
+ (setq entry-line (buffer-substring-no-properties line-start
line-end))
+ (put-text-property 0 1 'hyrolo-line-entry col-num entry-line)
+ (cons entry-line entry-source)))))))))
(define-derived-mode hyrolo-org-mode outline-mode "HyRoloOrg"
"Basic Org mode for use in HyRolo display match searches."
diff --git a/hywiki.el b/hywiki.el
new file mode 100644
index 0000000000..a9bfe1f8db
--- /dev/null
+++ b/hywiki.el
@@ -0,0 +1,601 @@
+;;; hywiki.el --- Hyperbole's auto-wikiword note-taking system -*-
lexical-binding: t -*-
+;;
+;; Author: Bob Weiner
+;;
+;; Orig-Date: 21-Apr-24 at 22:41:13
+;; Last-Mod: 25-May-24 at 16:54:09 by Bob Weiner
+;;
+;; SPDX-License-Identifier: GPL-3.0-or-later
+;;
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+;; See the "HY-COPY" file for license information.
+;;
+;; This file is part of GNU Hyperbole.
+
+;;; Commentary:
+;;
+;; This is Hyperbole's markup-free personal Wiki system for
+;; note-taking and automatic WikiWord hyperlinking. A `HyWiki word'
+;; starts with a capitalized letter and contains only upper and
+;; lowercase letters. `HyWiki pages' are Org or other text mode
+;; files with HyWiki word names (the page name) plus a file-type
+;; suffix which are stored within `hywiki-directory'.
+;;
+;; To create a new HyWiki page or to jump to one, simply create an
+;; 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; 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
+;; names will override Org's standard handling of such links. To
+;; prevent Org mode's binding of {M-RET} from splitting lines and
+;; creating new headlines when on a HyWiki word whose page has not
+;; yet been created, set `hsys-org-enable-smart-keys' to 't' so that
+;; Hyperbole's Action Key does the right thing in this context.
+;;
+;; HyWiki pages are created in `hywiki-directory'. Within such
+;; pages, WikiWords (the names of HyWiki pages) work without the need
+;; for any delimiters. Simply type them out, e.g. Emacs and if a
+;; page exists for the word, it is automatically highlighted when:
+;; - a HyWiki page file is read in
+;; - a whitespace character, ')', '}', or Org-mode punctuation/symbol
+;; character is inserted following a HyWiki word
+;; - the Action Key is pressed to activate a HyWiki word button.
+;;
+;; HyWiki links can also link to a section headline within a page by
+;; simply following the page name a '#' character and then the
+;; section headline name. For example, if your Emacs page has a
+;; 'Major Modes section, then either [[hy:Emacs#Major Modes]] or
+;; Emacs#Major-Modes will work as a link to that section. Note that
+;; without the square bracket delimiters, you must convert spaces in
+;; section names to '-' characters.
+;;
+;; Although HyWiki creates new pages in Org mode, you can manually
+;; insert pages in Markdown or other text modes within
+;; `hywiki-directory' and then link to them. You can also change the
+;; default `hywiki-file-suffix' to something else, like ".md" to have
+;; HyWiki use Markdown mode for its pages. This usage has not yet
+;; been tested though, so use at your own risk.
+
+;;; Code:
+;;; ************************************************************************
+;;; Other required Elisp libraries
+;;; ************************************************************************
+
+(require 'hasht)
+(require 'hpath)
+(require 'hui-em-but)
+(require 'ol)
+
+(eval-and-compile
+ '(when (require 'company nil t)
+ (add-to-list 'company-backends 'hywiki-company-hasht-backend)))
+
+;;; ************************************************************************
+;;; Public variables
+;;; ************************************************************************
+
+(defcustom hywiki-word-highlight-flag t
+ "Non-nil means automatically highlight non-Org link HyWiki word
hyperbuttons."
+ :type 'boolean
+ :initialize #'custom-initialize-default
+ :group 'hyperbole-buttons)
+
+(defvar hywiki-file-suffix ".org"
+ "File suffix (including period) to use when creating HyWiki pages.")
+
+(defvar hywiki-directory '"~/hywiki/"
+ "Directory in which to find HyWiki page files.")
+
+(defvar hywiki-non-character-commands
+ '(;; Org mode
+ org-cycle ;; TAB
+ org-return ;; RET, \r
+ org-return-and-maybe-indent ;; C-j, \n
+ ;; Markdown mode
+ markdown-cycle ;; TAB
+ markdown-enter-key ;; RET, \r
+ electric-newline-and-maybe-indent ;; C-j, \n
+ ;; Global
+ newline ;; RET, \r
+ newline-and-indent ;; RET, \r
+ quoted-insert ;; C-q
+ )
+ "Commands that insert characters but whose input events do not
+ arrive as characters or that quote another character for input.")
+
+;; Define the keymap for hywiki-mode.
+(defvar hywiki-mode-map nil
+ "Keymap for `hywiki-mode'.")
+
+(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'.
+Otherwise, this prefix is not needed and HyWiki word Org links
+override standard Org link lookups. See \"(org)Internal Links\".")
+
+(defconst hywiki-word-regexp
+ "\\<\\([[: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 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
+the HyWiki word and grouping 2 is the #section with the # included.")
+
+(defconst hywiki-word-org-link-regexp
+ (concat hywiki-word-regexp "\\(#[^][\n\r\f]+\\)?")
+ "Regexp that matches a HyWiki word with an optional #section in an Org link.
+Section may not contain spaces or square brackets. Use '-' to
+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 "orange"))
+ (((background dark)) (:background "orange" :foreground "black"))
+ (((min-colors 88)) (:foreground "orange"))
+ (t (:background "orange")))
+ "Face for HyWiki word highlighting."
+ :group 'hyperbole-buttons)
+
+(defcustom hywiki-word-face 'hywiki--word-face
+ "Hyperbole face for HyWiki word highlighting."
+ :type 'face
+ :initialize #'custom-initialize-default
+ :group 'hyperbole-buttons)
+
+;;; ************************************************************************
+;;; Private variables
+;;; ************************************************************************
+
+(defvar hywiki--buttonize-characters nil
+ "String of single character keys bound to
`hywiki-buttonize-character-commands'.
+Each such key self-inserts before highlighting any prior HyWiki word.")
+
+(defvar hywiki--pages-hasht nil)
+
+;;; ************************************************************************
+;;; hywiki minor mode
+;;; ************************************************************************
+
+(defun hywiki-buttonize-character-commands ()
+ "Turn any HyWikiWord before point into a highlighted Hyperbole button.
+Triggered by `post-self-insert-hook' for self-inserting characters."
+ (when (and (characterp last-command-event)
+ (seq-find (lambda (c) (= c last-command-event))
hywiki--buttonize-characters))
+ (hywiki-highlight-page-name)))
+
+(defun hywiki-buttonize-non-character-commands ()
+ "Turn any HyWikiWord before point into a highlighted Hyperbole button.
+Triggered by `pre-command-hook' for non-character-commands, e.g. return."
+ (when (memq this-command hywiki-non-character-commands)
+ (hywiki-highlight-page-name)))
+
+(defun hywiki-get-buttonize-characters ()
+ "Return a string of Org self-insert keys that have punctuation/symbol
syntax."
+ (let (key
+ cmd
+ key-cmds
+ result)
+ ;; Org and other text mode self-insert-command bindings are just
+ ;; remaps inherited from global-map. Create key-cmds list of
+ ;; parsable (key . cmd) combinations where key may be a
+ ;; (start-key . end-key) range of keys.
+ (map-keymap (lambda (key cmd) (setq key-cmds (cons (cons key cmd)
key-cmds))) (current-global-map))
+ (dolist (key-cmd key-cmds (concat (nreverse result)))
+ (setq key (car key-cmd)
+ cmd (cdr key-cmd))
+ (when (eq cmd 'self-insert-command)
+ (cond ((and (characterp key)
+ (= (char-syntax key) ?.))
+ ;; char with punctuation/symbol syntax
+ (setq result (cons key result)))
+ ((and (consp key)
+ (characterp (car key))
+ (characterp (cdr key))
+ (<= (cdr key) 256))
+ ;; ASCII char range, some of which has punctuation/symbol syntax
+ (with-syntax-table org-mode-syntax-table
+ (dolist (k (number-sequence (car key) (cdr key)))
+ (when (memq (char-syntax k) '(?. ?_))
+ (setq result (cons k result)))))))))))
+
+(define-minor-mode hywiki-mode
+ "Toggle HyWiki minor mode with \\[hywiki-mode].
+
+The hywiki-mode minor mode auto-highlights and creates implicit
+buttons from wiki words. Any such button jumps to the associated
+HyWiki page or associated section when HyWikiWord#section is used.
+
+When hywiki-mode is enabled, the `hywiki-mode' variable is
+non-nil.
+
+See the Info documentation at \"(hyperbole)HyWiki\".
+
+\\{hywiki-mode-map}"
+
+ :lighter " HyWiki"
+ :keymap hywiki-mode-map
+ (if hywiki-mode
+ (progn (unless hywiki-mode-map
+ (setq hywiki-mode-map (make-sparse-keymap)))
+ ;; Self-insert punct/sym keys that trigger wiki-word
+ ;; highlighting via `hywiki-buttonize-character-commands' in
`hywiki-mode'.
+ (unless hywiki--buttonize-characters
+ (setq hywiki--buttonize-characters
+ (concat " \t\r\n\)\]\>\}'"
(hywiki-get-buttonize-characters))))
+ (add-hook 'post-self-insert-hook
'hywiki-buttonize-character-commands)
+ (add-hook 'pre-command-hook
'hywiki-buttonize-non-character-commands 95))
+ (remove-hook 'post-self-insert-hook 'hywiki-buttonize-character-commands)
+ (remove-hook 'pre-command-hook 'hywiki-buttonize-character-commands)))
+
+;;; ************************************************************************
+;;; Public Implicit Button and Action Types
+;;; ************************************************************************
+
+(defib hywiki ()
+ "When on a HyWiki word, display its page and optional section."
+ (let* ((page-name (hywiki-at-wikiword)))
+ (when page-name
+ (ibut:label-set page-name (match-beginning 0) (match-end 0))
+ (hywiki-highlight-page-name t)
+ (hact 'hywiki-find-page page-name))))
+
+(defun hywiki-find-page (&optional page-name 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 ((in-page-flag (null page-name))
+ (in-hywiki-directory-flag (string-prefix-p (expand-file-name
hywiki-directory)
+ (or buffer-file-name ""))))
+ ;; If called from `find-file-hook' without a page-name and outside
+ ;; hywiki-directory, do nothing (just finding a regular file).
+ (when (or (stringp page-name) in-hywiki-directory-flag)
+ (when in-page-flag
+ ;; Current buffer must be the desired page (called from
'find-file-hook')
+ (unless in-hywiki-directory-flag
+ (error "(hywiki-find-page): No `page-name'; buffer file must be in
`hywiki-directory', not %s"
+ default-directory))
+ (when (null buffer-file-name)
+ (error "(hywiki-find-page): No `page-name' given in a buffer without
an attached file"))
+ (setq page-name (file-name-sans-extension (file-name-nondirectory
buffer-file-name))))
+
+ (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))
+ (page-file (or (hywiki-get-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
+ (unless in-page-flag (hpath:find (concat page-file section)))
+ (unless hywiki-mode (hywiki-mode 1))
+ (hywiki-highlight-page-names)
+ (run-hooks 'hywiki-find-page-hook)
+ page-file)))))
+
+;;; ************************************************************************
+;;; 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
+ (with-current-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-maybe-at-wikiword-beginning ()
+ "Return non-nil if previous character is one preceding a HyWiki word.
+Does not test whether or not a page exists for the HyWiki word.
+Use `hywiki-get-page' to determine whether a HyWiki page exists."
+ ;; Ignore wikiwords preceded by any non-whitespace character, except
+ ;; any of these: ({"'`'
+ (when (or (bolp)
+ (memq (char-before) '(?\( ?\{ ?\" ?\' ?\` ?\ ?\t ?\n ?\r ?\f)))
+ t))
+
+(defun hywiki-at-wikiword ()
+ "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."
+ (when hywiki-mode
+ (let ((wikiword (ibut:label-p t "[[" "]]")))
+ (if wikiword
+ ;; Handle an Org link [[HyWikiWord]] [[hy:HyWikiWord]] or
[[HyWikiWord#section]].
+ (progn
+ (setq wikiword
+ (org-link-expand-abbrev (org-link-unescape (string-trim
wikiword))))
+ ;; Ignore prefixed, typed hy:HyWikiWord since Org mode will display
those.
+ (when (hywiki-is-wikiword wikiword)
+ wikiword))
+ ;; Handle a HyWiki word with optional #section; if it is an Org
+ ;; link, it may optionally have a hy: link-type prefix.
+ (save-excursion
+ (let ((case-fold-search nil))
+ (skip-chars-backward "-*#[:alnum:]")
+ ;; Ignore wikiwords preceded by any non-whitespace
+ ;; character, except any of these: (["'`'
+ (and (hywiki-maybe-at-wikiword-beginning)
+ (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.
+(defvar hywiki--any-page-regexp nil)
+(defvar hywiki--but nil)
+(defvar hywiki--but-end nil)
+(defvar hywiki--but-start nil)
+(defvar hywiki--current-page nil)
+(defvar hywiki--end nil)
+(defvar hywiki--page-name nil)
+(defvar hywiki--save-case-fold-search nil)
+(defvar hywiki--save-org-link-type-required nil)
+(defvar hywiki--start nil)
+
+(defun hywiki-highlight-page-names ()
+ "Highlight all non-Org link HyWiki page names in a HyWiki buffer.
+Use `hywiki-word-face' to highlight. Does not highlight references to
+the current page unless they have sections attached."
+ (interactive)
+ ;; Avoid doing any lets for efficiency.
+ ;; Highlight HyWiki words in buffers where `hywiki-mode' is enabled
+ ;; or with attached files below `hywiki-directory'.
+ (when (and hywiki-word-highlight-flag
+ (or hywiki-mode
+ (string-prefix-p (expand-file-name hywiki-directory)
+ (or buffer-file-name ""))))
+ (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)
+ (when (hywiki-maybe-at-wikiword-beginning)
+ ;; 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.
+With optional ON-PAGE-NAME non-nil, assume point is within the page or
+section name.
+
+Use `hywiki-word-face' to highlight. Does not highlight references to
+the current page unless they have sections attached."
+ (interactive)
+ (when (and hywiki-word-highlight-flag
+ (or on-page-name
+ (and (eq (char-before) last-command-event) ; Sanity check
+ (not (eq ?# last-command-event))
+ (memq (char-syntax last-command-event) '(?\ ?\) ?\$ ?\>
?. ?\" ?\'))))
+ (not executing-kbd-macro)
+ (not noninteractive))
+ (save-excursion
+ ;; (when (= (char-syntax (char-before)) ?\))
+ ;; Clear any HyWikiWord highlighting that may just be a part
+ ;; of a larger balanced delimiter text with multiple words.
+ ;; If there is just a single HyWikiWord, it will be
+ ;; re-highlighted later in this function.
+ ;; (ignore-errors
+ ;; (let* ((sexp-end (point))
+ ;; (sexp-start (scan-sexps sexp-end -1)))
+ ;; (when sexp-start
+ ;; (hproperty:but-clear-all-in-list
+ ;; (hproperty:but-get-all-in-region sexp-start sexp-end 'face
hywiki-word-face))))))
+
+ (unless on-page-name
+ ;; after page name
+ (skip-syntax-backward "-"))
+ ;; May be a closing delimiter that we have to skip past
+ (skip-chars-backward (regexp-quote hywiki--buttonize-characters))
+ ;; Skip pass HyWikiWord or section
+ (skip-syntax-backward "^-$()._\"\'")
+ (skip-chars-backward "#[:alpha:]")
+
+ (setq hywiki--save-case-fold-search case-fold-search
+ case-fold-search nil
+ hywiki--save-org-link-type-required hywiki-org-link-type-required
+ hywiki-org-link-type-required t)
+ (if (and (hywiki-maybe-at-wikiword-beginning)
+ (looking-at hywiki-word-optional-section-regexp)
+ (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.
+The page for the word may not yet exist. Use `hywiki-get-page'
+to determine whether a HyWiki word page exists."
+ (and (stringp word)
+ (let (case-fold-search)
+ (or (eq (string-match (concat "\\`" hywiki-word-org-link-regexp "\\'")
word)
+ 0)
+ (eq (string-match (concat "\\`"
hywiki-word-optional-section-regexp "\\'") word)
+ 0)))))
+
+(defun hywiki-get-buffer-page-name ()
+ "Extract the page name from the buffer file name or else buffer name."
+ (file-name-sans-extension (file-name-nondirectory
+ (or buffer-file-name (buffer-name)))))
+
+(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))
+ (eq (string-match hywiki-word-org-link-regexp page-name) 0))
+ (progn
+ (when (match-string-no-properties 2 page-name)
+ ;; Remove any #section suffix in PAGE-NAME.
+ (setq page-name (match-string-no-properties 1 page-name)))
+
+ (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."
+ (when (and (stringp hywiki-directory) (file-readable-p hywiki-directory))
+ (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,
+return nil.
+
+Use `hywiki-get-page' to determine whether a HyWiki page exists."
+ (if (and (stringp page-name) (not (string-empty-p page-name))
+ (eq (string-match hywiki-word-org-link-regexp page-name) 0))
+ (progn
+ (when (match-string-no-properties 2 page-name)
+ ;; Remove any #section suffix in PAGE-NAME.
+ (setq page-name (match-string-no-properties 1 page-name)))
+
+ (let ((page-file (hywiki-get-page-file page-name))
+ (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))
+ (unless (hash-get page-name pages-hasht)
+ (hash-add page-file page-name pages-hasht))
+ page-file))
+ (user-error "(hywiki-add-page): Invalid page name: '%s'; must be
capitalized, all alpha" page-name)))
+
+(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))))
+
+(eval-and-compile
+'(when (featurep 'company)
+(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)
+ (pcase command
+ ('interactive (company-begin-backend 'company-hash-table-backend))
+ ('prefix (company-grab-word))
+ ('candidates
+ (let ((prefix (company-grab-word)))
+ (when prefix
+ (cl-loop for key being the hash-keys in (hywiki-get-page-list)
+ when (string-prefix-p prefix key)
+ collect key))))
+ ('sorted t))))))
+
+(defun hywiki-org-link-complete (&optional _arg)
+ "Complete HyWiki page names for `org-insert-link'."
+ (concat
+ (when hywiki-org-link-type-required
+ (concat hywiki-org-link-type ":"))
+ (let ((completion-ignore-case t))
+ (completing-read "HyWiki page: " (hywiki-get-page-list) nil t))))
+
+(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
+ (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))))
+
+(org-link-set-parameters hywiki-org-link-type
+ :complete #'hywiki-org-link-complete
+ :follow #'hywiki-find-page
+ :store #'hywiki-org-link-store)
+
+(add-hook 'find-file-hook #'hywiki-find-page t)
+
+(provide 'hywiki)
diff --git a/test/hyrolo-tests.el b/test/hyrolo-tests.el
index d2655e297c..13444faf8b 100644
--- a/test/hyrolo-tests.el
+++ b/test/hyrolo-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 19-Jun-21 at 22:42:00
-;; Last-Mod: 31-Mar-24 at 22:29:58 by Mats Lidell
+;; Last-Mod: 18-May-24 at 20:14:05 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1613,21 +1613,21 @@ body
(ert-deftest hyrolo-tests--goto-kotl-header-with-slash-match ()
"Move from heading match to target line with a slash in kotl file."
:expected-result :failed
- (let* ((kotl-file1 (hyrolo-tests--gen-kotl-outline "h1 / h2" "body" 1))
+ (let* ((kotl-file1 (hyrolo-tests--gen-kotl-outline "h1" "body" 1))
(hyrolo-file-list (list kotl-file1)))
(unwind-protect
(progn
- (hyrolo-grep "h2")
- (hyrolo-next-match)
+ (kotl-mode:beginning-of-buffer)
+ (hyrolo-grep "h1/h1 1")
(action-key)
(should (string= (buffer-file-name) kotl-file1))
- (should (looking-at-p "h2$"))
+ (should (looking-at-p "h1 1$"))
(should (string= (buffer-substring-no-properties (point-min)
(point-max))
"\
- 1. h1 / h2
+ 1. h1
body
- 1a. h1 / h2 1
+ 1a. h2
body 1
" )))
