contrib/lisp/org-wikinodes.el

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