hywiki-alias.el (32860B)
1 ;;; hywiki-alias.el --- Derived case/space aliases for HyWikiWords -*- lexical-binding: t; -*- 2 3 ;; Highlight and activate case- and space-variants of existing HyWikiWords 4 ;; without typing any aliases. A HyWikiWord like `DataModelTesting' is split at 5 ;; its CamelCase boundaries (Data | Model | Testing); the mode then highlights 6 ;; any case-insensitive occurrence with optional single spaces at those 7 ;; boundaries -- "Data Model Testing", "data model testing", "DaTa moDel 8 ;; TESTING" -- and the Action Key (M-RET) on such a phrase jumps to the 9 ;; `DataModelTesting' page, exactly as on the real WikiWord. The alias set is 10 ;; derived from your live HyWiki pages, so there is nothing to maintain. 11 ;; 12 ;; This is an EDITING-TIME convenience only: highlighting + Action-Key jump. 13 ;; It does NOT feed HyWiki's data model, so backlinks, publishing, the 14 ;; hywiki-graph, cross-file grep and completion do not see these aliases. See 15 ;; hywiki-alias.README.md for the full list and the rationale. 16 ;; 17 ;; Implementation is a thin, reversible layer over HyWiki: two pieces of advice 18 ;; plus its own overlay pass. Disabling the mode removes both and all overlays. 19 ;; Off by default -- `M-x zetta-hywiki-alias-mode' to toggle. 20 21 (require 'cl-lib) 22 23 (declare-function hywiki-get-wikiword-list "hywiki") 24 (declare-function hywiki-active-in-current-buffer-p "hywiki") 25 (declare-function hywiki-word-at "hywiki") 26 (declare-function hywiki-maybe-highlight-references "hywiki") 27 (declare-function hywiki-add-referent "hywiki") 28 (declare-function hywiki-add-page "hywiki") 29 (declare-function hywiki-find-referent "hywiki") 30 (declare-function hywiki-word-strip-suffix "hywiki") 31 (declare-function hywiki-word-create-and-display "hywiki") 32 (declare-function hywiki-get-plural-wikiword "hywiki") 33 (declare-function hywiki-get-singular-wikiword "hywiki") 34 (defvar hywiki-allow-plurals-flag) 35 (defvar hywiki-word-face) 36 (defvar hywiki-directory) 37 (defvar hywiki-file-suffix) 38 (defvar zetta-hywiki-alias-mode) 39 40 (defgroup zetta-hywiki-alias nil 41 "Derived case/space aliases for HyWikiWords." 42 :group 'hyperbole-hywiki) 43 44 (defcustom zetta-hywiki-alias-min-length 1 45 "Only HyWikiWords at least this many characters get a derived alias. 46 The default, 1, imposes no real length floor; raise it to suppress aliases 47 for very short page names, whose lowercase forms are the most prose-prone." 48 :type 'integer :group 'zetta-hywiki-alias) 49 50 (defcustom zetta-hywiki-alias-min-segments 1 51 "Minimum CamelCase segments a HyWikiWord needs to get a derived alias. 52 The default, 1, aliases every page including single-word ones like `Emacs', 53 so lowercase `emacs' is highlighted and activates. Set to 2 to skip 54 single-word pages, whose case-insensitive match tends to light up prose; use 55 `zetta-hywiki-alias-deny-list' to exclude specific offenders either way." 56 :type 'integer :group 'zetta-hywiki-alias) 57 58 (defcustom zetta-hywiki-alias-deny-list nil 59 "HyWikiWords that should never get a derived alias (e.g. common phrases)." 60 :type '(repeat string) :group 'zetta-hywiki-alias) 61 62 (defcustom zetta-hywiki-alias-derive-plurals t 63 "Non-nil means also alias the plural/singular inflections of each page. 64 When set, a `Lisp' page also highlights and activates `lisps', a `Class' page 65 `classes', and so on, using HyWiki's own inflection rules 66 \(`hywiki-get-plural-wikiword' / `hywiki-get-singular-wikiword'). Both the 67 derived CamelCase aliases and manual `Aliases' entries are inflected, in both 68 directions (the plural of a singular name and the singular of a plural one). 69 70 This mirrors -- and defers to -- HyWiki's native `hywiki-allow-plurals-flag', 71 which HyWiki applies only to the capitalized WikiWord form (so it highlights 72 `Lisps' but never lowercase `lisps'); enabling this extends the same plurals 73 to the lowercase/spaced/hyphenated alias forms. Because the underlying 74 HyWiki functions return nil when `hywiki-allow-plurals-flag' is nil, turning 75 HyWiki's plurals off turns these off too. Set to nil to match an alias only 76 in the exact number the page name uses." 77 :type 'boolean :group 'zetta-hywiki-alias) 78 79 (defcustom zetta-hywiki-alias-wikify-key "C-c W" 80 "Key globally bound to `zetta-hywiki-alias-wikify', or nil for no binding. 81 A `keymap-set'-style string such as \"C-c W\". Set it through Customize (which 82 moves the binding for you) or `setq' it before this module loads; the module 83 installs the binding once at load time. Set to nil to leave the command 84 reachable only via \\[execute-extended-command]." 85 :type '(choice (const :tag "No binding" nil) (string :tag "Key")) 86 :set (lambda (sym val) 87 (when (and (boundp sym) (symbol-value sym)) 88 (ignore-errors (keymap-global-unset (symbol-value sym) t))) 89 (set-default sym val) 90 (when val (keymap-global-set val #'zetta-hywiki-alias-wikify))) 91 :group 'zetta-hywiki-alias) 92 93 (defvar zetta-hywiki-alias--index nil 94 "Hash mapping a downcased, space-stripped alias form to its WikiWord(s). 95 The value is the LIST of canonical WikiWords that share the alias, sorted for 96 a stable representative; more than one entry means the alias is ambiguous and 97 the choice between pages is made at activation time.") 98 (defvar zetta-hywiki-alias--regexp nil 99 "Cached alternation regexp matching every derived alias form.") 100 (defvar zetta-hywiki-alias--generation 0 101 "Counter bumped whenever the alias set changes. 102 Part of the `post-command' refresh-guard key, so adding a HyWikiWord forces 103 the next command to re-scan even when buffer text and scroll are unchanged.") 104 105 (defun zetta-hywiki-alias--segments (word) 106 "Split WORD at CamelCase boundaries into a list of segments. 107 Handles acronym runs, so \"HTMLParser\" -> (\"HTML\" \"Parser\")." 108 (let* ((case-fold-search nil) 109 (s (replace-regexp-in-string 110 "\\([[:upper:]]\\)\\([[:upper:]][[:lower:]]\\)" "\\1\0\\2" word)) 111 (s (replace-regexp-in-string 112 "\\([[:lower:][:digit:]]\\)\\([[:upper:]]\\)" "\\1\0\\2" s))) 113 (split-string s "\0" t))) 114 115 (defun zetta-hywiki-alias--page-file (word) 116 "Return WORD's readable HyWiki page file, or nil." 117 (when (and (boundp 'hywiki-directory) hywiki-directory) 118 (let ((f (expand-file-name 119 (concat word (if (boundp 'hywiki-file-suffix) hywiki-file-suffix ".org")) 120 hywiki-directory))) 121 (and (file-readable-p f) f)))) 122 123 (defun zetta-hywiki-alias--hywiki-page-file-p (file) 124 "Return non-nil if FILE is a HyWiki page file directly under `hywiki-directory'." 125 (and file (boundp 'hywiki-directory) hywiki-directory 126 (let ((f (expand-file-name file)) 127 (dir (file-name-as-directory (expand-file-name hywiki-directory))) 128 (suffix (if (boundp 'hywiki-file-suffix) hywiki-file-suffix ".org"))) 129 (and (string-suffix-p suffix f) 130 (equal (file-name-directory f) dir))))) 131 132 (defun zetta-hywiki-alias--file-aliases (word) 133 "Return the manual alias strings declared in WORD's page `Aliases' section. 134 Reads WORD's page file and collects each entry beneath a heading whose title 135 is `Aliases' (any level, case-insensitive), up to the next heading. Leading 136 list bullets are stripped; blank lines and Org keyword/comment lines (`#...') 137 are ignored." 138 (let ((file (zetta-hywiki-alias--page-file word))) 139 (when file 140 (with-temp-buffer 141 (insert-file-contents file) 142 (goto-char (point-min)) 143 (let ((case-fold-search t) aliases) 144 (when (re-search-forward "^\\*+[ \t]+aliases[ \t]*$" nil t) 145 (forward-line 1) 146 (while (and (not (eobp)) (not (looking-at-p "^\\*+[ \t]"))) 147 (let ((line (string-trim (buffer-substring-no-properties 148 (line-beginning-position) 149 (line-end-position))))) 150 (setq line (replace-regexp-in-string 151 "\\`\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+" "" line)) 152 (when (and (not (string-empty-p line)) 153 (not (string-prefix-p "#" line))) 154 (push line aliases))) 155 (forward-line 1))) 156 (nreverse aliases)))))) 157 158 (defun zetta-hywiki-alias--add (index canon tokens) 159 "Add an alias built from TOKENS -> CANON to INDEX and return its regexp. 160 TOKENS is the ordered list of word pieces; in text they may be joined, or 161 separated by a single space/tab or hyphen. INDEX maps each alias key to the 162 LIST of canonical WikiWords that claim it, so when several pages share an 163 alias (e.g. two people both aliased `programmer') every page is kept and 164 offered at activation time instead of one silently clobbering the other. 165 CANON is appended when not already present. Returns nil for empty TOKENS." 166 (when tokens 167 (let* ((key (downcase (apply #'concat tokens))) 168 (existing (gethash key index))) 169 (unless (member canon existing) 170 (puthash key (append existing (list canon)) index))) 171 (mapconcat #'regexp-quote tokens "[ \t-]?"))) 172 173 (defun zetta-hywiki-alias--number-variants (s) 174 "Return plural/singular inflections of S that differ from it, else nil. 175 Reuses HyWiki's own inflection rules so a lowercase or spaced alias 176 pluralizes exactly as HyWiki pluralizes the WikiWord itself -- e.g. a `Lisp' 177 page also lights up `lisps', and a `Class' page `classes'. Both directions 178 are produced (plural of a singular name, singular of a plural name), matching 179 HyWiki's bidirectional plural handling. 180 181 HyWiki's singularizer strips a whole `-es' from sibilant endings, which is 182 right for `Boxes'->`Box' but wrong for the many plurals whose stem ends in a 183 silent `e' (`Houses'->`Hous', `Pages' left unchanged). So when S looks 184 plural we ALSO offer the naive strip-one-trailing-s singular, which recovers 185 `House'/`Page'/`Case'; any bogus extra (`hous') is inert since it never 186 occurs in prose. 187 188 Honoured only when `zetta-hywiki-alias-derive-plurals' is non-nil; the HyWiki 189 functions additionally return their input unchanged unless 190 `hywiki-allow-plurals-flag' is set, so this quietly follows HyWiki's own 191 plural setting." 192 (when zetta-hywiki-alias-derive-plurals 193 (let (variants) 194 (cl-flet ((add (v) 195 (when (and (stringp v) (not (string-empty-p v)) 196 (not (equal v s)) (not (member v variants))) 197 (push v variants)))) 198 ;; HyWiki's own inflectors, in both directions. 199 (dolist (fn '(hywiki-get-plural-wikiword hywiki-get-singular-wikiword)) 200 (when (fboundp fn) (add (funcall fn s)))) 201 ;; Naive singular for plural-looking names, to cover the `-se' plurals 202 ;; HyWiki's `-es' rule mishandles. Skip `-ss' endings (`Class') and 203 ;; `emacs', and require a non-trivial stem. 204 (let ((low (downcase s))) 205 (when (and (> (length s) 3) 206 (string-suffix-p "s" low) 207 (not (string-suffix-p "ss" low)) 208 (not (equal low "emacs"))) 209 (add (substring s 0 -1))))) 210 (nreverse variants)))) 211 212 (defun zetta-hywiki-alias--rebuild () 213 "Rebuild the alias index and matching regexp from existing HyWikiWords. 214 Includes both aliases derived from each WikiWord's CamelCase segments and any 215 manual aliases listed in a page's `Aliases' section." 216 (let ((index (make-hash-table :test 'equal)) 217 (patterns nil)) 218 (dolist (word (and (fboundp 'hywiki-get-wikiword-list) 219 (hywiki-get-wikiword-list))) 220 (when (stringp word) 221 ;; Derived aliases: case/space/hyphen variants of the CamelCase segments. 222 (let ((segs (zetta-hywiki-alias--segments word))) 223 (when (and (>= (length segs) zetta-hywiki-alias-min-segments) 224 (>= (length word) zetta-hywiki-alias-min-length) 225 (not (member word zetta-hywiki-alias-deny-list))) 226 (push (zetta-hywiki-alias--add index word segs) patterns) 227 ;; ...and the same variants for its plural/singular inflections. 228 (dolist (variant (zetta-hywiki-alias--number-variants word)) 229 (push (zetta-hywiki-alias--add 230 index word (zetta-hywiki-alias--segments variant)) 231 patterns)))) 232 ;; Manual aliases from the page's `Aliases' section (always honoured), 233 ;; each inflected the same way. 234 (dolist (alias (zetta-hywiki-alias--file-aliases word)) 235 (push (zetta-hywiki-alias--add index word (split-string alias "[ \t-]+" t)) 236 patterns) 237 (dolist (variant (zetta-hywiki-alias--number-variants alias)) 238 (push (zetta-hywiki-alias--add 239 index word (split-string variant "[ \t-]+" t)) 240 patterns))))) 241 ;; Collision-shared aliases push identical patterns; keep the regexp tidy. 242 (setq patterns (delete-dups (delq nil patterns))) 243 ;; Longer phrases first so a short alias cannot pre-empt a longer one. 244 (setq patterns (sort patterns (lambda (a b) (> (length a) (length b))))) 245 ;; Sort each key's candidate list so the representative (and the activation 246 ;; prompt's default) is stable rather than hash-iteration order. 247 (maphash (lambda (k v) (puthash k (sort v #'string<) index)) index) 248 (setq zetta-hywiki-alias--index index 249 zetta-hywiki-alias--regexp 250 (and patterns 251 (concat "\\b\\(?:" (mapconcat #'identity patterns "\\|") "\\)\\b"))))) 252 253 (defun zetta-hywiki-alias--ensure () 254 "Build the index and regexp if they are not current." 255 (unless zetta-hywiki-alias--index (zetta-hywiki-alias--rebuild))) 256 257 (defun zetta-hywiki-alias--invalidate (&rest _) 258 "Rebuild-on-demand the alias set and re-highlight all visible windows. 259 Advised onto the HyWikiWord-adding commands so a newly created word's derived 260 aliases appear immediately. Drop the cached index/regexp, bump the generation 261 counter (part of the `post-command' change-guard key, so a scroll-free, 262 edit-free buffer still re-scans on its next command), and refresh every visible 263 window now -- creating a WikiWord moves focus to the new page buffer, so the 264 buffer holding the alias occurrences is usually no longer the selected window." 265 (setq zetta-hywiki-alias--index nil 266 zetta-hywiki-alias--regexp nil) 267 (cl-incf zetta-hywiki-alias--generation) 268 (when (bound-and-true-p zetta-hywiki-alias-mode) 269 (zetta-hywiki-alias--refresh-windows))) 270 271 (defun zetta-hywiki-alias--hywiki-face-at (pos) 272 "Return non-nil if a HyWiki highlight overlay already covers POS." 273 (seq-find (lambda (o) (eq (overlay-get o 'face) hywiki-word-face)) 274 (overlays-at pos))) 275 276 (defun zetta-hywiki-alias--link-color-at (pos) 277 "Return a clickable link's colour at POS, or nil when POS is not a link. 278 Used to underline a WikiWord that is also a link in the link's own colour, so 279 it reads as both. Recognises `shr'/eww links and `button' buttons." 280 (cond 281 ((and (get-text-property pos 'shr-url) (facep 'shr-link)) 282 (face-attribute 'shr-link :foreground nil t)) 283 ((and (get-text-property pos 'button) (facep 'button)) 284 (face-attribute 'button :foreground nil t)))) 285 286 (defun zetta-hywiki-alias--hyphen-bounded-p (mb me) 287 "Return non-nil if [MB, ME) is joined by a hyphen to another word. 288 This skips an alias that is only part of a larger hyphenated token -- e.g. 289 `emacs' inside `emacs-foobar' -- while still allowing a hyphen that lies 290 between the WikiWord's own segments, since that hyphen is consumed inside the 291 match rather than sitting at its edge." 292 (cl-flet ((wordish (c) (and c (eq ?w (char-syntax c))))) 293 (or (and (eq (char-after me) ?-) (wordish (char-after (1+ me)))) 294 (and (eq (char-before mb) ?-) (wordish (char-before (1- mb))))))) 295 296 (defun zetta-hywiki-alias--highlight-region (start end) 297 "Highlight derived HyWikiWord aliases between START and END." 298 (zetta-hywiki-alias--ensure) 299 (when zetta-hywiki-alias--regexp 300 (remove-overlays start end 'zetta-hywiki-alias-p t) 301 (save-excursion 302 (goto-char start) 303 (let ((case-fold-search t)) 304 (while (re-search-forward zetta-hywiki-alias--regexp end t) 305 (let* ((mb (match-beginning 0)) 306 (me (match-end 0)) 307 (text (match-string-no-properties 0)) 308 (key (downcase (replace-regexp-in-string "[ \t-]+" "" text))) 309 (cands (gethash key zetta-hywiki-alias--index)) 310 (canon (car cands)) 311 (link-color (zetta-hywiki-alias--link-color-at mb)) 312 (hy-ov (zetta-hywiki-alias--hywiki-face-at mb)) 313 ;; Does a HyWiki overlay already span our whole match? If so it 314 ;; owns the exact WikiWord and we defer. If it covers only a 315 ;; sub-part -- e.g. `Emacs' inside a longer `Emacs Completion' 316 ;; whose joined form is the page `EmacsCompletion' -- we take 317 ;; over so the longest (composite) WikiWord wins as one unit. 318 (hy-covers-all (and hy-ov (>= (overlay-end hy-ov) me)))) 319 (when (and canon 320 ;; Not merely part of a larger hyphenated token: catch 321 ;; `emacs-completion' (EmacsCompletion) but not `emacs' 322 ;; inside `emacs-foobar'. 323 (not (zetta-hywiki-alias--hyphen-bounded-p mb me)) 324 ;; Defer only to a HyWiki overlay that already covers the 325 ;; whole match; on a link we still layer on for the cue. 326 ;; Elsewhere -- HyWiki idle (eww), a spot it skipped, or a 327 ;; composite it split -- we highlight the match ourselves. 328 (or link-color (not hy-covers-all))) 329 ;; Composite override: drop any HyWiki sub-part overlays inside our 330 ;; span so the composite shows and activates as a single WikiWord. 331 (unless hy-covers-all 332 (dolist (o (overlays-in mb me)) 333 (when (eq (overlay-get o 'face) hywiki-word-face) 334 (delete-overlay o)))) 335 (let ((ov (make-overlay mb me))) 336 (overlay-put ov 'zetta-hywiki-alias canon) 337 (overlay-put ov 'zetta-hywiki-alias-candidates cands) 338 (overlay-put ov 'zetta-hywiki-alias-p t) 339 ;; A DISTINCT (anonymous) face -- looks identical to 340 ;; `hywiki-word-face' but is not `eq' to it, so HyWiki's own 341 ;; per-command dehighlight (which clears overlays *by* that face 342 ;; value) does not sweep our alias overlays away. On a link, add 343 ;; the link's own colour as the underline and sit above HyWiki's 344 ;; overlay, so the word reads as both a WikiWord (orange text) 345 ;; and a clickable link (coloured underline). 346 (overlay-put ov 'face 347 (if link-color 348 (list :inherit hywiki-word-face :underline link-color) 349 (list :inherit hywiki-word-face))) 350 (when link-color (overlay-put ov 'priority 100)) 351 (overlay-put ov 'evaporate t) 352 (overlay-put ov 'help-echo 353 (cond 354 ((cdr cands) 355 (format "HyWiki alias -> %s (choose on activation)" 356 (mapconcat #'identity cands " | "))) 357 ((string= text canon) 358 (format "HyWikiWord: %s" canon)) 359 (t 360 (format "HyWiki alias -> %s" canon)))))))))))) 361 362 (defun zetta-hywiki-alias--refresh-region (start end) 363 "Re-highlight derived aliases between START and END, expanded to whole lines." 364 (zetta-hywiki-alias--highlight-region 365 (save-excursion (goto-char start) (line-beginning-position)) 366 (save-excursion (goto-char (min end (point-max))) (line-end-position)))) 367 368 (defvar-local zetta-hywiki-alias--last nil 369 "Cache key (tick window-start window-end) of the last visible-region refresh. 370 Skips redundant rescans so `post-command-hook' stays cheap and flicker-free.") 371 372 (defun zetta-hywiki-alias--post-command () 373 "Refresh alias highlighting in the selected window's visible region. 374 Driven off `post-command-hook' so highlights appear promptly and survive 375 HyWiki's own per-command dehighlight passes. Only rescans when the buffer 376 was modified or the window scrolled since the last refresh." 377 (when (and (bound-and-true-p zetta-hywiki-alias-mode) 378 (fboundp 'hywiki-active-in-current-buffer-p) 379 (hywiki-active-in-current-buffer-p)) 380 (let* ((win (selected-window)) 381 (ws (window-start win)) 382 (we (window-end win t)) 383 (key (list zetta-hywiki-alias--generation 384 (buffer-chars-modified-tick) ws we))) 385 (unless (equal key zetta-hywiki-alias--last) 386 (setq zetta-hywiki-alias--last key) 387 (zetta-hywiki-alias--refresh-region ws we))))) 388 389 (defun zetta-hywiki-alias--refresh-window (win) 390 "Re-highlight derived aliases in WIN's visible region. 391 Highlights WIN by its own bounds rather than via the selected window, so a 392 visible but unselected window -- e.g. the buffer you were editing after focus 393 moved to a freshly created page -- is refreshed too." 394 (with-current-buffer (window-buffer win) 395 (when (and (fboundp 'hywiki-active-in-current-buffer-p) 396 (hywiki-active-in-current-buffer-p)) 397 (let ((ws (window-start win)) 398 (we (window-end win t))) 399 ;; Record the guard key so the buffer's own next `post-command' pass 400 ;; skips a redundant (flicker-inducing) rescan when it regains focus. 401 (setq zetta-hywiki-alias--last 402 (list zetta-hywiki-alias--generation 403 (buffer-chars-modified-tick) ws we)) 404 (zetta-hywiki-alias--refresh-region ws we))))) 405 406 (defun zetta-hywiki-alias--refresh-windows () 407 "Force an alias refresh in every visible window on every frame. 408 Used on mode enable and whenever the alias set changes." 409 (walk-windows #'zetta-hywiki-alias--refresh-window nil t)) 410 411 (defun zetta-hywiki-alias--word-at-advice (orig &optional range-flag hash-sign-only-flag) 412 "Make `hywiki-word-at' recognise a derived alias at point. 413 When point is on an alias overlay, return its canonical WikiWord -- as a 414 \(WORD START END) list when RANGE-FLAG is set; otherwise defer to ORIG." 415 (let ((canon (and (bound-and-true-p zetta-hywiki-alias-mode) 416 (get-char-property (point) 'zetta-hywiki-alias)))) 417 (if canon 418 (if range-flag 419 (let ((ov (seq-find (lambda (o) (overlay-get o 'zetta-hywiki-alias)) 420 (overlays-at (point))))) 421 (list canon (and ov (overlay-start ov)) (and ov (overlay-end ov)))) 422 canon) 423 (funcall orig range-flag hash-sign-only-flag)))) 424 425 (defun zetta-hywiki-alias--find-referent-advice (orig &optional wikiword prompt-flag) 426 "Disambiguate when the alias at point maps to several HyWiki pages. 427 `hywiki-find-referent' is the single navigation chokepoint every activation 428 path funnels through -- both the `hywiki-word' and `hywiki-existing-word' 429 implicit buttons and the Org `hy:' link -- and unlike `hywiki-word-at' it is 430 not called during highlighting, range detection or idle passes, so it is the 431 one safe place to prompt. 432 433 When point sits on an alias overlay whose candidate list holds more than one 434 canonical WikiWord -- e.g. `programmer' declared by both CharlieHolland and 435 CharlieBaker -- and ORIG is about to visit the silently chosen representative 436 \(WIKIWORD), ask which page to open and route ORIG there instead. Every 437 other call -- a real WikiWord, a single-candidate alias, or an unrelated 438 navigation while point happens to rest on an alias -- passes straight 439 through, guarded by matching WIKIWORD against the overlay's representative." 440 (let* ((ov (and (bound-and-true-p zetta-hywiki-alias-mode) 441 (stringp wikiword) 442 (seq-find (lambda (o) (overlay-get o 'zetta-hywiki-alias-candidates)) 443 (overlays-at (point))))) 444 (cands (and ov (overlay-get ov 'zetta-hywiki-alias-candidates)))) 445 (if (and cands (cdr cands) 446 (fboundp 'hywiki-word-strip-suffix) 447 (equal (hywiki-word-strip-suffix wikiword) 448 (overlay-get ov 'zetta-hywiki-alias))) 449 (let ((choice (completing-read 450 (format "Alias \"%s\" -> HyWikiWord: " 451 (buffer-substring-no-properties 452 (overlay-start ov) (overlay-end ov))) 453 cands nil t nil nil (car cands)))) 454 (funcall orig choice prompt-flag)) 455 (funcall orig wikiword prompt-flag)))) 456 457 (defun zetta-hywiki-alias--refresh-on-save () 458 "Rebuild aliases and re-highlight after saving a HyWiki page file. 459 On `after-save-hook' so edits to a page's `Aliases' section (or a new page 460 saved to disk) take effect at once, without a manual refresh." 461 (when (and (bound-and-true-p zetta-hywiki-alias-mode) 462 (zetta-hywiki-alias--hywiki-page-file-p buffer-file-name)) 463 (zetta-hywiki-alias--invalidate))) 464 465 (defun zetta-hywiki-alias--rehighlight-hywiki () 466 "Re-run HyWiki's own WikiWord highlighting in every visible window. 467 Called on disable so toggling the mode off is a clean A/B against HyWiki's 468 native behaviour -- restoring its view even where we had replaced its overlays 469 \(e.g. composites in eww, which HyWiki never re-scans on its own)." 470 (when (fboundp 'hywiki-maybe-highlight-references) 471 (walk-windows 472 (lambda (win) 473 (with-current-buffer (window-buffer win) 474 (when (and (fboundp 'hywiki-active-in-current-buffer-p) 475 (hywiki-active-in-current-buffer-p)) 476 (ignore-errors (hywiki-maybe-highlight-references))))) 477 nil t))) 478 479 ;;; ------------------------------------------------------------------------ 480 ;;; Creating a HyWikiWord from arbitrary text (the inverse of aliasing) 481 ;;; ------------------------------------------------------------------------ 482 483 (defun zetta-hywiki-alias-to-wikiword (text) 484 "Convert TEXT into a PascalCase HyWikiWord string, or nil if impossible. 485 This is the inverse of the aliasing this mode performs: it collapses any of 486 the manifestations the aliases would match back into one canonical WikiWord. 487 488 Every run of non-alphabetic characters -- spaces, tabs, newlines, hyphens, 489 underscores, digits, punctuation -- separates words, and existing CamelCase 490 inside a run of letters is split too (reusing `zetta-hywiki-alias--segments', 491 the very splitter the aliases are built from). So `text embedding', 492 `text-embedding', `text_embedding', `TEXT EMBEDDING' and `textEmbedding' all 493 yield `TextEmbedding'. Each segment is then capitalized -- first letter 494 upper, rest lower -- so acronyms are title-cased (`HTML parser' -> 495 `HtmlParser'); that still round-trips because the aliases match 496 case-insensitively. 497 498 Returns nil when TEXT has no letters, or yields only a single letter, since a 499 HyWikiWord must be an uppercase-initial, all-alphabetic word of at least two 500 characters. Digits cannot appear in a HyWikiWord, so they act purely as 501 separators (`gpt 4 turbo' -> `GptTurbo')." 502 (when (stringp text) 503 (let* ((words (split-string text "[^[:alpha:]]+" t)) 504 (segs (mapcan #'zetta-hywiki-alias--segments words)) 505 (word (mapconcat 506 (lambda (w) (concat (upcase (substring w 0 1)) 507 (downcase (substring w 1)))) 508 segs ""))) 509 (and (string-match-p "\\`[[:upper:]][[:alpha:]]+\\'" word) word)))) 510 511 ;;;###autoload 512 (defun zetta-hywiki-alias-wikify (beg end &optional stay) 513 "Create a HyWikiWord page from the region BEG..END, display it, keep the text. 514 Interactively, act on the active region; with none, use the symbol at point. 515 The text is converted to a PascalCase WikiWord via 516 `zetta-hywiki-alias-to-wikiword', its page is created and shown, but the prose 517 is left UNCHANGED: this mode immediately highlights it as an alias of the new 518 page, so `text embedding' lights up and activates in place -- without being 519 rewritten to the literal `TextEmbedding'. 520 521 With a prefix arg STAY, create the page without leaving the current buffer. 522 Signals a `user-error' if the text cannot form a valid WikiWord or if HyWiki 523 is unavailable. Returns the WikiWord." 524 (interactive 525 (append (cond ((use-region-p) (list (region-beginning) (region-end))) 526 ((bounds-of-thing-at-point 'symbol) 527 (let ((b (bounds-of-thing-at-point 'symbol))) 528 (list (car b) (cdr b)))) 529 (t (user-error "No region or symbol at point to wikify"))) 530 (list current-prefix-arg))) 531 (unless (require 'hywiki nil t) 532 (user-error "Load GNU Hyperbole/HyWiki before using %s" 533 'zetta-hywiki-alias-wikify)) 534 (let* ((text (buffer-substring-no-properties beg end)) 535 (word (zetta-hywiki-alias-to-wikiword text)) 536 (src (current-buffer))) 537 (unless word 538 (user-error "Cannot form a HyWikiWord from %S" text)) 539 ;; Create the page -- and by default open it -- but leave the prose alone. 540 (if stay 541 (hywiki-add-page word) 542 (hywiki-word-create-and-display word)) 543 ;; Make the new page's aliases live and light up the source phrase now. 544 ;; `hywiki-add-page' invalidates the alias set via advice, but 545 ;; `hywiki-word-create-and-display' can reach the page by another route, so 546 ;; invalidate explicitly -- rebuilding the index to include the new page -- 547 ;; then re-highlight the source region, which may no longer be in a visible 548 ;; window now that the page is displayed (so the generic refresh misses it). 549 (when (bound-and-true-p zetta-hywiki-alias-mode) 550 (zetta-hywiki-alias--invalidate) 551 (when (buffer-live-p src) 552 (with-current-buffer src 553 (when (and (fboundp 'hywiki-active-in-current-buffer-p) 554 (hywiki-active-in-current-buffer-p)) 555 (zetta-hywiki-alias--refresh-region beg end))))) 556 (when (called-interactively-p 'interactive) 557 (message "HyWikiWord %s: page created%s, source text left in place" 558 word (if stay "" " and opened"))) 559 word)) 560 561 ;;;###autoload 562 (define-minor-mode zetta-hywiki-alias-mode 563 "Global mode: highlight and activate case/space/hyphen variants of HyWikiWords. 564 Aliases are derived from your existing HyWiki pages, plus any listed in a page's 565 `Aliases' section; see hywiki-alias.README.md for details. 566 567 This is the toggle between this module and HyWiki's native behaviour: turn it on 568 \(\\[zetta-hywiki-alias-mode]) for aliasing and composite handling, or off to 569 fall back to plain HyWiki -- disabling restores HyWiki's own highlighting in the 570 visible buffers." 571 :global t 572 :group 'zetta-hywiki-alias 573 (if zetta-hywiki-alias-mode 574 (if (not (require 'hywiki nil t)) 575 (progn 576 (setq zetta-hywiki-alias-mode nil) 577 (user-error "Load GNU Hyperbole/HyWiki before enabling %s" 578 'zetta-hywiki-alias-mode)) 579 (zetta-hywiki-alias--rebuild) 580 (advice-add 'hywiki-word-at :around #'zetta-hywiki-alias--word-at-advice) 581 (advice-add 'hywiki-find-referent :around 582 #'zetta-hywiki-alias--find-referent-advice) 583 (advice-add 'hywiki-add-referent :after #'zetta-hywiki-alias--invalidate) 584 (advice-add 'hywiki-add-page :after #'zetta-hywiki-alias--invalidate) 585 (add-hook 'post-command-hook #'zetta-hywiki-alias--post-command) 586 (add-hook 'after-save-hook #'zetta-hywiki-alias--refresh-on-save) 587 (zetta-hywiki-alias--refresh-windows)) 588 (remove-hook 'post-command-hook #'zetta-hywiki-alias--post-command) 589 (remove-hook 'after-save-hook #'zetta-hywiki-alias--refresh-on-save) 590 (advice-remove 'hywiki-word-at #'zetta-hywiki-alias--word-at-advice) 591 (advice-remove 'hywiki-find-referent #'zetta-hywiki-alias--find-referent-advice) 592 (advice-remove 'hywiki-add-referent #'zetta-hywiki-alias--invalidate) 593 (advice-remove 'hywiki-add-page #'zetta-hywiki-alias--invalidate) 594 (dolist (buf (buffer-list)) 595 (with-current-buffer buf 596 (remove-overlays (point-min) (point-max) 'zetta-hywiki-alias-p t))) 597 (zetta-hywiki-alias--invalidate) 598 ;; Restore HyWiki's native highlighting in visible buffers so toggling off 599 ;; is a clean A/B against HyWiki's own behaviour. 600 (zetta-hywiki-alias--rehighlight-hywiki))) 601 602 ;; Enable automatically once HyWiki is available. This file loads at startup, 603 ;; before Hyperbole's deferred load, so the mode turns on as soon as HyWiki 604 ;; provides. Toggle it off any time with `M-x zetta-hywiki-alias-mode'. 605 ;;(with-eval-after-load 'hywiki 606 ;;(zetta-hywiki-alias-mode 1)) 607 608 (provide 'hywiki-alias) 609 ;;; hywiki-alias.el ends here