summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCarsten Dominik <carsten.dominik@gmail.com>2010-07-16 14:15:41 +0200
committerCarsten Dominik <carsten.dominik@gmail.com>2010-08-06 15:08:45 +0200
commit251a3ca7c3a84b65547f4d125d961fd5845add41 (patch)
tree912c33f713d83fd4a814c86e364b837763eedef0
parentd593bae0ffa55c189f8009464fed7b898867d57e (diff)
downloadorg-mode-251a3ca7c3a84b65547f4d125d961fd5845add41.tar.gz
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.
-rw-r--r--contrib/README2
-rw-r--r--contrib/lisp/org-wikinodes.el339
-rw-r--r--lisp/org-exp.el12
-rw-r--r--lisp/org.el56
4 files changed, 405 insertions, 4 deletions
diff --git a/contrib/README b/contrib/README
index 3cb076d..4a18790 100644
--- a/contrib/README
+++ b/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
diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el
new file mode 100644
index 0000000..0a00052
--- /dev/null
+++ b/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
diff --git a/lisp/org-exp.el b/lisp/org-exp.el
index 36f8202..cd0a105 100644
--- a/lisp/org-exp.el
+++ b/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)
diff --git a/lisp/org.el b/lisp/org.el
index 1eb8023..2ac2aef 100644
--- a/lisp/org.el
+++ b/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."