org-wikinodes.el 12 KB

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