contrib/lisp/org-wikinodes.el

   1 ;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes
   2
   3 ;; Copyright (C) 2010-2013 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 not 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-directory-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
 125                                target (file-name-directory (buffer-file-name))))
 126                    (org-find-exact-headline-in-buffer
 127                     target (or (get-file-buffer file)
 128                                (find-file-noselect file))))))
 129     (if pos
 130         (progn
 131           (org-mark-ring-push (point))
 132           (org-goto-marker-or-bmk pos)
 133           (move-marker pos nil))
 134       (when (eq create 'query)
 135         (if (eq org-wikinodes-scope 'directory)
 136             (progn
 137               (message "Node \"%s\" does not exist.  Should it be created?
 138 \[RET] in this buffer   [TAB] in another file  [q]uit" target)
 139               (setq rpl (read-char-exclusive))
 140               (cond
 141                ((member rpl '(?\C-g ?q)) (error "Abort"))
 142                ((equal rpl ?\C-m) (setq create t))
 143                ((equal rpl ?\C-i)
 144                 (setq create (file-name-nondirectory
 145                               (read-file-name "Create in file: "))))
 146                (t (error "Invalid selection"))))
 147           (if (y-or-n-p (format "Create new node \"%s\" in current buffer? "
 148                                 target))
 149               (setq create t)
 150             (error "Abort"))))
 151
 152       (cond
 153        ((not create)
 154         ;; We are not allowed to create the new node
 155         (error "No match for link to \"%s\"" target))
 156        ((stringp create)
 157         ;; Make new node in another file
 158         (org-mark-ring-push (point))
 159         (org-pop-to-buffer-same-window (find-file-noselect create))
 160         (goto-char (point-max))
 161         (or (bolp) (newline))
 162         (insert "\n* " target "\n")
 163         (backward-char 1)
 164         (org-wikinodes-add-target-to-cache target)
 165         (message "New Wiki target `%s' created in file \"%s\""
 166                  target create))
 167        (t
 168         ;; Make new node in current buffer
 169         (org-mark-ring-push (point))
 170         (goto-char (point-max))
 171         (or (bolp) (newline))
 172         (insert "* " target "\n")
 173         (backward-char 1)
 174         (org-wikinodes-add-target-to-cache target)
 175         (message "New Wiki target `%s' created in current buffer"
 176                  target))))))
 177
 178 ;;; The target cache
 179
 180 (defvar org-wikinodes-directory-targets-cache nil)
 181
 182 (defun org-wikinodes-clear-cache-when-on-target ()
 183   "When on a headline that is a Wiki target, clear the cache."
 184   (when (and (org-at-heading-p)
 185              (org-in-regexp (format org-complex-heading-regexp-format
 186                                     org-wikinodes-camel-regexp))
 187              (org-in-regexp org-wikinodes-camel-regexp))
 188     (org-wikinodes-clear-directory-targets-cache)
 189     t))
 190
 191 (defun org-wikinodes-clear-directory-targets-cache ()
 192   "Clear the cache where to find wiki targets."
 193   (interactive)
 194   (setq org-wikinodes-directory-targets-cache nil)
 195   (message "Wiki target cache cleared, so that it will update when used again"))
 196
 197 (defun org-wikinodes-get-targets ()
 198   "Return a list of all wiki targets in the current buffer."
 199   (let ((re (format org-complex-heading-regexp-format
 200                     org-wikinodes-camel-regexp))
 201         (case-fold-search nil)
 202         targets)
 203     (save-excursion
 204       (save-restriction
 205         (widen)
 206         (goto-char (point-min))
 207         (while (re-search-forward re nil t)
 208           (push (org-match-string-no-properties 4) targets))))
 209     (nreverse targets)))
 210
 211 (defun org-wikinodes-get-links-for-directory (dir)
 212   "Return an alist that connects wiki links to files in directory DIR."
 213   (let ((files (directory-files dir nil "\\`[^.#].*\\.org\\'"))
 214         (org-inhibit-startup t)
 215         target-file-alist file visiting m buffer)
 216     (while (setq file (pop files))
 217       (setq visiting (org-find-base-buffer-visiting file))
 218       (setq buffer (or visiting (find-file-noselect file)))
 219       (with-current-buffer buffer
 220         (mapc
 221          (lambda (target)
 222            (setq target-file-alist (cons (cons target file) target-file-alist)))
 223          (org-wikinodes-get-targets)))
 224       (or visiting (kill-buffer buffer)))
 225     target-file-alist))
 226
 227 (defun org-wikinodes-add-target-to-cache (target &optional file)
 228   (setq file (or file buffer-file-name (error "No file for new wiki target")))
 229   (set-text-properties 0 (length target) nil target)
 230   (let ((dir (file-name-directory (expand-file-name file)))
 231         a)
 232     (setq a (assoc dir org-wikinodes-directory-targets-cache))
 233     (if a
 234         ;; Push the new target onto the existing list
 235         (push (cons target (expand-file-name file)) (cdr a))
 236       ;; Call org-wikinodes-which-file so that the cache will be filled
 237       (org-wikinodes-which-file target dir))))
 238
 239 (defun org-wikinodes-which-file (target &optional directory)
 240   "Return the file for wiki headline TARGET DIRECTORY.
 241 If there is no such wiki target, return nil."
 242   (let* ((directory (expand-file-name (or directory default-directory)))
 243          (founddir (assoc directory org-wikinodes-directory-targets-cache))
 244          (foundfile (cdr (assoc target (cdr founddir)))))
 245     (or foundfile
 246         (and (push (cons directory (org-wikinodes-get-links-for-directory directory))
 247                    org-wikinodes-directory-targets-cache)
 248              (cdr (assoc target (cdr (assoc directory
 249                                             org-wikinodes-directory-targets-cache))))))))
 250
 251 ;;; Exporting Wiki links
 252
 253 (defvar target)
 254 (defvar target-alist)
 255 (defvar last-section-target)
 256 (defvar org-export-target-aliases)
 257 (defun org-wikinodes-set-wiki-targets-during-export ()
 258   (let ((line (buffer-substring (point-at-bol) (point-at-eol)))
 259         (case-fold-search nil)
 260         wtarget a)
 261     (when (string-match (format org-complex-heading-regexp-format
 262                                 org-wikinodes-camel-regexp)
 263                         line)
 264       (setq wtarget (match-string 4 line))
 265       (push (cons wtarget target) target-alist)
 266       (setq a (or (assoc last-section-target org-export-target-aliases)
 267                   (progn
 268                     (push (list last-section-target)
 269                           org-export-target-aliases)
 270                     (car org-export-target-aliases))))
 271       (push (caar target-alist) (cdr a)))))
 272
 273 (defvar org-current-export-file)
 274 (defun org-wikinodes-process-links-for-export ()
 275   "Process Wiki links in the export preprocess buffer.
 276
 277 Try to find target matches in the wiki scope and replace CamelCase words
 278 with working links."
 279   (let ((re org-wikinodes-camel-regexp)
 280         (case-fold-search nil)
 281         link file)
 282     (goto-char (point-min))
 283     (while (re-search-forward re nil t)
 284       (org-if-unprotected-at (match-beginning 0)
 285         (unless (save-match-data
 286                   (or (org-at-heading-p)
 287                       (org-in-regexp org-bracket-link-regexp)
 288                       (org-in-regexp org-plain-link-re)
 289                       (org-in-regexp "<<[^<>]+>>")))
 290           (setq link (match-string 0))
 291           (delete-region (match-beginning 0) (match-end 0))
 292           (save-match-data
 293             (cond
 294              ((org-find-exact-headline-in-buffer link (current-buffer))
 295               ;; Found in current buffer
 296               (insert (format "[[#%s][%s]]" link link)))
 297              ((eq org-wikinodes-scope 'file)
 298               ;; No match in file, and other files are not allowed
 299               (insert (format "%s" link)))
 300              ((setq file
 301                     (and (org-string-nw-p org-current-export-file)
 302                          (org-wikinodes-which-file
 303                           link (file-name-directory org-current-export-file))))
 304               ;; Match in another file in the current directory
 305               (insert (format "[[file:%s::%s][%s]]" file link link)))
 306              (t ;; No match for this link
 307               (insert (format "%s" link))))))))))
 308
 309 ;;; Hook the WikiNode mechanism into Org
 310
 311 ;; `C-c C-o' should follow wiki links
 312 (add-hook 'org-open-at-point-functions 'org-wikinodes-open-at-point)
 313
 314 ;; `C-c C-c' should clear the cache
 315 (add-hook 'org-ctrl-c-ctrl-c-hook 'org-wikinodes-clear-cache-when-on-target)
 316
 317 ;; Make Wiki haeding create additional link names for headlines
 318 (add-hook 'org-export-define-heading-targets-headline-hook
 319           'org-wikinodes-set-wiki-targets-during-export)
 320
 321 ;; Turn Wiki links into links the exporter will treat correctly
 322 (add-hook 'org-export-preprocess-after-radio-targets-hook
 323           'org-wikinodes-process-links-for-export)
 324
 325 ;; Activate CamelCase words as part of Org mode font lock
 326
 327 (defun org-wikinodes-add-to-font-lock-keywords ()
 328   "Add wikinode CamelCase highlighting to `org-font-lock-extra-keywords'."
 329   (let ((m (member '(org-activate-plain-links) org-font-lock-extra-keywords)))
 330     (if m
 331         (setcdr m (cons '(org-wikinodes-activate-links) (cdr m)))
 332       (message
 333        "Failed to add wikinodes to `org-font-lock-extra-keywords'."))))
 334
 335 (add-hook 'org-font-lock-set-keywords-hook
 336           'org-wikinodes-add-to-font-lock-keywords)
 337
 338 (provide 'org-wikinodes)
 339
 340 ;;; org-wikinodes.el ends here