contrib/lisp/org-wikinodes.el

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