mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-21 e75a20334813452c6912c090d70a0de2c805f94d
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