Imported Upstream version 7.9.2

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