org-pcomplete.el 13.4 KB
Newer Older
Rasmus's avatar
Rasmus committed
1
;;; org-pcomplete.el --- In-buffer Completion Code -*- lexical-binding: t; -*-
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2004-2018 Free Software Foundation, Inc.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;;         John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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 27 28 29 30
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:

;;;; Require other packages

(require 'org-macs)
31
(require 'org-compat)
32 33
(require 'pcomplete)

Rasmus's avatar
Rasmus committed
34
(declare-function org-make-org-heading-search-string "org" (&optional string))
35 36 37
(declare-function org-get-buffer-tags "org" ())
(declare-function org-get-tags "org" ())
(declare-function org-buffer-property-keys "org"
Rasmus's avatar
Rasmus committed
38 39 40
		  (&optional specials defaults columns ignore-malformed))
(declare-function org-entry-properties "org" (&optional pom which))
(declare-function org-tag-alist-to-string "org" (alist &optional skip-key))
41 42 43

;;;; Customization variables

44 45
(defvar org-drawer-regexp)
(defvar org-property-re)
Rasmus's avatar
Rasmus committed
46
(defvar org-current-tag-alist)
47

48 49 50 51
(defun org-thing-at-point ()
  "Examine the thing at point and let the caller know what it is.
The return value is a string naming the thing at point."
  (let ((beg1 (save-excursion
Rasmus's avatar
Rasmus committed
52
		(skip-chars-backward "[:alnum:]-_@")
53 54
		(point)))
	(beg (save-excursion
55
	       (skip-chars-backward "a-zA-Z0-9-_:$")
56 57 58 59 60 61 62 63 64 65 66
	       (point)))
	(line-to-here (buffer-substring (point-at-bol) (point))))
    (cond
     ((string-match "\\`[ \t]*#\\+begin: clocktable[ \t]+" line-to-here)
      (cons "block-option" "clocktable"))
     ((string-match "\\`[ \t]*#\\+begin_src[ \t]+" line-to-here)
      (cons "block-option" "src"))
     ((save-excursion
	(re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*"
			    (line-beginning-position) t))
      (cons "file-option" (match-string-no-properties 1)))
67
     ((string-match "\\`[ \t]*#\\+[a-zA-Z_]*\\'" line-to-here)
68 69 70 71 72 73 74 75 76 77 78 79 80 81
      (cons "file-option" nil))
     ((equal (char-before beg) ?\[)
      (cons "link" nil))
     ((equal (char-before beg) ?\\)
      (cons "tex" nil))
     ((string-match "\\`\\*+[ \t]+\\'"
		    (buffer-substring (point-at-bol) beg))
      (cons "todo" nil))
     ((equal (char-before beg) ?*)
      (cons "searchhead" nil))
     ((and (equal (char-before beg1) ?:)
	   (equal (char-after (point-at-bol)) ?*))
      (cons "tag" nil))
     ((and (equal (char-before beg1) ?:)
82 83 84 85 86 87
	   (not (equal (char-after (point-at-bol)) ?*))
	   (save-excursion
	     (move-beginning-of-line 1)
	     (skip-chars-backward "[ \t\n]")
	     ;; org-drawer-regexp matches a whole line but while
	     ;; looking-back, we just ignore trailing whitespaces
Rasmus's avatar
Rasmus committed
88 89 90 91
	     (or (looking-back (substring org-drawer-regexp 0 -1)
			       (line-beginning-position))
		 (looking-back org-property-re
			       (line-beginning-position)))))
92
      (cons "prop" nil))
93 94 95
     ((and (equal (char-before beg1) ?:)
	   (not (equal (char-after (point-at-bol)) ?*)))
      (cons "drawer" nil))
96 97 98 99 100 101 102 103 104
     (t nil))))

(defun org-command-at-point ()
  "Return the qualified name of the Org completion entity at point.
When completing for #+STARTUP, for example, this function returns
\"file-option/startup\"."
  (let ((thing (org-thing-at-point)))
    (cond
     ((string= "file-option" (car thing))
Bastien Guerry's avatar
Bastien Guerry committed
105 106
      (concat (car thing)
	      (and (cdr thing) (concat "/" (downcase (cdr thing))))))
107 108
     ((string= "block-option" (car thing))
      (concat (car thing) "/" (downcase (cdr thing))))
Bastien Guerry's avatar
Bastien Guerry committed
109
     (t (car thing)))))
110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135

(defun org-parse-arguments ()
  "Parse whitespace separated arguments in the current region."
  (let ((begin (line-beginning-position))
	(end (line-end-position))
	begins args)
    (save-restriction
      (narrow-to-region begin end)
      (save-excursion
	(goto-char (point-min))
	(while (not (eobp))
	  (skip-chars-forward " \t\n[")
	  (setq begins (cons (point) begins))
	  (skip-chars-forward "^ \t\n[")
	  (setq args (cons (buffer-substring-no-properties
			    (car begins) (point))
			   args)))
	(cons (reverse args) (reverse begins))))))

(defun org-pcomplete-initial ()
  "Calls the right completion function for first argument completions."
  (ignore
   (funcall (or (pcomplete-find-completion-function
		 (car (org-thing-at-point)))
		pcomplete-default-completion-function))))

Bastien Guerry's avatar
Bastien Guerry committed
136 137 138
(defvar org-options-keywords)		 ; From org.el
(defvar org-element-affiliated-keywords) ; From org-element.el
(declare-function org-get-export-keywords "org" ())
139 140
(defun pcomplete/org-mode/file-option ()
  "Complete against all valid file options."
Bastien Guerry's avatar
Bastien Guerry committed
141
  (require 'org-element)
142 143
  (pcomplete-here
   (org-pcomplete-case-double
Bastien Guerry's avatar
Bastien Guerry committed
144 145 146 147 148
    (append (mapcar (lambda (keyword) (concat keyword " "))
		    org-options-keywords)
	    (mapcar (lambda (keyword) (concat keyword ": "))
		    org-element-affiliated-keywords)
	    (let (block-names)
Rasmus's avatar
Rasmus committed
149 150 151 152 153 154 155 156 157 158 159 160 161
	      (dolist (name
		       '("CENTER" "COMMENT" "EXAMPLE" "EXPORT" "QUOTE" "SRC"
			 "VERSE")
		       block-names)
		(push (format "END_%s" name) block-names)
		(push (concat "BEGIN_"
			      name
			      ;; Since language is compulsory in
			      ;; export blocks source blocks, add
			      ;; a space.
			      (and (member name '("EXPORT" "SRC")) " "))
		      block-names)
		(push (format "ATTR_%s: " name) block-names)))
Bastien Guerry's avatar
Bastien Guerry committed
162 163
	    (mapcar (lambda (keyword) (concat keyword ": "))
		    (org-get-export-keywords))))
164
   (substring pcomplete-stub 2)))
165

Bastien Guerry's avatar
Bastien Guerry committed
166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196
(defun pcomplete/org-mode/file-option/author ()
  "Complete arguments for the #+AUTHOR file option."
  (pcomplete-here (list user-full-name)))

(defvar org-time-stamp-formats)
(defun pcomplete/org-mode/file-option/date ()
  "Complete arguments for the #+DATE file option."
  (pcomplete-here (list (format-time-string (car org-time-stamp-formats)))))

(defun pcomplete/org-mode/file-option/email ()
  "Complete arguments for the #+EMAIL file option."
  (pcomplete-here (list user-mail-address)))

(defvar org-export-exclude-tags)
(defun pcomplete/org-mode/file-option/exclude_tags ()
  "Complete arguments for the #+EXCLUDE_TAGS file option."
  (require 'ox)
  (pcomplete-here
   (and org-export-exclude-tags
	(list (mapconcat 'identity org-export-exclude-tags " ")))))

(defvar org-file-tags)
(defun pcomplete/org-mode/file-option/filetags ()
  "Complete arguments for the #+FILETAGS file option."
  (pcomplete-here (and org-file-tags (mapconcat 'identity org-file-tags " "))))

(defvar org-export-default-language)
(defun pcomplete/org-mode/file-option/language ()
  "Complete arguments for the #+LANGUAGE file option."
  (require 'ox)
  (pcomplete-here
Paul Eggert's avatar
Paul Eggert committed
197
   (pcomplete-uniquify-list
Bastien Guerry's avatar
Bastien Guerry committed
198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217
    (list org-export-default-language "en"))))

(defvar org-default-priority)
(defvar org-highest-priority)
(defvar org-lowest-priority)
(defun pcomplete/org-mode/file-option/priorities ()
  "Complete arguments for the #+PRIORITIES file option."
  (pcomplete-here (list (format "%c %c %c"
				org-highest-priority
				org-lowest-priority
				org-default-priority))))

(defvar org-export-select-tags)
(defun pcomplete/org-mode/file-option/select_tags ()
  "Complete arguments for the #+SELECT_TAGS file option."
  (require 'ox)
  (pcomplete-here
   (and org-export-select-tags
	(list (mapconcat 'identity org-export-select-tags " ")))))

218 219 220 221
(defvar org-startup-options)
(defun pcomplete/org-mode/file-option/startup ()
  "Complete arguments for the #+STARTUP file option."
  (while (pcomplete-here
Paul Eggert's avatar
Paul Eggert committed
222
	  (let ((opts (pcomplete-uniquify-list
223 224 225 226 227 228 229 230 231
		       (mapcar 'car org-startup-options))))
	    ;; Some options are mutually exclusive, and shouldn't be completed
	    ;; against if certain other options have already been seen.
	    (dolist (arg pcomplete-args)
	      (cond
	       ((string= arg "hidestars")
		(setq opts (delete "showstars" opts)))))
	    opts))))

Bastien Guerry's avatar
Bastien Guerry committed
232 233 234
(defun pcomplete/org-mode/file-option/tags ()
  "Complete arguments for the #+TAGS file option."
  (pcomplete-here
Rasmus's avatar
Rasmus committed
235
   (list (org-tag-alist-to-string org-current-tag-alist))))
236 237 238

(defun pcomplete/org-mode/file-option/title ()
  "Complete arguments for the #+TITLE file option."
Bastien Guerry's avatar
Bastien Guerry committed
239 240 241 242 243 244
  (pcomplete-here
   (let ((visited-file (buffer-file-name (buffer-base-buffer))))
     (list (or (and visited-file
		    (file-name-sans-extension
		     (file-name-nondirectory visited-file)))
	       (buffer-name (buffer-base-buffer)))))))
245 246


Paul Eggert's avatar
Paul Eggert committed
247
(declare-function org-export-backend-options "ox" (cl-x) t)
Bastien Guerry's avatar
Bastien Guerry committed
248 249 250
(defun pcomplete/org-mode/file-option/options ()
  "Complete arguments for the #+OPTIONS file option."
  (while (pcomplete-here
Paul Eggert's avatar
Paul Eggert committed
251
	  (pcomplete-uniquify-list
Bastien Guerry's avatar
Bastien Guerry committed
252 253 254 255 256 257 258 259
	   (append
	    ;; Hard-coded OPTION items always available.
	    '("H:" "\\n:" "num:" "timestamp:" "arch:" "author:" "c:"
	      "creator:" "date:" "d:" "email:" "*:" "e:" "::" "f:"
	      "inline:" "tex:" "p:" "pri:" "':" "-:" "stat:" "^:" "toc:"
	      "|:" "tags:" "tasks:" "<:" "todo:")
	    ;; OPTION items from registered back-ends.
	    (let (items)
Rasmus's avatar
Rasmus committed
260 261
	      (dolist (backend (bound-and-true-p
				org-export-registered-backends))
Bastien Guerry's avatar
Bastien Guerry committed
262 263 264 265 266 267 268 269
		(dolist (option (org-export-backend-options backend))
		  (let ((item (nth 2 option)))
		    (when item (push (concat item ":") items)))))
	      items))))))

(defun pcomplete/org-mode/file-option/infojs_opt ()
  "Complete arguments for the #+INFOJS_OPT file option."
  (while (pcomplete-here
Paul Eggert's avatar
Paul Eggert committed
270
	  (pcomplete-uniquify-list
Bastien Guerry's avatar
Bastien Guerry committed
271
	   (mapcar (lambda (item) (format "%s:" (car item)))
Rasmus's avatar
Rasmus committed
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 277 278 279 280 281 282 283 284 285
  (let (vars)
    (mapatoms
     (lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars)))))
    (pcomplete-here vars)))

(defvar org-link-abbrev-alist-local)
(defvar org-link-abbrev-alist)
(defun pcomplete/org-mode/link ()
  "Complete against defined #+LINK patterns."
  (pcomplete-here
Paul Eggert's avatar
Paul Eggert committed
286
   (pcomplete-uniquify-list
287 288 289 290 291 292 293 294 295
    (copy-sequence
     (append (mapcar 'car org-link-abbrev-alist-local)
	     (mapcar 'car org-link-abbrev-alist))))))

(defvar org-entities)
(defun pcomplete/org-mode/tex ()
  "Complete against TeX-style HTML entity names."
  (require 'org-entities)
  (while (pcomplete-here
Paul Eggert's avatar
Paul Eggert committed
296
	  (pcomplete-uniquify-list (remove nil (mapcar 'car-safe org-entities)))
297 298 299 300 301
	  (substring pcomplete-stub 1))))

(defvar org-todo-keywords-1)
(defun pcomplete/org-mode/todo ()
  "Complete against known TODO keywords."
Paul Eggert's avatar
Paul Eggert committed
302
  (pcomplete-here (pcomplete-uniquify-list (copy-sequence org-todo-keywords-1))))
303 304 305 306 307 308

(defvar org-todo-line-regexp)
(defun pcomplete/org-mode/searchhead ()
  "Complete against all headings.
This needs more work, to handle headings with lots of spaces in them."
  (while
309 310 311 312
      (pcomplete-here
       (save-excursion
	 (goto-char (point-min))
	 (let (tbl)
Rasmus's avatar
Rasmus committed
313 314 315 316 317
	   (let ((case-fold-search nil))
	     (while (re-search-forward org-todo-line-regexp nil t)
	       (push (org-make-org-heading-search-string
		      (match-string-no-properties 3))
		     tbl)))
Paul Eggert's avatar
Paul Eggert committed
318
	   (pcomplete-uniquify-list tbl)))
319
       (substring pcomplete-stub 1))))
320 321 322 323

(defun pcomplete/org-mode/tag ()
  "Complete a tag name.  Omit tags already set."
  (while (pcomplete-here
Rasmus's avatar
Rasmus committed
324
	  (mapcar (lambda (x) (concat x ":"))
Paul Eggert's avatar
Paul Eggert committed
325
		  (let ((lst (pcomplete-uniquify-list
Rasmus's avatar
Rasmus committed
326
			      (or (remq
327
				   nil
Rasmus's avatar
Rasmus committed
328 329 330
				   (mapcar (lambda (x) (org-string-nw-p (car x)))
					   org-current-tag-alist))
				  (mapcar #'car (org-get-buffer-tags))))))
331 332 333 334 335 336 337 338 339 340 341
		    (dolist (tag (org-get-tags))
		      (setq lst (delete tag lst)))
		    lst))
	  (and (string-match ".*:" pcomplete-stub)
	       (substring pcomplete-stub (match-end 0))))))

(defun pcomplete/org-mode/prop ()
  "Complete a property name.  Omit properties already set."
  (pcomplete-here
   (mapcar (lambda (x)
	     (concat x ": "))
Paul Eggert's avatar
Paul Eggert committed
342
	   (let ((lst (pcomplete-uniquify-list
343
		       (copy-sequence
Rasmus's avatar
Rasmus committed
344
			(org-buffer-property-keys nil t t t)))))
345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363
	     (dolist (prop (org-entry-properties))
	       (setq lst (delete (car prop) lst)))
	     lst))
   (substring pcomplete-stub 1)))

(defun pcomplete/org-mode/block-option/src ()
  "Complete the arguments of a begin_src block.
Complete a language in the first field, the header arguments and switches."
  (pcomplete-here
   (mapcar
    (lambda(x) (symbol-name (nth 3 x)))
    (cdr (car (cdr (memq :key-type (plist-get
				    (symbol-plist
				     'org-babel-load-languages)
				    'custom-type)))))))
  (while (pcomplete-here
	  '("-n" "-r" "-l"
	    ":cache" ":colnames" ":comments" ":dir" ":eval" ":exports"
	    ":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames"
Bastien Guerry's avatar
Bastien Guerry committed
364
	    ":session" ":shebang" ":tangle" ":tangle-mode" ":var"))))
365 366

(defun pcomplete/org-mode/block-option/clocktable ()
367
  "Complete keywords in a clocktable line."
Bastien Guerry's avatar
Bastien Guerry committed
368
  (while (pcomplete-here '(":maxlevel" ":scope" ":lang"
369 370 371 372
			   ":tstart" ":tend" ":block" ":step"
			   ":stepskip0" ":fileskip0"
			   ":emphasize" ":link" ":narrow" ":indent"
			   ":tcolumns" ":level" ":compact" ":timestamp"
Bastien Guerry's avatar
Bastien Guerry committed
373
			   ":formula" ":formatter" ":wstart" ":mstart"))))
374 375 376 377 378 379 380 381 382 383 384 385 386

(defun org-pcomplete-case-double (list)
  "Return list with both upcase and downcase version of all strings in LIST."
  (let (e res)
    (while (setq e (pop list))
      (setq res (cons (downcase e) (cons (upcase e) res))))
    (nreverse res)))

;;;; Finish up

(provide 'org-pcomplete)

;;; org-pcomplete.el ends here