org-wikinodes.el (11827B)
1 ;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes 2 3 ;; Copyright (C) 2010-2021 Free Software Foundation, Inc. 4 5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 6 ;; Keywords: outlines, hypermedia, calendar, wp 7 ;; Homepage: https://git.sr.ht/~bzg/org-contrib 8 ;; Version: 7.01trans 9 ;; 10 ;; This file is not part of GNU Emacs. 11 ;; 12 ;; This program is free software: you can redistribute it and/or modify 13 ;; it under the terms of the GNU General Public License as published by 14 ;; the Free Software Foundation, either version 3 of the License, or 15 ;; (at your option) any later version. 16 17 ;; This program is distributed in the hope that it will be useful, 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; GNU General Public License for more details. 21 22 ;; You should have received a copy of the GNU General Public License 23 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 24 25 (require 'org) 26 (eval-when-compile 27 (require 'cl)) 28 29 (defgroup org-wikinodes nil 30 "Wiki-like CamelCase links words to outline nodes in Org mode." 31 :tag "Org WikiNodes" 32 :group 'org) 33 34 (defconst org-wikinodes-camel-regexp "\\<[A-Z]+[a-z]+[A-Z]+[a-z]+[a-zA-Z]*\\>" 35 "Regular expression matching CamelCase words.") 36 37 (defcustom org-wikinodes-active t 38 "Should CamelCase links be active in the current file?" 39 :group 'org-wikinodes 40 :type 'boolean) 41 (put 'org-wikinodes-active 'safe-local-variable 'booleanp) 42 43 (defcustom org-wikinodes-scope 'file 44 "The scope of searches for wiki targets. 45 Allowed values are: 46 47 file Search for targets in the current file only 48 directory Search for targets in all org files in the current directory" 49 :group 'org-wikinodes 50 :type '(choice 51 (const :tag "Find targets in current file" file) 52 (const :tag "Find targets in current directory" directory))) 53 54 (defcustom org-wikinodes-create-targets 'query 55 "Non-nil means create Wiki target when following a wiki link fails. 56 Allowed values are: 57 58 nil never create node, just throw an error if the target does not exist 59 query ask the user what to do 60 t create the node in the current buffer 61 \"file.org\" create the node in the file \"file.org\", in the same directory 62 63 If you are using wiki links across files, you need to set `org-wikinodes-scope' 64 to `directory'." 65 :group 'org-wikinodes 66 :type '(choice 67 (const :tag "Never automatically create node" nil) 68 (const :tag "In current file" t) 69 (file :tag "In one special file\n") 70 (const :tag "Query the user" query))) 71 72 ;;; Link activation 73 74 (defun org-wikinodes-activate-links (limit) 75 "Activate CamelCase words as links to Wiki targets." 76 (when org-wikinodes-active 77 (let (case-fold-search) 78 (if (re-search-forward org-wikinodes-camel-regexp limit t) 79 (if (equal (char-after (point-at-bol)) ?*) 80 (progn 81 ;; in heading - deactivate flyspell 82 (org-remove-flyspell-overlays-in (match-beginning 0) 83 (match-end 0)) 84 t) 85 ;; this is a wiki link 86 (org-remove-flyspell-overlays-in (match-beginning 0) 87 (match-end 0)) 88 (add-text-properties (match-beginning 0) (match-end 0) 89 (list 'mouse-face 'highlight 90 'face 'org-link 91 'keymap org-mouse-map 92 'help-echo "Wiki Link")) 93 t))))) 94 95 ;;; Following links and creating non-existing target nodes 96 97 (defun org-wikinodes-open-at-point () 98 "Check if the cursor is on a Wiki link and follow the link. 99 100 This function goes into `org-open-at-point-functions'." 101 (and org-wikinodes-active 102 (not (org-at-heading-p)) 103 (let (case-fold-search) (org-in-regexp org-wikinodes-camel-regexp)) 104 (progn (org-wikinodes-follow-link (match-string 0)) t))) 105 106 (defun org-wikinodes-follow-link (target) 107 "Follow a wiki link to TARGET. 108 109 This need to be found as an exact headline match, either in the current 110 buffer, or in any .org file in the current directory, depending on the 111 variable `org-wikinodes-scope'. 112 113 If a target headline is not found, it may be created according to the 114 setting of `org-wikinodes-create-targets'." 115 (if current-prefix-arg (org-wikinodes-clear-directory-targets-cache)) 116 (let ((create org-wikinodes-create-targets) 117 visiting buffer m pos file rpl) 118 (setq pos 119 (or (org-find-exact-headline-in-buffer target (current-buffer)) 120 (and (eq org-wikinodes-scope 'directory) 121 (setq file (org-wikinodes-which-file 122 target (file-name-directory (buffer-file-name)))) 123 (org-find-exact-headline-in-buffer 124 target (or (get-file-buffer file) 125 (find-file-noselect file)))))) 126 (if pos 127 (progn 128 (org-mark-ring-push (point)) 129 (org-goto-marker-or-bmk pos) 130 (move-marker pos nil)) 131 (when (eq create 'query) 132 (if (eq org-wikinodes-scope 'directory) 133 (progn 134 (message "Node \"%s\" does not exist. Should it be created? 135 \[RET] in this buffer [TAB] in another file [q]uit" target) 136 (setq rpl (read-char-exclusive)) 137 (cond 138 ((member rpl '(?\C-g ?q)) (error "Abort")) 139 ((equal rpl ?\C-m) (setq create t)) 140 ((equal rpl ?\C-i) 141 (setq create (file-name-nondirectory 142 (read-file-name "Create in file: ")))) 143 (t (error "Invalid selection")))) 144 (if (y-or-n-p (format "Create new node \"%s\" in current buffer? " 145 target)) 146 (setq create t) 147 (error "Abort")))) 148 149 (cond 150 ((not create) 151 ;; We are not allowed to create the new node 152 (error "No match for link to \"%s\"" target)) 153 ((stringp create) 154 ;; Make new node in another file 155 (org-mark-ring-push (point)) 156 (org-pop-to-buffer-same-window (find-file-noselect create)) 157 (goto-char (point-max)) 158 (or (bolp) (newline)) 159 (insert "\n* " target "\n") 160 (backward-char 1) 161 (org-wikinodes-add-target-to-cache target) 162 (message "New Wiki target `%s' created in file \"%s\"" 163 target create)) 164 (t 165 ;; Make new node in current buffer 166 (org-mark-ring-push (point)) 167 (goto-char (point-max)) 168 (or (bolp) (newline)) 169 (insert "* " target "\n") 170 (backward-char 1) 171 (org-wikinodes-add-target-to-cache target) 172 (message "New Wiki target `%s' created in current buffer" 173 target)))))) 174 175 ;;; The target cache 176 177 (defvar org-wikinodes-directory-targets-cache nil) 178 179 (defun org-wikinodes-clear-cache-when-on-target () 180 "When on a headline that is a Wiki target, clear the cache." 181 (when (and (org-at-heading-p) 182 (org-in-regexp (format org-complex-heading-regexp-format 183 org-wikinodes-camel-regexp)) 184 (org-in-regexp org-wikinodes-camel-regexp)) 185 (org-wikinodes-clear-directory-targets-cache) 186 t)) 187 188 (defun org-wikinodes-clear-directory-targets-cache () 189 "Clear the cache where to find wiki targets." 190 (interactive) 191 (setq org-wikinodes-directory-targets-cache nil) 192 (message "Wiki target cache cleared, so that it will update when used again")) 193 194 (defun org-wikinodes-get-targets () 195 "Return a list of all wiki targets in the current buffer." 196 (let ((re (format org-complex-heading-regexp-format 197 org-wikinodes-camel-regexp)) 198 (case-fold-search nil) 199 targets) 200 (save-excursion 201 (save-restriction 202 (widen) 203 (goto-char (point-min)) 204 (while (re-search-forward re nil t) 205 (push (match-string-no-properties 4) targets)))) 206 (nreverse targets))) 207 208 (defun org-wikinodes-get-links-for-directory (dir) 209 "Return an alist that connects wiki links to files in directory DIR." 210 (let ((files (directory-files dir nil "\\`[^.#].*\\.org\\'")) 211 (org-inhibit-startup t) 212 target-file-alist file visiting m buffer) 213 (while (setq file (pop files)) 214 (setq visiting (org-find-base-buffer-visiting file)) 215 (setq buffer (or visiting (find-file-noselect file))) 216 (with-current-buffer buffer 217 (mapc 218 (lambda (target) 219 (setq target-file-alist (cons (cons target file) target-file-alist))) 220 (org-wikinodes-get-targets))) 221 (or visiting (kill-buffer buffer))) 222 target-file-alist)) 223 224 (defun org-wikinodes-add-target-to-cache (target &optional file) 225 (setq file (or file buffer-file-name (error "No file for new wiki target"))) 226 (set-text-properties 0 (length target) nil target) 227 (let ((dir (file-name-directory (expand-file-name file))) 228 a) 229 (setq a (assoc dir org-wikinodes-directory-targets-cache)) 230 (if a 231 ;; Push the new target onto the existing list 232 (push (cons target (expand-file-name file)) (cdr a)) 233 ;; Call org-wikinodes-which-file so that the cache will be filled 234 (org-wikinodes-which-file target dir)))) 235 236 (defun org-wikinodes-which-file (target &optional directory) 237 "Return the file for wiki headline TARGET DIRECTORY. 238 If there is no such wiki target, return nil." 239 (let* ((directory (expand-file-name (or directory default-directory))) 240 (founddir (assoc directory org-wikinodes-directory-targets-cache)) 241 (foundfile (cdr (assoc target (cdr founddir))))) 242 (or foundfile 243 (and (push (cons directory (org-wikinodes-get-links-for-directory directory)) 244 org-wikinodes-directory-targets-cache) 245 (cdr (assoc target (cdr (assoc directory 246 org-wikinodes-directory-targets-cache)))))))) 247 248 ;;; Exporting Wiki links 249 250 (defvar target) 251 (defvar target-alist) 252 (defvar last-section-target) 253 (defvar org-export-target-aliases) 254 (defun org-wikinodes-set-wiki-targets-during-export (_) 255 (let ((line (buffer-substring (point-at-bol) (point-at-eol))) 256 (case-fold-search nil) 257 wtarget a) 258 (when (string-match (format org-complex-heading-regexp-format 259 org-wikinodes-camel-regexp) 260 line) 261 (setq wtarget (match-string 4 line)) 262 (push (cons wtarget target) target-alist) 263 (setq a (or (assoc last-section-target org-export-target-aliases) 264 (progn 265 (push (list last-section-target) 266 org-export-target-aliases) 267 (car org-export-target-aliases)))) 268 (push (caar target-alist) (cdr a))))) 269 270 (defun org-wikinodes-process-links-for-export (_) 271 "Process Wiki links in the export preprocess buffer. 272 Try to find target matches in the wiki scope and replace CamelCase words 273 with working links." 274 (let ((re org-wikinodes-camel-regexp) 275 (case-fold-search nil) 276 link file) 277 (goto-char (point-min)) 278 (while (re-search-forward re nil t) 279 (unless (save-match-data 280 (or (org-at-heading-p) 281 (org-in-regexp org-bracket-link-regexp) 282 (org-in-regexp org-plain-link-re) 283 (org-in-regexp "<<[^<>]+>>"))) 284 (setq link (match-string 0)) 285 (delete-region (match-beginning 0) (match-end 0)) 286 (save-match-data 287 (cond 288 ((org-find-exact-headline-in-buffer link (current-buffer)) 289 ;; Found in current buffer 290 (insert (format "[[*%s][%s]]" link link))) 291 ((eq org-wikinodes-scope 'file) 292 ;; No match in file, and other files are not allowed 293 (insert (format "%s" link))) 294 (t ;; No match for this link 295 (insert (format "%s" link))))))))) 296 297 ;;; Hook the WikiNode mechanism into Org 298 299 ;; `C-c C-o' should follow wiki links 300 (add-hook 'org-open-at-point-functions 'org-wikinodes-open-at-point) 301 302 ;; `C-c C-c' should clear the cache 303 (add-hook 'org-ctrl-c-ctrl-c-hook 'org-wikinodes-clear-cache-when-on-target) 304 305 ;; Make Wiki haeding create additional link names for headlines 306 (add-hook 'org-export-before-parsing-hook 307 'org-wikinodes-set-wiki-targets-during-export) 308 309 ;; Turn Wiki links into links the exporter will treat correctly 310 (add-hook 'org-export-before-parsing-hook 311 'org-wikinodes-process-links-for-export) 312 313 ;; Activate CamelCase words as part of Org mode font lock 314 315 (defun org-wikinodes-add-to-font-lock-keywords () 316 "Add wikinode CamelCase highlighting to `org-font-lock-extra-keywords'." 317 (let ((m (member '(org-activate-links) org-font-lock-extra-keywords))) 318 (if m (push '(org-wikinodes-activate-links) (cdr m)) 319 (message "Failed to add wikinodes to `org-font-lock-extra-keywords'.")))) 320 321 (add-hook 'org-font-lock-set-keywords-hook 322 'org-wikinodes-add-to-font-lock-keywords) 323 324 (provide 'org-wikinodes) 325 326 ;;; org-wikinodes.el ends here