summaryrefslogtreecommitdiff
path: root/contrib/lisp/org-wikinodes.el
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/lisp/org-wikinodes.el')
-rw-r--r--contrib/lisp/org-wikinodes.el340
1 files changed, 340 insertions, 0 deletions
diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el
new file mode 100644
index 0000000..bdc3e34
--- /dev/null
+++ b/contrib/lisp/org-wikinodes.el
@@ -0,0 +1,340 @@
+;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 7.01trans
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require 'org)
+(eval-when-compile
+ (require 'cl))
+
+(defgroup org-wikinodes nil
+ "Wiki-like CamelCase links words to outline nodes in Org mode."
+ :tag "Org WikiNodes"
+ :group 'org)
+
+(defconst org-wikinodes-camel-regexp "\\<[A-Z]+[a-z]+[A-Z]+[a-z]+[a-zA-Z]*\\>"
+ "Regular expression matching CamelCase words.")
+
+(defcustom org-wikinodes-active t
+ "Should CamelCase links be active in the current file?"
+ :group 'org-wikinodes
+ :type 'boolean)
+(put 'org-wikinodes-active 'safe-local-variable 'booleanp)
+
+(defcustom org-wikinodes-scope 'file
+ "The scope of searches for wiki targets.
+Allowed values are:
+
+file Search for targets in the current file only
+directory Search for targets in all org files in the current directory"
+ :group 'org-wikinodes
+ :type '(choice
+ (const :tag "Find targets in current file" file)
+ (const :tag "Find targets in current directory" directory)))
+
+(defcustom org-wikinodes-create-targets 'query
+ "Non-nil means create Wiki target when following a wiki link fails.
+Allowed values are:
+
+nil never create node, just throw an error if the target does not exist
+query ask the user what to do
+t create the node in the current buffer
+\"file.org\" create the node in the file \"file.org\", in the same directory
+
+If you are using wiki links across files, you need to set `org-wikinodes-scope'
+to `directory'."
+ :group 'org-wikinodes
+ :type '(choice
+ (const :tag "Never automatically create node" nil)
+ (const :tag "In current file" t)
+ (file :tag "In one special file\n")
+ (const :tag "Query the user" query)))
+
+;;; Link activation
+
+(defun org-wikinodes-activate-links (limit)
+ "Activate CamelCase words as links to Wiki targets."
+ (when org-wikinodes-active
+ (let (case-fold-search)
+ (if (re-search-forward org-wikinodes-camel-regexp limit t)
+ (if (equal (char-after (point-at-bol)) ?*)
+ (progn
+ ;; in heading - deactivate flyspell
+ (org-remove-flyspell-overlays-in (match-beginning 0)
+ (match-end 0))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(org-no-flyspell t))
+ t)
+ ;; this is a wiki link
+ (org-remove-flyspell-overlays-in (match-beginning 0)
+ (match-end 0))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'mouse-face 'highlight
+ 'face 'org-link
+ 'keymap org-mouse-map
+ 'help-echo "Wiki Link"))
+ t)))))
+
+;;; Following links and creating non-existing target nodes
+
+(defun org-wikinodes-open-at-point ()
+ "Check if the cursor is on a Wiki link and follow the link.
+
+This function goes into `org-open-at-point-functions'."
+ (and org-wikinodes-active
+ (not (org-at-heading-p))
+ (let (case-fold-search) (org-in-regexp org-wikinodes-camel-regexp))
+ (progn (org-wikinodes-follow-link (match-string 0)) t)))
+
+(defun org-wikinodes-follow-link (target)
+ "Follow a wiki link to TARGET.
+
+This need to be found as an exact headline match, either in the current
+buffer, or in any .org file in the current directory, depending on the
+variable `org-wikinodes-scope'.
+
+If a target headline is not found, it may be created according to the
+setting of `org-wikinodes-create-targets'."
+ (if current-prefix-arg (org-wikinodes-clear-directory-targets-cache))
+ (let ((create org-wikinodes-create-targets)
+ visiting buffer m pos file rpl)
+ (setq pos
+ (or (org-find-exact-headline-in-buffer target (current-buffer))
+ (and (eq org-wikinodes-scope 'directory)
+ (setq file (org-wikinodes-which-file
+ target (file-name-directory (buffer-file-name))))
+ (org-find-exact-headline-in-buffer
+ target (or (get-file-buffer file)
+ (find-file-noselect file))))))
+ (if pos
+ (progn
+ (org-mark-ring-push (point))
+ (org-goto-marker-or-bmk pos)
+ (move-marker pos nil))
+ (when (eq create 'query)
+ (if (eq org-wikinodes-scope 'directory)
+ (progn
+ (message "Node \"%s\" does not exist. Should it be created?
+\[RET] in this buffer [TAB] in another file [q]uit" target)
+ (setq rpl (read-char-exclusive))
+ (cond
+ ((member rpl '(?\C-g ?q)) (error "Abort"))
+ ((equal rpl ?\C-m) (setq create t))
+ ((equal rpl ?\C-i)
+ (setq create (file-name-nondirectory
+ (read-file-name "Create in file: "))))
+ (t (error "Invalid selection"))))
+ (if (y-or-n-p (format "Create new node \"%s\" in current buffer? "
+ target))
+ (setq create t)
+ (error "Abort"))))
+
+ (cond
+ ((not create)
+ ;; We are not allowed to create the new node
+ (error "No match for link to \"%s\"" target))
+ ((stringp create)
+ ;; Make new node in another file
+ (org-mark-ring-push (point))
+ (org-pop-to-buffer-same-window (find-file-noselect create))
+ (goto-char (point-max))
+ (or (bolp) (newline))
+ (insert "\n* " target "\n")
+ (backward-char 1)
+ (org-wikinodes-add-target-to-cache target)
+ (message "New Wiki target `%s' created in file \"%s\""
+ target create))
+ (t
+ ;; Make new node in current buffer
+ (org-mark-ring-push (point))
+ (goto-char (point-max))
+ (or (bolp) (newline))
+ (insert "* " target "\n")
+ (backward-char 1)
+ (org-wikinodes-add-target-to-cache target)
+ (message "New Wiki target `%s' created in current buffer"
+ target))))))
+
+;;; The target cache
+
+(defvar org-wikinodes-directory-targets-cache nil)
+
+(defun org-wikinodes-clear-cache-when-on-target ()
+ "When on a headline that is a Wiki target, clear the cache."
+ (when (and (org-at-heading-p)
+ (org-in-regexp (format org-complex-heading-regexp-format
+ org-wikinodes-camel-regexp))
+ (org-in-regexp org-wikinodes-camel-regexp))
+ (org-wikinodes-clear-directory-targets-cache)
+ t))
+
+(defun org-wikinodes-clear-directory-targets-cache ()
+ "Clear the cache where to find wiki targets."
+ (interactive)
+ (setq org-wikinodes-directory-targets-cache nil)
+ (message "Wiki target cache cleared, so that it will update when used again"))
+
+(defun org-wikinodes-get-targets ()
+ "Return a list of all wiki targets in the current buffer."
+ (let ((re (format org-complex-heading-regexp-format
+ org-wikinodes-camel-regexp))
+ (case-fold-search nil)
+ targets)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (push (org-match-string-no-properties 4) targets))))
+ (nreverse targets)))
+
+(defun org-wikinodes-get-links-for-directory (dir)
+ "Return an alist that connects wiki links to files in directory DIR."
+ (let ((files (directory-files dir nil "\\`[^.#].*\\.org\\'"))
+ (org-inhibit-startup t)
+ target-file-alist file visiting m buffer)
+ (while (setq file (pop files))
+ (setq visiting (org-find-base-buffer-visiting file))
+ (setq buffer (or visiting (find-file-noselect file)))
+ (with-current-buffer buffer
+ (mapc
+ (lambda (target)
+ (setq target-file-alist (cons (cons target file) target-file-alist)))
+ (org-wikinodes-get-targets)))
+ (or visiting (kill-buffer buffer)))
+ target-file-alist))
+
+(defun org-wikinodes-add-target-to-cache (target &optional file)
+ (setq file (or file buffer-file-name (error "No file for new wiki target")))
+ (set-text-properties 0 (length target) nil target)
+ (let ((dir (file-name-directory (expand-file-name file)))
+ a)
+ (setq a (assoc dir org-wikinodes-directory-targets-cache))
+ (if a
+ ;; Push the new target onto the existing list
+ (push (cons target (expand-file-name file)) (cdr a))
+ ;; Call org-wikinodes-which-file so that the cache will be filled
+ (org-wikinodes-which-file target dir))))
+
+(defun org-wikinodes-which-file (target &optional directory)
+ "Return the file for wiki headline TARGET DIRECTORY.
+If there is no such wiki target, return nil."
+ (let* ((directory (expand-file-name (or directory default-directory)))
+ (founddir (assoc directory org-wikinodes-directory-targets-cache))
+ (foundfile (cdr (assoc target (cdr founddir)))))
+ (or foundfile
+ (and (push (cons directory (org-wikinodes-get-links-for-directory directory))
+ org-wikinodes-directory-targets-cache)
+ (cdr (assoc target (cdr (assoc directory
+ org-wikinodes-directory-targets-cache))))))))
+
+;;; Exporting Wiki links
+
+(defvar target)
+(defvar target-alist)
+(defvar last-section-target)
+(defvar org-export-target-aliases)
+(defun org-wikinodes-set-wiki-targets-during-export ()
+ (let ((line (buffer-substring (point-at-bol) (point-at-eol)))
+ (case-fold-search nil)
+ wtarget a)
+ (when (string-match (format org-complex-heading-regexp-format
+ org-wikinodes-camel-regexp)
+ line)
+ (setq wtarget (match-string 4 line))
+ (push (cons wtarget target) target-alist)
+ (setq a (or (assoc last-section-target org-export-target-aliases)
+ (progn
+ (push (list last-section-target)
+ org-export-target-aliases)
+ (car org-export-target-aliases))))
+ (push (caar target-alist) (cdr a)))))
+
+(defvar org-current-export-file)
+(defun org-wikinodes-process-links-for-export ()
+ "Process Wiki links in the export preprocess buffer.
+
+Try to find target matches in the wiki scope and replace CamelCase words
+with working links."
+ (let ((re org-wikinodes-camel-regexp)
+ (case-fold-search nil)
+ link file)
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (org-if-unprotected-at (match-beginning 0)
+ (unless (save-match-data
+ (or (org-at-heading-p)
+ (org-in-regexp org-bracket-link-regexp)
+ (org-in-regexp org-plain-link-re)
+ (org-in-regexp "<<[^<>]+>>")))
+ (setq link (match-string 0))
+ (delete-region (match-beginning 0) (match-end 0))
+ (save-match-data
+ (cond
+ ((org-find-exact-headline-in-buffer link (current-buffer))
+ ;; Found in current buffer
+ (insert (format "[[#%s][%s]]" link link)))
+ ((eq org-wikinodes-scope 'file)
+ ;; No match in file, and other files are not allowed
+ (insert (format "%s" link)))
+ ((setq file
+ (and (org-string-nw-p org-current-export-file)
+ (org-wikinodes-which-file
+ link (file-name-directory org-current-export-file))))
+ ;; Match in another file in the current directory
+ (insert (format "[[file:%s::%s][%s]]" file link link)))
+ (t ;; No match for this link
+ (insert (format "%s" link))))))))))
+
+;;; Hook the WikiNode mechanism into Org
+
+;; `C-c C-o' should follow wiki links
+(add-hook 'org-open-at-point-functions 'org-wikinodes-open-at-point)
+
+;; `C-c C-c' should clear the cache
+(add-hook 'org-ctrl-c-ctrl-c-hook 'org-wikinodes-clear-cache-when-on-target)
+
+;; Make Wiki haeding create additional link names for headlines
+(add-hook 'org-export-define-heading-targets-headline-hook
+ 'org-wikinodes-set-wiki-targets-during-export)
+
+;; Turn Wiki links into links the exporter will treat correctly
+(add-hook 'org-export-preprocess-after-radio-targets-hook
+ 'org-wikinodes-process-links-for-export)
+
+;; Activate CamelCase words as part of Org mode font lock
+
+(defun org-wikinodes-add-to-font-lock-keywords ()
+ "Add wikinode CamelCase highlighting to `org-font-lock-extra-keywords'."
+ (let ((m (member '(org-activate-plain-links) org-font-lock-extra-keywords)))
+ (if m
+ (setcdr m (cons '(org-wikinodes-activate-links) (cdr m)))
+ (message
+ "Failed to add wikinodes to `org-font-lock-extra-keywords'."))))
+
+(add-hook 'org-font-lock-set-keywords-hook
+ 'org-wikinodes-add-to-font-lock-keywords)
+
+(provide 'org-wikinodes)
+
+;;; org-wikinodes.el ends here