| 1 | ;;; org-pcomplete.el --- In-buffer completion code |
| 2 | |
| 3 | ;; Copyright (C) 2004-2012 Free Software Foundation, Inc. |
| 4 | ;; |
| 5 | ;; Author: Carsten Dominik <carsten at orgmode dot org> |
| 6 | ;; John Wiegley <johnw at gnu dot org> |
| 7 | ;; Keywords: outlines, hypermedia, calendar, wp |
| 8 | ;; Homepage: http://orgmode.org |
| 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 | ;;; Code: |
| 27 | |
| 28 | ;;;; Require other packages |
| 29 | |
| 30 | (eval-when-compile |
| 31 | (require 'cl)) |
| 32 | |
| 33 | (require 'org-macs) |
| 34 | (require 'pcomplete) |
| 35 | |
| 36 | (declare-function org-split-string "org" (string &optional separators)) |
| 37 | (declare-function org-get-current-options "org-exp" ()) |
| 38 | (declare-function org-make-org-heading-search-string "org" |
| 39 | (&optional string heading)) |
| 40 | (declare-function org-get-buffer-tags "org" ()) |
| 41 | (declare-function org-get-tags "org" ()) |
| 42 | (declare-function org-buffer-property-keys "org" |
| 43 | (&optional include-specials include-defaults include-columns)) |
| 44 | (declare-function org-entry-properties "org" (&optional pom which specific)) |
| 45 | |
| 46 | ;;;; Customization variables |
| 47 | |
| 48 | (defgroup org-complete nil |
| 49 | "Outline-based notes management and organizer." |
| 50 | :tag "Org" |
| 51 | :group 'org) |
| 52 | |
| 53 | (defun org-thing-at-point () |
| 54 | "Examine the thing at point and let the caller know what it is. |
| 55 | The return value is a string naming the thing at point." |
| 56 | (let ((beg1 (save-excursion |
| 57 | (skip-chars-backward (org-re "[:alnum:]_@")) |
| 58 | (point))) |
| 59 | (beg (save-excursion |
| 60 | (skip-chars-backward "a-zA-Z0-9_:$") |
| 61 | (point))) |
| 62 | (line-to-here (buffer-substring (point-at-bol) (point)))) |
| 63 | (cond |
| 64 | ((string-match "\\`[ \t]*#\\+begin: clocktable[ \t]+" line-to-here) |
| 65 | (cons "block-option" "clocktable")) |
| 66 | ((string-match "\\`[ \t]*#\\+begin_src[ \t]+" line-to-here) |
| 67 | (cons "block-option" "src")) |
| 68 | ((save-excursion |
| 69 | (re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*" |
| 70 | (line-beginning-position) t)) |
| 71 | (cons "file-option" (match-string-no-properties 1))) |
| 72 | ((string-match "\\`[ \t]*#\\+[a-zA-Z_]*\\'" line-to-here) |
| 73 | (cons "file-option" nil)) |
| 74 | ((equal (char-before beg) ?\[) |
| 75 | (cons "link" nil)) |
| 76 | ((equal (char-before beg) ?\\) |
| 77 | (cons "tex" nil)) |
| 78 | ((string-match "\\`\\*+[ \t]+\\'" |
| 79 | (buffer-substring (point-at-bol) beg)) |
| 80 | (cons "todo" nil)) |
| 81 | ((equal (char-before beg) ?*) |
| 82 | (cons "searchhead" nil)) |
| 83 | ((and (equal (char-before beg1) ?:) |
| 84 | (equal (char-after (point-at-bol)) ?*)) |
| 85 | (cons "tag" nil)) |
| 86 | ((and (equal (char-before beg1) ?:) |
| 87 | (not (equal (char-after (point-at-bol)) ?*))) |
| 88 | (cons "prop" nil)) |
| 89 | (t nil)))) |
| 90 | |
| 91 | (defun org-command-at-point () |
| 92 | "Return the qualified name of the Org completion entity at point. |
| 93 | When completing for #+STARTUP, for example, this function returns |
| 94 | \"file-option/startup\"." |
| 95 | (let ((thing (org-thing-at-point))) |
| 96 | (cond |
| 97 | ((string= "file-option" (car thing)) |
| 98 | (concat (car thing) "/" (downcase (cdr thing)))) |
| 99 | ((string= "block-option" (car thing)) |
| 100 | (concat (car thing) "/" (downcase (cdr thing)))) |
| 101 | (t |
| 102 | (car thing))))) |
| 103 | |
| 104 | (defun org-parse-arguments () |
| 105 | "Parse whitespace separated arguments in the current region." |
| 106 | (let ((begin (line-beginning-position)) |
| 107 | (end (line-end-position)) |
| 108 | begins args) |
| 109 | (save-restriction |
| 110 | (narrow-to-region begin end) |
| 111 | (save-excursion |
| 112 | (goto-char (point-min)) |
| 113 | (while (not (eobp)) |
| 114 | (skip-chars-forward " \t\n[") |
| 115 | (setq begins (cons (point) begins)) |
| 116 | (skip-chars-forward "^ \t\n[") |
| 117 | (setq args (cons (buffer-substring-no-properties |
| 118 | (car begins) (point)) |
| 119 | args))) |
| 120 | (cons (reverse args) (reverse begins)))))) |
| 121 | |
| 122 | |
| 123 | (defun org-pcomplete-initial () |
| 124 | "Calls the right completion function for first argument completions." |
| 125 | (ignore |
| 126 | (funcall (or (pcomplete-find-completion-function |
| 127 | (car (org-thing-at-point))) |
| 128 | pcomplete-default-completion-function)))) |
| 129 | |
| 130 | (defvar org-additional-option-like-keywords) |
| 131 | (defun pcomplete/org-mode/file-option () |
| 132 | "Complete against all valid file options." |
| 133 | (require 'org-exp) |
| 134 | (pcomplete-here |
| 135 | (org-pcomplete-case-double |
| 136 | (mapcar (lambda (x) |
| 137 | (if (= ?: (aref x (1- (length x)))) |
| 138 | (concat x " ") |
| 139 | x)) |
| 140 | (delq nil |
| 141 | (pcomplete-uniqify-list |
| 142 | (append |
| 143 | (mapcar (lambda (x) |
| 144 | (if (string-match "^#\\+\\([A-Z_]+:?\\)" x) |
| 145 | (match-string 1 x))) |
| 146 | (org-split-string (org-get-current-options) "\n")) |
| 147 | (copy-sequence org-additional-option-like-keywords)))))) |
| 148 | (substring pcomplete-stub 2))) |
| 149 | |
| 150 | (defvar org-startup-options) |
| 151 | (defun pcomplete/org-mode/file-option/startup () |
| 152 | "Complete arguments for the #+STARTUP file option." |
| 153 | (while (pcomplete-here |
| 154 | (let ((opts (pcomplete-uniqify-list |
| 155 | (mapcar 'car org-startup-options)))) |
| 156 | ;; Some options are mutually exclusive, and shouldn't be completed |
| 157 | ;; against if certain other options have already been seen. |
| 158 | (dolist (arg pcomplete-args) |
| 159 | (cond |
| 160 | ((string= arg "hidestars") |
| 161 | (setq opts (delete "showstars" opts))))) |
| 162 | opts)))) |
| 163 | |
| 164 | (defun pcomplete/org-mode/file-option/bind () |
| 165 | "Complete arguments for the #+BIND file option, which are variable names" |
| 166 | (let (vars) |
| 167 | (mapatoms |
| 168 | (lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars))))) |
| 169 | (pcomplete-here vars))) |
| 170 | |
| 171 | (defvar org-link-abbrev-alist-local) |
| 172 | (defvar org-link-abbrev-alist) |
| 173 | (defun pcomplete/org-mode/link () |
| 174 | "Complete against defined #+LINK patterns." |
| 175 | (pcomplete-here |
| 176 | (pcomplete-uniqify-list |
| 177 | (copy-sequence |
| 178 | (append (mapcar 'car org-link-abbrev-alist-local) |
| 179 | (mapcar 'car org-link-abbrev-alist)))))) |
| 180 | |
| 181 | (defvar org-entities) |
| 182 | (defun pcomplete/org-mode/tex () |
| 183 | "Complete against TeX-style HTML entity names." |
| 184 | (require 'org-entities) |
| 185 | (while (pcomplete-here |
| 186 | (pcomplete-uniqify-list (remove nil (mapcar 'car-safe org-entities))) |
| 187 | (substring pcomplete-stub 1)))) |
| 188 | |
| 189 | (defvar org-todo-keywords-1) |
| 190 | (defun pcomplete/org-mode/todo () |
| 191 | "Complete against known TODO keywords." |
| 192 | (pcomplete-here (pcomplete-uniqify-list (copy-sequence org-todo-keywords-1)))) |
| 193 | |
| 194 | (defvar org-todo-line-regexp) |
| 195 | (defun pcomplete/org-mode/searchhead () |
| 196 | "Complete against all headings. |
| 197 | This needs more work, to handle headings with lots of spaces in them." |
| 198 | (while |
| 199 | (pcomplete-here |
| 200 | (save-excursion |
| 201 | (goto-char (point-min)) |
| 202 | (let (tbl) |
| 203 | (while (re-search-forward org-todo-line-regexp nil t) |
| 204 | (push (org-make-org-heading-search-string |
| 205 | (match-string-no-properties 3) t) |
| 206 | tbl)) |
| 207 | (pcomplete-uniqify-list tbl))) |
| 208 | (substring pcomplete-stub 1)))) |
| 209 | |
| 210 | (defvar org-tag-alist) |
| 211 | (defun pcomplete/org-mode/tag () |
| 212 | "Complete a tag name. Omit tags already set." |
| 213 | (while (pcomplete-here |
| 214 | (mapcar (lambda (x) |
| 215 | (concat x ":")) |
| 216 | (let ((lst (pcomplete-uniqify-list |
| 217 | (or (remove |
| 218 | nil |
| 219 | (mapcar (lambda (x) |
| 220 | (and (stringp (car x)) (car x))) |
| 221 | org-tag-alist)) |
| 222 | (mapcar 'car (org-get-buffer-tags)))))) |
| 223 | (dolist (tag (org-get-tags)) |
| 224 | (setq lst (delete tag lst))) |
| 225 | lst)) |
| 226 | (and (string-match ".*:" pcomplete-stub) |
| 227 | (substring pcomplete-stub (match-end 0)))))) |
| 228 | |
| 229 | (defun pcomplete/org-mode/prop () |
| 230 | "Complete a property name. Omit properties already set." |
| 231 | (pcomplete-here |
| 232 | (mapcar (lambda (x) |
| 233 | (concat x ": ")) |
| 234 | (let ((lst (pcomplete-uniqify-list |
| 235 | (copy-sequence |
| 236 | (org-buffer-property-keys nil t t))))) |
| 237 | (dolist (prop (org-entry-properties)) |
| 238 | (setq lst (delete (car prop) lst))) |
| 239 | lst)) |
| 240 | (substring pcomplete-stub 1))) |
| 241 | |
| 242 | (defun pcomplete/org-mode/block-option/src () |
| 243 | "Complete the arguments of a begin_src block. |
| 244 | Complete a language in the first field, the header arguments and switches." |
| 245 | (pcomplete-here |
| 246 | (mapcar |
| 247 | (lambda(x) (symbol-name (nth 3 x))) |
| 248 | (cdr (car (cdr (memq :key-type (plist-get |
| 249 | (symbol-plist |
| 250 | 'org-babel-load-languages) |
| 251 | 'custom-type))))))) |
| 252 | (while (pcomplete-here |
| 253 | '("-n" "-r" "-l" |
| 254 | ":cache" ":colnames" ":comments" ":dir" ":eval" ":exports" |
| 255 | ":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames" |
| 256 | ":session" ":shebang" ":tangle" ":var")))) |
| 257 | |
| 258 | (defun pcomplete/org-mode/block-option/clocktable () |
| 259 | "Complete keywords in a clocktable line" |
| 260 | (while (pcomplete-here '(":maxlevel" ":scope" |
| 261 | ":tstart" ":tend" ":block" ":step" |
| 262 | ":stepskip0" ":fileskip0" |
| 263 | ":emphasize" ":link" ":narrow" ":indent" |
| 264 | ":tcolumns" ":level" ":compact" ":timestamp" |
| 265 | ":formula" ":formatter")))) |
| 266 | |
| 267 | (defun org-pcomplete-case-double (list) |
| 268 | "Return list with both upcase and downcase version of all strings in LIST." |
| 269 | (let (e res) |
| 270 | (while (setq e (pop list)) |
| 271 | (setq res (cons (downcase e) (cons (upcase e) res)))) |
| 272 | (nreverse res))) |
| 273 | |
| 274 | ;;;; Finish up |
| 275 | |
| 276 | (provide 'org-pcomplete) |
| 277 | |
| 278 | ;;; org-pcomplete.el ends here |