| commit | author | age | ||
| 76bbd0 | 1 | ;;; org-pcomplete.el --- In-buffer Completion Code -*- lexical-binding: t; -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2004-2018 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: https://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 <https://www.gnu.org/licenses/>. | |
| 24 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 25 | ;; | |
| 26 | ;;; Code: | |
| 27 | ||
| 28 | ;;;; Require other packages | |
| 29 | ||
| 30 | (require 'org-macs) | |
| 31 | (require 'org-compat) | |
| 32 | (require 'pcomplete) | |
| 33 | ||
| 34 | (declare-function org-make-org-heading-search-string "org" (&optional string)) | |
| 35 | (declare-function org-get-buffer-tags "org" ()) | |
| 36 | (declare-function org-get-tags "org" ()) | |
| 37 | (declare-function org-buffer-property-keys "org" | |
| 38 | (&optional specials defaults columns ignore-malformed)) | |
| 39 | (declare-function org-entry-properties "org" (&optional pom which)) | |
| 40 | (declare-function org-tag-alist-to-string "org" (alist &optional skip-key)) | |
| 41 | ||
| 42 | ;;;; Customization variables | |
| 43 | ||
| 44 | (defvar org-drawer-regexp) | |
| 45 | (defvar org-property-re) | |
| 46 | (defvar org-current-tag-alist) | |
| 47 | ||
| 48 | (defun org-thing-at-point () | |
| 49 | "Examine the thing at point and let the caller know what it is. | |
| 50 | The return value is a string naming the thing at point." | |
| 51 | (let ((beg1 (save-excursion | |
| 52 | (skip-chars-backward "[:alnum:]-_@") | |
| 53 | (point))) | |
| 54 | (beg (save-excursion | |
| 55 | (skip-chars-backward "a-zA-Z0-9-_:$") | |
| 56 | (point))) | |
| 57 | (line-to-here (buffer-substring (point-at-bol) (point)))) | |
| 58 | (cond | |
| 59 | ((string-match "\\`[ \t]*#\\+begin: clocktable[ \t]+" line-to-here) | |
| 60 | (cons "block-option" "clocktable")) | |
| 61 | ((string-match "\\`[ \t]*#\\+begin_src[ \t]+" line-to-here) | |
| 62 | (cons "block-option" "src")) | |
| 63 | ((save-excursion | |
| 64 | (re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*" | |
| 65 | (line-beginning-position) t)) | |
| 66 | (cons "file-option" (match-string-no-properties 1))) | |
| 67 | ((string-match "\\`[ \t]*#\\+[a-zA-Z_]*\\'" line-to-here) | |
| 68 | (cons "file-option" nil)) | |
| 69 | ((equal (char-before beg) ?\[) | |
| 70 | (cons "link" nil)) | |
| 71 | ((equal (char-before beg) ?\\) | |
| 72 | (cons "tex" nil)) | |
| 73 | ((string-match "\\`\\*+[ \t]+\\'" | |
| 74 | (buffer-substring (point-at-bol) beg)) | |
| 75 | (cons "todo" nil)) | |
| 76 | ((equal (char-before beg) ?*) | |
| 77 | (cons "searchhead" nil)) | |
| 78 | ((and (equal (char-before beg1) ?:) | |
| 79 | (equal (char-after (point-at-bol)) ?*)) | |
| 80 | (cons "tag" nil)) | |
| 81 | ((and (equal (char-before beg1) ?:) | |
| 82 | (not (equal (char-after (point-at-bol)) ?*)) | |
| 83 | (save-excursion | |
| 84 | (move-beginning-of-line 1) | |
| 85 | (skip-chars-backward "[ \t\n]") | |
| 86 | ;; org-drawer-regexp matches a whole line but while | |
| 87 | ;; looking-back, we just ignore trailing whitespaces | |
| 88 | (or (looking-back (substring org-drawer-regexp 0 -1) | |
| 89 | (line-beginning-position)) | |
| 90 | (looking-back org-property-re | |
| 91 | (line-beginning-position))))) | |
| 92 | (cons "prop" nil)) | |
| 93 | ((and (equal (char-before beg1) ?:) | |
| 94 | (not (equal (char-after (point-at-bol)) ?*))) | |
| 95 | (cons "drawer" nil)) | |
| 96 | (t nil)))) | |
| 97 | ||
| 98 | (defun org-command-at-point () | |
| 99 | "Return the qualified name of the Org completion entity at point. | |
| 100 | When completing for #+STARTUP, for example, this function returns | |
| 101 | \"file-option/startup\"." | |
| 102 | (let ((thing (org-thing-at-point))) | |
| 103 | (cond | |
| 104 | ((string= "file-option" (car thing)) | |
| 105 | (concat (car thing) | |
| 106 | (and (cdr thing) (concat "/" (downcase (cdr thing)))))) | |
| 107 | ((string= "block-option" (car thing)) | |
| 108 | (concat (car thing) "/" (downcase (cdr thing)))) | |
| 109 | (t (car thing))))) | |
| 110 | ||
| 111 | (defun org-parse-arguments () | |
| 112 | "Parse whitespace separated arguments in the current region." | |
| 113 | (let ((begin (line-beginning-position)) | |
| 114 | (end (line-end-position)) | |
| 115 | begins args) | |
| 116 | (save-restriction | |
| 117 | (narrow-to-region begin end) | |
| 118 | (save-excursion | |
| 119 | (goto-char (point-min)) | |
| 120 | (while (not (eobp)) | |
| 121 | (skip-chars-forward " \t\n[") | |
| 122 | (setq begins (cons (point) begins)) | |
| 123 | (skip-chars-forward "^ \t\n[") | |
| 124 | (setq args (cons (buffer-substring-no-properties | |
| 125 | (car begins) (point)) | |
| 126 | args))) | |
| 127 | (cons (reverse args) (reverse begins)))))) | |
| 128 | ||
| 129 | (defun org-pcomplete-initial () | |
| 130 | "Calls the right completion function for first argument completions." | |
| 131 | (ignore | |
| 132 | (funcall (or (pcomplete-find-completion-function | |
| 133 | (car (org-thing-at-point))) | |
| 134 | pcomplete-default-completion-function)))) | |
| 135 | ||
| 136 | (defvar org-options-keywords) ; From org.el | |
| 137 | (defvar org-element-affiliated-keywords) ; From org-element.el | |
| 138 | (declare-function org-get-export-keywords "org" ()) | |
| 139 | (defun pcomplete/org-mode/file-option () | |
| 140 | "Complete against all valid file options." | |
| 141 | (require 'org-element) | |
| 142 | (pcomplete-here | |
| 143 | (org-pcomplete-case-double | |
| 144 | (append (mapcar (lambda (keyword) (concat keyword " ")) | |
| 145 | org-options-keywords) | |
| 146 | (mapcar (lambda (keyword) (concat keyword ": ")) | |
| 147 | org-element-affiliated-keywords) | |
| 148 | (let (block-names) | |
| 149 | (dolist (name | |
| 150 | '("CENTER" "COMMENT" "EXAMPLE" "EXPORT" "QUOTE" "SRC" | |
| 151 | "VERSE") | |
| 152 | block-names) | |
| 153 | (push (format "END_%s" name) block-names) | |
| 154 | (push (concat "BEGIN_" | |
| 155 | name | |
| 156 | ;; Since language is compulsory in | |
| 157 | ;; export blocks source blocks, add | |
| 158 | ;; a space. | |
| 159 | (and (member name '("EXPORT" "SRC")) " ")) | |
| 160 | block-names) | |
| 161 | (push (format "ATTR_%s: " name) block-names))) | |
| 162 | (mapcar (lambda (keyword) (concat keyword ": ")) | |
| 163 | (org-get-export-keywords)))) | |
| 164 | (substring pcomplete-stub 2))) | |
| 165 | ||
| 166 | (defun pcomplete/org-mode/file-option/author () | |
| 167 | "Complete arguments for the #+AUTHOR file option." | |
| 168 | (pcomplete-here (list user-full-name))) | |
| 169 | ||
| 170 | (defvar org-time-stamp-formats) | |
| 171 | (defun pcomplete/org-mode/file-option/date () | |
| 172 | "Complete arguments for the #+DATE file option." | |
| 173 | (pcomplete-here (list (format-time-string (car org-time-stamp-formats))))) | |
| 174 | ||
| 175 | (defun pcomplete/org-mode/file-option/email () | |
| 176 | "Complete arguments for the #+EMAIL file option." | |
| 177 | (pcomplete-here (list user-mail-address))) | |
| 178 | ||
| 179 | (defvar org-export-exclude-tags) | |
| 180 | (defun pcomplete/org-mode/file-option/exclude_tags () | |
| 181 | "Complete arguments for the #+EXCLUDE_TAGS file option." | |
| 182 | (require 'ox) | |
| 183 | (pcomplete-here | |
| 184 | (and org-export-exclude-tags | |
| 185 | (list (mapconcat 'identity org-export-exclude-tags " "))))) | |
| 186 | ||
| 187 | (defvar org-file-tags) | |
| 188 | (defun pcomplete/org-mode/file-option/filetags () | |
| 189 | "Complete arguments for the #+FILETAGS file option." | |
| 190 | (pcomplete-here (and org-file-tags (mapconcat 'identity org-file-tags " ")))) | |
| 191 | ||
| 192 | (defvar org-export-default-language) | |
| 193 | (defun pcomplete/org-mode/file-option/language () | |
| 194 | "Complete arguments for the #+LANGUAGE file option." | |
| 195 | (require 'ox) | |
| 196 | (pcomplete-here | |
| 197 | (pcomplete-uniqify-list | |
| 198 | (list org-export-default-language "en")))) | |
| 199 | ||
| 200 | (defvar org-default-priority) | |
| 201 | (defvar org-highest-priority) | |
| 202 | (defvar org-lowest-priority) | |
| 203 | (defun pcomplete/org-mode/file-option/priorities () | |
| 204 | "Complete arguments for the #+PRIORITIES file option." | |
| 205 | (pcomplete-here (list (format "%c %c %c" | |
| 206 | org-highest-priority | |
| 207 | org-lowest-priority | |
| 208 | org-default-priority)))) | |
| 209 | ||
| 210 | (defvar org-export-select-tags) | |
| 211 | (defun pcomplete/org-mode/file-option/select_tags () | |
| 212 | "Complete arguments for the #+SELECT_TAGS file option." | |
| 213 | (require 'ox) | |
| 214 | (pcomplete-here | |
| 215 | (and org-export-select-tags | |
| 216 | (list (mapconcat 'identity org-export-select-tags " "))))) | |
| 217 | ||
| 218 | (defvar org-startup-options) | |
| 219 | (defun pcomplete/org-mode/file-option/startup () | |
| 220 | "Complete arguments for the #+STARTUP file option." | |
| 221 | (while (pcomplete-here | |
| 222 | (let ((opts (pcomplete-uniqify-list | |
| 223 | (mapcar 'car org-startup-options)))) | |
| 224 | ;; Some options are mutually exclusive, and shouldn't be completed | |
| 225 | ;; against if certain other options have already been seen. | |
| 226 | (dolist (arg pcomplete-args) | |
| 227 | (cond | |
| 228 | ((string= arg "hidestars") | |
| 229 | (setq opts (delete "showstars" opts))))) | |
| 230 | opts)))) | |
| 231 | ||
| 232 | (defun pcomplete/org-mode/file-option/tags () | |
| 233 | "Complete arguments for the #+TAGS file option." | |
| 234 | (pcomplete-here | |
| 235 | (list (org-tag-alist-to-string org-current-tag-alist)))) | |
| 236 | ||
| 237 | (defun pcomplete/org-mode/file-option/title () | |
| 238 | "Complete arguments for the #+TITLE file option." | |
| 239 | (pcomplete-here | |
| 240 | (let ((visited-file (buffer-file-name (buffer-base-buffer)))) | |
| 241 | (list (or (and visited-file | |
| 242 | (file-name-sans-extension | |
| 243 | (file-name-nondirectory visited-file))) | |
| 244 | (buffer-name (buffer-base-buffer))))))) | |
| 245 | ||
| 246 | ||
| 247 | (declare-function org-export-backend-options "ox" (cl-x) t) | |
| 248 | (defun pcomplete/org-mode/file-option/options () | |
| 249 | "Complete arguments for the #+OPTIONS file option." | |
| 250 | (while (pcomplete-here | |
| 251 | (pcomplete-uniqify-list | |
| 252 | (append | |
| 253 | ;; Hard-coded OPTION items always available. | |
| 254 | '("H:" "\\n:" "num:" "timestamp:" "arch:" "author:" "c:" | |
| 255 | "creator:" "date:" "d:" "email:" "*:" "e:" "::" "f:" | |
| 256 | "inline:" "tex:" "p:" "pri:" "':" "-:" "stat:" "^:" "toc:" | |
| 257 | "|:" "tags:" "tasks:" "<:" "todo:") | |
| 258 | ;; OPTION items from registered back-ends. | |
| 259 | (let (items) | |
| 260 | (dolist (backend (bound-and-true-p | |
| 261 | org-export-registered-backends)) | |
| 262 | (dolist (option (org-export-backend-options backend)) | |
| 263 | (let ((item (nth 2 option))) | |
| 264 | (when item (push (concat item ":") items))))) | |
| 265 | items)))))) | |
| 266 | ||
| 267 | (defun pcomplete/org-mode/file-option/infojs_opt () | |
| 268 | "Complete arguments for the #+INFOJS_OPT file option." | |
| 269 | (while (pcomplete-here | |
| 270 | (pcomplete-uniqify-list | |
| 271 | (mapcar (lambda (item) (format "%s:" (car item))) | |
| 272 | (bound-and-true-p org-html-infojs-opts-table)))))) | |
| 273 | ||
| 274 | (defun pcomplete/org-mode/file-option/bind () | |
| 275 | "Complete arguments for the #+BIND file option, which are variable names." | |
| 276 | (let (vars) | |
| 277 | (mapatoms | |
| 278 | (lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars))))) | |
| 279 | (pcomplete-here vars))) | |
| 280 | ||
| 281 | (defvar org-link-abbrev-alist-local) | |
| 282 | (defvar org-link-abbrev-alist) | |
| 283 | (defun pcomplete/org-mode/link () | |
| 284 | "Complete against defined #+LINK patterns." | |
| 285 | (pcomplete-here | |
| 286 | (pcomplete-uniqify-list | |
| 287 | (copy-sequence | |
| 288 | (append (mapcar 'car org-link-abbrev-alist-local) | |
| 289 | (mapcar 'car org-link-abbrev-alist)))))) | |
| 290 | ||
| 291 | (defvar org-entities) | |
| 292 | (defun pcomplete/org-mode/tex () | |
| 293 | "Complete against TeX-style HTML entity names." | |
| 294 | (require 'org-entities) | |
| 295 | (while (pcomplete-here | |
| 296 | (pcomplete-uniqify-list (remove nil (mapcar 'car-safe org-entities))) | |
| 297 | (substring pcomplete-stub 1)))) | |
| 298 | ||
| 299 | (defvar org-todo-keywords-1) | |
| 300 | (defun pcomplete/org-mode/todo () | |
| 301 | "Complete against known TODO keywords." | |
| 302 | (pcomplete-here (pcomplete-uniqify-list (copy-sequence org-todo-keywords-1)))) | |
| 303 | ||
| 304 | (defvar org-todo-line-regexp) | |
| 305 | (defun pcomplete/org-mode/searchhead () | |
| 306 | "Complete against all headings. | |
| 307 | This needs more work, to handle headings with lots of spaces in them." | |
| 308 | (while | |
| 309 | (pcomplete-here | |
| 310 | (save-excursion | |
| 311 | (goto-char (point-min)) | |
| 312 | (let (tbl) | |
| 313 | (let ((case-fold-search nil)) | |
| 314 | (while (re-search-forward org-todo-line-regexp nil t) | |
| 315 | (push (org-make-org-heading-search-string | |
| 316 | (match-string-no-properties 3)) | |
| 317 | tbl))) | |
| 318 | (pcomplete-uniqify-list tbl))) | |
| 319 | (substring pcomplete-stub 1)))) | |
| 320 | ||
| 321 | (defun pcomplete/org-mode/tag () | |
| 322 | "Complete a tag name. Omit tags already set." | |
| 323 | (while (pcomplete-here | |
| 324 | (mapcar (lambda (x) (concat x ":")) | |
| 325 | (let ((lst (pcomplete-uniqify-list | |
| 326 | (or (remq | |
| 327 | nil | |
| 328 | (mapcar (lambda (x) (org-string-nw-p (car x))) | |
| 329 | org-current-tag-alist)) | |
| 330 | (mapcar #'car (org-get-buffer-tags)))))) | |
| 331 | (dolist (tag (org-get-tags)) | |
| 332 | (setq lst (delete tag lst))) | |
| 333 | lst)) | |
| 334 | (and (string-match ".*:" pcomplete-stub) | |
| 335 | (substring pcomplete-stub (match-end 0)))))) | |
| 336 | ||
| 337 | (defun pcomplete/org-mode/prop () | |
| 338 | "Complete a property name. Omit properties already set." | |
| 339 | (pcomplete-here | |
| 340 | (mapcar (lambda (x) | |
| 341 | (concat x ": ")) | |
| 342 | (let ((lst (pcomplete-uniqify-list | |
| 343 | (copy-sequence | |
| 344 | (org-buffer-property-keys nil t t t))))) | |
| 345 | (dolist (prop (org-entry-properties)) | |
| 346 | (setq lst (delete (car prop) lst))) | |
| 347 | lst)) | |
| 348 | (substring pcomplete-stub 1))) | |
| 349 | ||
| 350 | (defun pcomplete/org-mode/block-option/src () | |
| 351 | "Complete the arguments of a begin_src block. | |
| 352 | Complete a language in the first field, the header arguments and switches." | |
| 353 | (pcomplete-here | |
| 354 | (mapcar | |
| 355 | (lambda(x) (symbol-name (nth 3 x))) | |
| 356 | (cdr (car (cdr (memq :key-type (plist-get | |
| 357 | (symbol-plist | |
| 358 | 'org-babel-load-languages) | |
| 359 | 'custom-type))))))) | |
| 360 | (while (pcomplete-here | |
| 361 | '("-n" "-r" "-l" | |
| 362 | ":cache" ":colnames" ":comments" ":dir" ":eval" ":exports" | |
| 363 | ":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames" | |
| 364 | ":session" ":shebang" ":tangle" ":tangle-mode" ":var")))) | |
| 365 | ||
| 366 | (defun pcomplete/org-mode/block-option/clocktable () | |
| 367 | "Complete keywords in a clocktable line." | |
| 368 | (while (pcomplete-here '(":maxlevel" ":scope" ":lang" | |
| 369 | ":tstart" ":tend" ":block" ":step" | |
| 370 | ":stepskip0" ":fileskip0" | |
| 371 | ":emphasize" ":link" ":narrow" ":indent" | |
| 372 | ":tcolumns" ":level" ":compact" ":timestamp" | |
| 373 | ":formula" ":formatter" ":wstart" ":mstart")))) | |
| 374 | ||
| 375 | (defun org-pcomplete-case-double (list) | |
| 376 | "Return list with both upcase and downcase version of all strings in LIST." | |
| 377 | (let (e res) | |
| 378 | (while (setq e (pop list)) | |
| 379 | (setq res (cons (downcase e) (cons (upcase e) res)))) | |
| 380 | (nreverse res))) | |
| 381 | ||
| 382 | ;;;; Finish up | |
| 383 | ||
| 384 | (provide 'org-pcomplete) | |
| 385 | ||
| 386 | ;;; org-pcomplete.el ends here | |
