Add org-wikinodes.el as a contributed package

* contrib/lisp/org-wikinodes.el: New file.
* lisp/org-exp.el (org-export-preprocess-after-radio-targets-hook):
(org-export-define-heading-targets-headline-hook): New hooks.
* lisp/org.el (org-modules): Add entry for org-wikinodes.el.
(org-font-lock-set-keywords-hook): New hook.
(org-open-at-point-functions): New hook.
(org-find-exact-headling-in-buffer):
(org-find-exact-heading-in-directory): New functions.
(org-mode-flyspell-verify): Better cursor position for checking if
flyspell should ignore a word.

contrib/README

@@ -44,7 +44,7 @@ orgtbl-sqlinsert.el      --- Convert Org-mode tables to SQL insertions
 org-toc.el 	         --- Table of contents for Org-mode buffer
 org-track.el             --- Keep up with Org development
 org-velocity.el          --- something like Notational Velocity for Org
-
+org-wikinodes            --- CamelCase wiki-like links for Org
 
 
 PACKAGES

contrib/lisp/org-wikinodes.el

@@ -0,0 +1,339 @@
+;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes
+
+;; Copyright (C) 2010  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 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-on-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-direcory-targets-cache))
+  (let ((create org-wikinodes-create-targets)
+	visiting buffer m pos file rpl)
+    (setq pos
+	  (or (org-find-exact-headling-in-buffer target (current-buffer))
+	      (and (eq org-wikinodes-scope 'directory)
+		   (setq file (org-wikinodes-which-file target))
+		   (org-find-exact-headling-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))
+	(switch-to-buffer (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-on-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-direcory-targets-cache)
+    t))
+
+(defun org-wikinodes-clear-direcory-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."
+  (setq directory (expand-file-name (or directory default-directory)))
+  (unless (assoc directory org-wikinodes-directory-targets-cache)
+    (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-on-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-headling-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)
+
+;; arch-tag: e3b56e38-a2be-478c-b56c-68a913ec54ec
+
+;;; org-wikinodes.el ends here

lisp/org-exp.el

@@ -417,6 +417,10 @@ This is run just before backend-specific blocks get selected.")
 This is run after blockquote/quote/verse/center have been marked
 with cookies.")
 
+(defvar org-export-preprocess-after-radio-targets-hook nil
+  "Hook for preprocessing an export buffer.
+This is run after radio target processing.")
+
 (defvar org-export-preprocess-before-normalizing-links-hook nil
   "Hook for preprocessing an export buffer.
 This hook is run before links are normalized.")
@@ -1120,6 +1124,7 @@ on this string to produce the exported version."
 
       ;; Find matches for radio targets and turn them into internal links
       (org-export-mark-radio-links)
+      (run-hooks 'org-export-preprocess-after-radio-targets-hook)
 
       ;; Find all links that contain a newline and put them into a single line
       (org-export-concatenate-multiline-links)
@@ -1185,6 +1190,10 @@ on this string to produce the exported version."
        p (or (next-single-property-change p :org-license-to-kill)
 	     (point-max))))))
 
+(defvar org-export-define-heading-targets-headline-hook nil
+  "Hook that is run when a headline was matched during target search.
+This is part of the preprocessing for export.")
+
 (defun org-export-define-heading-targets (target-alist)
   "Find all headings and define the targets for them.
 The new targets are added to TARGET-ALIST, which is also returned.
@@ -1228,7 +1237,8 @@ Also find all ID and CUSTOM_ID properties and store them."
 	  (push (cons target target) target-alist)
 	  (add-text-properties
 	   (point-at-bol) (point-at-eol)
-	   (list 'target target))))))
+	   (list 'target target))
+	  (run-hooks 'org-export-define-heading-targets-headline-hook)))))
   target-alist)
 
 (defun org-export-handle-invisible-targets (target-alist)

lisp/org.el

@@ -331,6 +331,7 @@ to add the symbol `xyz', and the package must have a call to
 	(const :tag "C  toc:               Table of contents for Org-mode buffer" org-toc)
 	(const :tag "C  track:             Keep up with Org-mode development" org-track)
 	(const :tag "C  velocity           Something like Notational Velocity for Org" org-velocity)
+	(const :tag "C  wikinodes:         CamelCase wiki-like links" org-wikinodes)
 	(repeat :tag "External packages" :inline t (symbol :tag "Package"))))
 
 (defcustom org-support-shift-select nil
@@ -5379,6 +5380,12 @@ For plain list items, if they are matched by `outline-regexp', this returns
 (defvar org-font-lock-hook nil
   "Functions to be called for special font lock stuff.")
 
+(defvar org-font-lock-set-keywords-hook nil
+  "Functions that can manipulate `org-font-lock-extra-keywords'.
+This is calles after `org-font-lock-extra-keywords' is defined, but before
+it is installed to be used by font lock.  This can be useful if something
+needs to be inserted at a specific position in the font-lock sequence.")
+
 (defun org-font-lock-hook (limit)
   (run-hook-with-args 'org-font-lock-hook limit))
 
@@ -5473,6 +5480,7 @@ For plain list items, if they are matched by `outline-regexp', this returns
 	   '(org-fontify-meta-lines-and-blocks)
 	   )))
     (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
+    (run-hooks 'org-font-lock-set-keywords-hook)
     ;; Now set the full font-lock-keywords
     (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords)
     (org-set-local 'font-lock-defaults
@@ -8988,6 +8996,13 @@ Org-mode syntax."
 		  org-link-abbrev-alist-local)))
 	(org-open-at-point arg reference-buffer)))))
 
+(defvar org-open-at-point-functions nil
+  "Hook that is run when following a link at point.
+
+Functions in this hook must return t if they identify and follow
+a link at point.  If they don't find anything interesting at point,
+they must return nil.")
+
 (defun org-open-at-point (&optional in-emacs reference-buffer)
   "Open link at or after point.
 If there is no link at point, this function will search forward up to
@@ -9013,6 +9028,7 @@ application the system uses for this file type."
 	 (not (get-text-property (point) 'org-linked-text)))
     (or (org-offer-links-in-entry in-emacs)
 	(progn (require 'org-attach) (org-attach-reveal 'if-exists))))
+   ((run-hook-with-args-until-success 'org-open-at-point-functions))
    ((org-at-timestamp-p t) (org-follow-timestamp-link))
    ((or (org-footnote-at-reference-p) (org-footnote-at-definition-p))
     (org-footnote-action))
@@ -13988,6 +14004,42 @@ only headings."
 	  (when (org-on-heading-p)
 	    (move-marker (make-marker) (point))))))))
 
+(defun org-find-exact-headling-in-buffer (heading &optional buffer pos-only)
+  "Find node HEADING in BUFFER.
+Return a marker to the heading if it was found, or nil if not.
+If POS-ONLY is set, return just the position instead of a marker.
+
+The heading text must match exact, but it may have a TODO keyword,
+a priority cookie and tags in the standard locations."
+  (with-current-buffer (or buffer (current-buffer))
+    (save-excursion
+      (save-restriction
+	(widen)
+	(goto-char (point-min))
+	(let (case-fold-search)
+	  (if (setq p (re-search-forward
+		       (format org-complex-heading-regexp-format
+			       (regexp-quote heading)) nil t))
+	      (if pos-only
+		  (match-beginning 0)
+		(move-marker (make-marker) (match-beginning 0)))))))))
+
+(defun org-find-exact-heading-in-directory (heading &optional dir)
+  "Find Org node headline HEADING in all .org files in directory DIR.
+When the target headline is found, return a marker to this location."
+  (let ((files (directory-files (or dir default-directory)
+				nil "\\`[^.#].*\\.org\\'"))
+        file visiting m buffer)
+    (catch 'found
+      (while (setq file (pop files))
+        (message "trying %s" file)
+        (setq visiting (org-find-base-buffer-visiting file))
+        (setq buffer (or visiting (find-file-noselect file)))
+        (setq m (org-find-exact-headling-in-buffer
+                 target buffer))
+        (when (and (not m) (not visiting)) (kill-buffer buffer))
+        (and m (throw 'found m))))))
+
 (defun org-find-entry-with-id (ident)
   "Locate the entry that contains the ID property with exact value IDENT.
 IDENT can be a string, a symbol or a number, this function will search for
@@ -19401,8 +19453,8 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
 ;; Make flyspell not check words in links, to not mess up our keymap
 (defun org-mode-flyspell-verify ()
   "Don't let flyspell put overlays at active buttons."
-  (and (not (get-text-property (point) 'keymap))
-       (not (get-text-property (point) 'org-no-flyspell))))
+  (and (not (get-text-property (max (1- (point)) (point-min)) 'keymap))
+       (not (get-text-property (max (1- (point)) (point-min)) 'org-no-flyspell))))
 
 (defun org-remove-flyspell-overlays-in (beg end)
   "Remove flyspell overlays in region."