Mercurial > emacs
comparison lisp/org/org-complete.el @ 111880:a7740098b594
Update to Org mode 7.4
author | Carsten Dominik <carsten.dominik@gmail.com> |
---|---|
date | Sat, 11 Dec 2010 17:42:53 +0100 |
parents | |
children | 6378d1b57038 |
comparison
equal
deleted
inserted
replaced
111879:4a0faa1cecc2 | 111880:a7740098b594 |
---|---|
1 ;;; org-complete.el --- In-buffer completion code | |
2 | |
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 | |
4 ;; Free Software Foundation, Inc. | |
5 ;; | |
6 ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
7 ;; John Wiegley <johnw at gnu dot org> | |
8 ;; Keywords: outlines, hypermedia, calendar, wp | |
9 ;; Homepage: http://orgmode.org | |
10 ;; Version: 7.4 | |
11 ;; | |
12 ;; This file is part of GNU Emacs. | |
13 ;; | |
14 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
15 ;; it under the terms of the GNU General Public License as published by | |
16 ;; the Free Software Foundation, either version 3 of the License, or | |
17 ;; (at your option) any later version. | |
18 | |
19 ;; GNU Emacs is distributed in the hope that it will be useful, | |
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 ;; GNU General Public License for more details. | |
23 | |
24 ;; You should have received a copy of the GNU General Public License | |
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
27 ;; | |
28 ;;; Code: | |
29 | |
30 ;;;; Require other packages | |
31 | |
32 (eval-when-compile | |
33 (require 'cl)) | |
34 | |
35 (require 'org-macs) | |
36 (require 'pcomplete) | |
37 | |
38 (declare-function org-split-string "org" (string &optional separators)) | |
39 (declare-function org-get-current-options "org-exp" ()) | |
40 (declare-function org-make-org-heading-search-string "org" | |
41 (&optional string heading)) | |
42 (declare-function org-get-buffer-tags "org" ()) | |
43 (declare-function org-get-tags "org" ()) | |
44 (declare-function org-buffer-property-keys "org" | |
45 (&optional include-specials include-defaults include-columns)) | |
46 (declare-function org-entry-properties "org" (&optional pom which specific)) | |
47 | |
48 ;;;; Customization variables | |
49 | |
50 (defgroup org-complete nil | |
51 "Outline-based notes management and organizer." | |
52 :tag "Org" | |
53 :group 'org) | |
54 | |
55 (defun org-thing-at-point () | |
56 "Examine the thing at point and let the caller know what it is. | |
57 The return value is a string naming the thing at point." | |
58 (let ((beg1 (save-excursion | |
59 (skip-chars-backward (org-re "[:alnum:]_@")) | |
60 (point))) | |
61 (beg (save-excursion | |
62 (skip-chars-backward "a-zA-Z0-9_:$") | |
63 (point))) | |
64 (line-to-here (buffer-substring (point-at-bol) (point)))) | |
65 (cond | |
66 ((string-match "\\`[ \t]*#\\+begin: clocktable[ \t]+" line-to-here) | |
67 (cons "block-option" "clocktable")) | |
68 ((string-match "\\`[ \t]*#\\+begin_src[ \t]+" line-to-here) | |
69 (cons "block-option" "src")) | |
70 ((save-excursion | |
71 (re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*" | |
72 (line-beginning-position) t)) | |
73 (cons "file-option" (match-string-no-properties 1))) | |
74 ((string-match "\\`[ \t]*#\\+[a-zA-Z]*\\'" line-to-here) | |
75 (cons "file-option" nil)) | |
76 ((equal (char-before beg) ?\[) | |
77 (cons "link" nil)) | |
78 ((equal (char-before beg) ?\\) | |
79 (cons "tex" nil)) | |
80 ((string-match "\\`\\*+[ \t]+\\'" | |
81 (buffer-substring (point-at-bol) beg)) | |
82 (cons "todo" nil)) | |
83 ((equal (char-before beg) ?*) | |
84 (cons "searchhead" nil)) | |
85 ((and (equal (char-before beg1) ?:) | |
86 (equal (char-after (point-at-bol)) ?*)) | |
87 (cons "tag" nil)) | |
88 ((and (equal (char-before beg1) ?:) | |
89 (not (equal (char-after (point-at-bol)) ?*))) | |
90 (cons "prop" nil)) | |
91 (t nil)))) | |
92 | |
93 (defun org-command-at-point () | |
94 "Return the qualified name of the Org completion entity at point. | |
95 When completing for #+STARTUP, for example, this function returns | |
96 \"file-option/startup\"." | |
97 (let ((thing (org-thing-at-point))) | |
98 (cond | |
99 ((string= "file-option" (car thing)) | |
100 (concat (car thing) "/" (downcase (cdr thing)))) | |
101 ((string= "block-option" (car thing)) | |
102 (concat (car thing) "/" (downcase (cdr thing)))) | |
103 (t | |
104 (car thing))))) | |
105 | |
106 (defun org-parse-arguments () | |
107 "Parse whitespace separated arguments in the current region." | |
108 (let ((begin (line-beginning-position)) | |
109 (end (line-end-position)) | |
110 begins args) | |
111 (save-restriction | |
112 (narrow-to-region begin end) | |
113 (save-excursion | |
114 (goto-char (point-min)) | |
115 (while (not (eobp)) | |
116 (skip-chars-forward " \t\n[") | |
117 (setq begins (cons (point) begins)) | |
118 (skip-chars-forward "^ \t\n[") | |
119 (setq args (cons (buffer-substring-no-properties | |
120 (car begins) (point)) | |
121 args))) | |
122 (cons (reverse args) (reverse begins)))))) | |
123 | |
124 | |
125 (defun org-complete-initial () | |
126 "Calls the right completion function for first argument completions." | |
127 (ignore | |
128 (funcall (or (pcomplete-find-completion-function | |
129 (car (org-thing-at-point))) | |
130 pcomplete-default-completion-function)))) | |
131 | |
132 (defvar org-additional-option-like-keywords) | |
133 (defun pcomplete/org-mode/file-option () | |
134 "Complete against all valid file options." | |
135 (require 'org-exp) | |
136 (pcomplete-here | |
137 (org-complete-case-double | |
138 (mapcar (lambda (x) | |
139 (if (= ?: (aref x (1- (length x)))) | |
140 (concat x " ") | |
141 x)) | |
142 (delq nil | |
143 (pcomplete-uniqify-list | |
144 (append | |
145 (mapcar (lambda (x) | |
146 (if (string-match "^#\\+\\([A-Z_]+:?\\)" x) | |
147 (match-string 1 x))) | |
148 (org-split-string (org-get-current-options) "\n")) | |
149 org-additional-option-like-keywords))))) | |
150 (substring pcomplete-stub 2))) | |
151 | |
152 (defvar org-startup-options) | |
153 (defun pcomplete/org-mode/file-option/startup () | |
154 "Complete arguments for the #+STARTUP file option." | |
155 (while (pcomplete-here | |
156 (let ((opts (pcomplete-uniqify-list | |
157 (mapcar 'car org-startup-options)))) | |
158 ;; Some options are mutually exclusive, and shouldn't be completed | |
159 ;; against if certain other options have already been seen. | |
160 (dolist (arg pcomplete-args) | |
161 (cond | |
162 ((string= arg "hidestars") | |
163 (setq opts (delete "showstars" opts))))) | |
164 opts)))) | |
165 | |
166 (defun pcomplete/org-mode/file-option/bind () | |
167 "Complete arguments for the #+BIND file option, which are variable names" | |
168 (let (vars) | |
169 (mapatoms | |
170 (lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars))))) | |
171 (pcomplete-here vars))) | |
172 | |
173 (defvar org-link-abbrev-alist-local) | |
174 (defvar org-link-abbrev-alist) | |
175 (defun pcomplete/org-mode/link () | |
176 "Complete against defined #+LINK patterns." | |
177 (pcomplete-here | |
178 (pcomplete-uniqify-list (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 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 (org-buffer-property-keys nil t t)))) | |
236 (dolist (prop (org-entry-properties)) | |
237 (setq lst (delete (car prop) lst))) | |
238 lst)) | |
239 (substring pcomplete-stub 1))) | |
240 | |
241 (defun pcomplete/org-mode/block-option/src () | |
242 "Complete the arguments of a begin_src block. | |
243 Complete a language in the first field, the header arguments and switches." | |
244 (pcomplete-here | |
245 (mapcar | |
246 (lambda(x) (symbol-name (nth 3 x))) | |
247 (cdr (car (cdr (memq :key-type (plist-get | |
248 (symbol-plist | |
249 'org-babel-load-languages) | |
250 'custom-type))))))) | |
251 (while (pcomplete-here | |
252 '("-n" "-r" "-l" | |
253 ":cache" ":colnames" ":comments" ":dir" ":eval" ":exports" | |
254 ":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames" | |
255 ":session" ":shebang" ":tangle" ":var")))) | |
256 | |
257 (defun pcomplete/org-mode/block-option/clocktable () | |
258 "Complete keywords in a clocktable line" | |
259 (while (pcomplete-here '(":maxlevel" ":scope" | |
260 ":tstart" ":tend" ":block" ":step" | |
261 ":stepskip0" ":fileskip0" | |
262 ":emphasize" ":link" ":narrow" ":indent" | |
263 ":tcolumns" ":level" ":compact" ":timestamp" | |
264 ":formula" ":formatter")))) | |
265 | |
266 (defun org-complete-case-double (list) | |
267 "Return list with both upcase and downcase version of all strings in LIST." | |
268 (let (e res) | |
269 (while (setq e (pop list)) | |
270 (setq res (cons (downcase e) (cons (upcase e) res)))) | |
271 (nreverse res))) | |
272 | |
273 ;;;; Finish up | |
274 | |
275 (provide 'org-complete) | |
276 | |
277 ;; arch-tag: | |
278 | |
279 ;;; org-complete.el ends here |