Mercurial > emacs
annotate lisp/textmodes/org.el @ 59301:34f8020b42d5
*** empty log message ***
author | Jay Belanger <jay.p.belanger@gmail.com> |
---|---|
date | Sun, 02 Jan 2005 06:56:51 +0000 |
parents | c636a3aa7ec9 |
children | 998101ef8562 e4029991605f |
rev | line source |
---|---|
58792 | 1 ;; org.el --- Outline-based notes management and organizer |
2 | |
58794 | 3 ;; Copyright (c) 2003, 2004 Free Software Foundation |
58792 | 4 |
5 ;; Author: Carsten Dominik <dominik at science dot uva dot nl> | |
6 ;; Keywords: outlines, hypermedia, calendar | |
7 ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ | |
58841
c636a3aa7ec9
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-718
Miles Bader <miles@gnu.org>
parents:
58833
diff
changeset
|
8 ;; Version: 3.03 |
58792 | 9 |
58794 | 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 2, or (at your option) | |
58792 | 15 ;; any later version. |
16 | |
58794 | 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. | |
58792 | 21 |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 ;; Boston, MA 02111-1307, USA. | |
26 | |
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
28 ;; Carsten's outline-mode for keeping track of everything. | |
29 ;; | |
30 ;;; Commentary: | |
31 ;; | |
32 ;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing | |
33 ;; project planning with a fast and effective plain-text system. | |
34 ;; | |
35 ;; Org-mode develops organizational tasks around a NOTES file that contains | |
36 ;; information about projects as plain text. Org-mode is implemented on | |
37 ;; top of outline-mode - ideal to keep the content of large files well | |
38 ;; structured. It supports ToDo items, deadlines and time stamps, which | |
39 ;; magically appear in the diary listing of the Emacs calendar. Tables are | |
40 ;; easily created with a built-in table editor. Plain text URL-like links | |
41 ;; connect to websites, emails (VM,RMAIL,WANDERLUST), Usenet messages (Gnus), | |
42 ;; BBDB entries, and any files related to the projects. For printing and | |
43 ;; sharing of notes, an Org-mode file (or a part of it) can be exported as | |
44 ;; a structured ASCII file, or as HTML. | |
45 ;; | |
46 ;; Installation | |
47 ;; ------------ | |
48 ;; The instruction below assume that you have downloaded Org-mode from the | |
49 ;; web. If Org-mode is part of the Emacs distribution or an XEmacs package, | |
50 ;; you only need to add to .emacs the last three lines of Lisp code listed | |
51 ;; below, i.e. the `auto-mode-alist' modification and the global key bindings. | |
52 ;; | |
53 ;; Byte-compile org.el and put it on your load path. Then copy the | |
54 ;; following lines into .emacs. The last two lines define *global* | |
55 ;; keys for the commands `org-store-link' and `org-agenda' - please | |
56 ;; choose suitable keys yourself. | |
57 ;; | |
58 ;; (autoload 'org-mode "org" "Org mode" t) | |
59 ;; (autoload 'org-diary "org" "Diary entries from Org mode") | |
60 ;; (autoload 'org-agenda "org" "Multi-file agenda from Org mode" t) | |
61 ;; (autoload 'org-store-link "org" "Store a link to the current location" t) | |
62 ;; (add-to-list 'auto-mode-alist '("\\.org$" . org-mode)) | |
63 ;; (define-key global-map "\C-cl" 'org-store-link) | |
64 ;; (define-key global-map "\C-ca" 'org-agenda) | |
65 ;; | |
66 ;; This will put all files with extension ".org" into Org-mode. As an | |
67 ;; alternative, make the first line of a file look like this: | |
68 ;; | |
69 ;; MY PROJECTS -*- mode: org; -*- | |
70 ;; | |
71 ;; which will select Org-mode for this buffer no matter what the file's | |
72 ;; name is. | |
73 ;; | |
74 ;; Documentation | |
75 ;; ------------- | |
76 ;; The documentation of Org-mode can be found in the TeXInfo file. | |
77 ;; This distribution also contains a PDF version of it. At the homepage | |
78 ;; of Org-mode, you can find and read online the same text as HTML. | |
79 ;; | |
80 ;; Changes: | |
81 ;; ------- | |
82 ;; Version 3.03 | |
83 ;; - Copyright transfer to the FSF. | |
84 ;; - Effect of C-u and C-u C-u in org-timeline interchanged. | |
85 ;; - Timeline now always contains today, and `.' jumps to it. | |
86 ;; - Table editor: | |
87 ;; - cut and paste of regtangular regions in tables | |
88 ;; - command to convert org-mode table to table.el table and back | |
89 ;; - command to treat several cells like a paragraph and fill it | |
90 ;; - command to convert a buffer region to a table | |
91 ;; - import/export tables as tab-separated files (exchange with Excel) | |
92 ;; - Agenda: | |
93 ;; - Sorting mechanism for agenda items rewritten from scratch. | |
94 ;; - Sorting fully configurable. | |
95 ;; - Entries specifying a time are sorted together. | |
96 ;; - Completion also covers option keywords after `#-'. | |
97 ;; - Bug fixes. | |
98 ;; | |
99 ;; Version 3.01 | |
100 ;; - New reference card, thanks to Philip Rooke for creating it. | |
101 ;; - Single file agenda renamed to "Timeline". It no longer shows | |
102 ;; warnings about upcoming deadlines/overdue scheduled items. | |
103 ;; That functionality is now limited to the (multifile) agenda. | |
104 ;; - When reading a date, the calendar can be manipulated with keys. | |
105 ;; - Link support for RMAIL and Wanderlust (from planner.el, untested) | |
106 ;; - Minor bug fixes and documentation improvements. | |
107 ;; | |
108 ;; Version 3.00 | |
109 ;; - Multifile Agenda shows current entries from many different files. | |
110 ;; - TeXInfo documentation (thanks to Christian Egli for the conversion). | |
111 ;; - Additional applications for TODO keywords, see documentation. | |
112 ;; Different files may have different TODO keywords etc. | |
113 ;; - Priorities for TODO items. | |
114 ;; - The browser mode used by `org-remember-handler' is improved. | |
115 ;; - Images get inlined in HTML export (thanks to Carsten Wimmer). | |
116 ;; - File links can contain line numbers, like file:/usr/etc/config:255 | |
117 ;; - Minor bug fixes. | |
118 ;; | |
119 ;; Version 2.10 | |
120 ;; - TODO entries can have additional states besides TODO and DONE. | |
121 ;; See new variable `org-todo-keywords'. | |
122 ;; - TODO keywords can be interpreted as categories. See variable | |
123 ;; `org-todo-interpretation'. | |
124 ;; - M-TAB completion on TODO keywords, TeX symbols, and normal words. | |
125 ;; - All keywords (like TODO, DEADLINE etc) are configurable. | |
126 ;; - Cursor positioning optimized after pro/demotion and TODO cycling. | |
127 ;; - Emphasizing in HTML works now for *bold*, /italic/ and _underline_. | |
128 ;; - New commands to kill, copy and yank entire subtrees. Yanking | |
129 ;; modifies the level of the tree before insertion. | |
130 ;; - New command `org-goto' (C-c C-j) to quickly move to other locations | |
131 ;; in the buffer without affecting outline visibility. | |
132 ;; - Hooks for John Wiegley's remember.el. | |
133 ;; - `org-read-date' pops up calendar for date selection with the mouse. | |
134 ;; See variable `org-popup-calendar-for-date-prompt'. | |
135 ;; | |
136 ;; Version 2.6 | |
137 ;; - TODO items can be SCHEDULED to a certain date. | |
138 ;; - Expired DEADLINEs are ignored if in an entry marked DONE. | |
139 ;; - From the diary or time-sorted view (C-c C-r), C-c C-t can be used to | |
140 ;; change the TODO state of an item remotely. | |
141 ;; - Horizontal computations in table editor. See `org-table-eval-formula'. | |
142 ;; - Fixed bug with summing tables (command `org-table-sum', `C-c +'). | |
143 ;; - Calendar window follows the timestamp when a timestamp is changed. | |
144 ;; New variable `org-calendar-follow-timestamp-change'. | |
145 ;; - Time-sorted view (`org-diary-view', C-c C-r) now uses the prefix | |
146 ;; argument to force inclusion of unscheduled TODO items. | |
147 ;; - New variable `org-confirm-shell-links' to turn of safety query. | |
148 ;; - New variable `org-open-non-existing-files'. | |
149 ;; | |
150 ;; Version 2.4 | |
151 ;; - A time-sorted view on all time stamps can be created with C-c C-r. | |
152 ;; - Timestamps and Deadlines can be shown in the Emacs diary. | |
153 ;; - Date ranges introduced. | |
154 ;; - Time-string formats are no longer configurable. | |
155 ;; - Vertical lines in tables can be made invisible with `C-c |'. | |
156 ;; - New "link" type to execute shell commands, like "shell:ls *.org" | |
157 ;; - Upon export, "myfile.org" becomes "myfile.html" or "myfile.txt", | |
158 ;; instead of "myfile.org.html" or "myfile.org.txt". | |
159 ;; - When the cursor is in the white space at the beginning of a line, | |
160 ;; TAB removes the whitespace before indenting again. | |
161 ;; | |
162 ;; Version 2.0 | |
163 ;; - Windows (NT/2000) support. | |
164 ;; - Works with both Emacs and XEmacs. | |
165 ;; - Fully automatic table editor. | |
166 ;; - New link types into Gnus, VM and BBDB. | |
167 ;; - Other link system changes | |
168 ;; - Time stamps are treated as links to the calendar. | |
169 ;; - Easy creation of links with global command `org-store-link'. | |
170 ;; - Insertion of links with `C-c C-l' works differently now. | |
171 ;; - Space characters allowed as part of a link. | |
172 ;; - Options in `org-file-apps' extended. The command may now be | |
173 ;; symbol 'emacs', or a lisp form. | |
174 ;; Please re-read the manual section about links. | |
175 ;; - Timestamp changes | |
176 ;; - `org-deadline' now prompts for a date. | |
177 ;; - A line can now contain several timestamps. Updating of a | |
178 ;; timestamp only happens if the cursor is at the timestamp. | |
179 ;; - Changed the time-stamp-format to ISO, to make sure it will | |
180 ;; always work (non-English month names had caused problems | |
181 ;; with `parse-time-string'.). Changing the time stamp format | |
182 ;; is not recommended. | |
183 ;; - Picture mode enhancements have been removed from org.el | |
184 ;; | |
185 ;; Version 1.4 | |
186 ;; - Some option name changes, not backward compatible. | |
187 ;; - ASCII exporter upgrade: Table of contents. | |
188 ;; - HTML exporter upgrade: fixed-width regions, better | |
189 ;; sub/superscripts, many TeX symbols supported. | |
190 ;; - Calendar support. | |
191 ;; | |
192 ;; Version 1.3 | |
193 ;; - HTML exporter upgrade, in particular table of contents | |
194 ;; | |
195 ;; Version 1.0 | |
196 ;; - Initial release | |
197 | |
198 ;;; Code: | |
199 | |
200 (eval-when-compile (require 'cl)) | |
201 (require 'outline) | |
202 (require 'time-date) | |
203 (require 'easymenu) | |
204 | |
205 ;;; Customization variables | |
206 | |
207 (defvar org-version "3.03" | |
208 "The version number of the file org.el.") | |
209 (defun org-version (arg) | |
210 (interactive "P") | |
211 (message "Org-mode version %s" org-version)) | |
212 | |
213 ;; The following two constants are for compatibility with different | |
214 ;; Emacs versions (Emacs versus XEmacs) and with different versions of | |
215 ;; outline.el. All the compatibility code in org.el is based on these two | |
216 ;; constants. | |
217 (defconst org-xemacs-p (featurep 'xemacs) | |
218 "Are we running xemacs?") | |
219 (defconst org-noutline-p (featurep 'noutline) | |
220 "Are we using the new outline mode?") | |
221 | |
222 (defgroup org nil | |
223 "Outline-based notes management and organizer " | |
224 :tag "Org" | |
225 :group 'outlines | |
226 :group 'hypermedia | |
227 :group 'calendar) | |
228 | |
229 (defgroup org-startup nil | |
230 "Options concerning startup of Org-mode." | |
231 :tag "Org Startup" | |
232 :group 'org) | |
233 | |
234 (defcustom org-startup-folded t | |
235 "Non-nil means, entering Org-mode will switch to OVERVIEW." | |
236 :group 'org-startup | |
237 :type 'boolean) | |
238 | |
239 (defcustom org-startup-truncated t | |
240 "Non-nil means, entering Org-mode will set `truncate-lines'. | |
241 This is useful since some lines containing links can be very long and | |
242 uninteresting. Also tables look terrible when wrapped." | |
243 :group 'org-startup | |
244 :type 'boolean) | |
245 | |
246 (defcustom org-startup-with-deadline-check nil | |
247 "Non-nil means, entering Org-mode will run the deadline check. | |
248 This means, if you start editing an org file, you will get an | |
249 immediate reminder of any due deadlines." | |
250 :group 'org-startup | |
251 :type 'boolean) | |
252 | |
253 (defcustom org-insert-mode-line-in-empty-file t | |
254 "Non-nil means insert the first line setting Org-mode in empty files. | |
255 When the function `org-mode' is called interactively in an empty, this | |
256 normally means that the file name does not automatically trigger Org-mode. | |
257 To ensure that the file will always be in Org-mode in the future, a | |
258 line enforcing Org-mode can be inserted into the buffer." | |
259 :group 'org-startup | |
260 :type 'boolean) | |
261 | |
262 (defgroup org-keywords nil | |
263 "Options concerning TODO items in Org-mode." | |
264 :tag "Org Keywords" | |
265 :group 'org) | |
266 | |
267 (defcustom org-todo-keywords '("TODO" "DONE") | |
268 "List of TODO entry keywords.\\<org-mode-map> | |
269 By default, this is '(\"TODO\" \"DONE\"). The last entry in the list is | |
270 considered to mean that the entry is \"done\". All the other mean that | |
271 action is required, and will make the entry show up in todo lists, diaries | |
272 etc. | |
273 The command \\[org-todo] cycles an entry through these states, and an | |
274 additional state where no keyword is present. For details about this | |
275 cycling, see also the variable `org-todo-interpretation' | |
276 Changes become only effective after restarting Emacs." | |
277 :group 'org-keywords | |
278 :type '(repeat (string :tag "Keyword"))) | |
279 | |
280 (defcustom org-todo-interpretation 'sequence | |
281 "Controls how TODO keywords are interpreted.\\<org-mode-map> | |
282 Possible values are `sequence' and `type'. | |
283 This variable is only relevant if `org-todo-keywords' contains more than two | |
284 states. There are two ways how these keywords can be used: | |
285 | |
286 - As a sequence in the process of working on a TODO item, for example | |
287 (setq org-todo-keywords '(\"TODO\" \"STARTED\" \"VERIFY\" \"DONE\") | |
288 org-todo-interpretation 'sequence) | |
289 | |
290 - As different types of TODO items, for example | |
291 (setq org-todo-keywords '(\"URGENT\" \"RELAXED\" \"REMIND\" \"FOR_TOM\" \"DONE\") | |
292 org-todo-interpretation 'type) | |
293 | |
294 When the states are interpreted as a sequence, \\[org-todo] always cycles | |
295 to the next state, in order to walk through all different states. So with | |
296 \\[org-todo], you turn an empty entry into the state TODO. When you started | |
297 working on the item, you use \\[org-todo] again to switch it to \"STARTED\", | |
298 later to VERIFY and finally to DONE. | |
299 | |
300 When the states are interpreted as types, \\[org-todo] still cycles through | |
301 when it is called several times in direct succession, in order to initially | |
302 select the type. However, if not called immediately after a previous | |
303 \\[org-todo], it switches from each type directly to DONE. So with the | |
304 above example, you could use `\\[org-todo] \\[org-todo]' to label an entry | |
305 RELAXED. If you later return to this entry and press \\[org-todo] again, | |
306 RELAXED will not be changed REMIND, but directly to DONE. | |
307 | |
308 You can create a large number of types. To initially select a | |
309 type, it is then best to use C-u \\[org-todo] in order to specify the | |
310 type with completion. Of course, you can also type the keyword | |
311 directly into the buffer. M-TAB completes TODO keywords at the | |
312 beginning of a headline." | |
313 :group 'org-keywords | |
314 :type '(choice (const sequence) | |
315 (const type))) | |
316 | |
317 (defcustom org-default-priority ?B | |
318 "The default priority of TODO items. | |
319 This is the priority an item get if no explicit priority is given." | |
320 :group 'org-keywords | |
321 :type 'character) | |
322 | |
323 (defcustom org-lowest-priority ?C | |
324 "The lowest priority of TODO items. A character like ?A, ?B etc." | |
325 :group 'org-keywords | |
326 :type 'character) | |
327 | |
328 (defcustom org-deadline-string "DEADLINE:" | |
329 "String to mark deadline entries. | |
330 A deadline is this string, followed by a time stamp. Should be a word, | |
331 terminated by a colon. You can insert a schedule keyword and | |
332 a timestamp with \\[org-deadline]. | |
333 Changes become only effective after restarting Emacs." | |
334 :group 'org-keywords | |
335 :type 'string) | |
336 | |
337 (defcustom org-scheduled-string "SCHEDULED:" | |
338 "String to mark scheduled TODO entries. | |
339 A schedule is this string, followed by a time stamp. Should be a word, | |
340 terminated by a colon. You can insert a schedule keyword and | |
341 a timestamp with \\[org-schedule]. | |
342 Changes become only effective after restarting Emacs." | |
343 :group 'org-keywords | |
344 :type 'string) | |
345 | |
346 (defcustom org-comment-string "COMMENT" | |
347 "Entries starting with this keyword will never be exported. | |
348 An entry can be toggled between COMMENT and normal with | |
349 \\[org-toggle-comment]. | |
350 Changes become only effective after restarting Emacs." | |
351 :group 'org-keywords | |
352 :type 'string) | |
353 | |
354 (defcustom org-after-todo-state-change-hook nil | |
355 "Hook which is run after the state of a TODO item was changed. | |
356 The new state (a string with a todo keyword, or nil) is available in the | |
357 lisp variable `state'." | |
358 :group 'org-keywords | |
359 :type 'hook) | |
360 | |
361 ;; Variables for pre-computed regular expressions, all buffer local | |
362 (defvar org-todo-kwd-priority-p nil | |
363 "Do TODO items have priorities?") | |
364 (make-variable-buffer-local 'org-todo-kwd-priority-p) | |
365 (defvar org-todo-kwd-max-priority nil | |
366 "Maximum priority of TODO items") | |
367 (make-variable-buffer-local 'org-todo-kwd-max-priority) | |
368 (defvar org-ds-keyword-length 12 | |
369 "Maximum length of the Deadline and SCHEDULED keywords.") | |
370 (make-variable-buffer-local 'org-ds-keyword-length) | |
371 (defvar org-done-string nil | |
372 "The last string in `org-todo-keywords', indicating an item is DONE.") | |
373 (make-variable-buffer-local 'org-done-string) | |
374 (defvar org-todo-regexp nil | |
375 "Matches any of the TODO state keywords.") | |
376 (make-variable-buffer-local 'org-todo-regexp) | |
377 (defvar org-not-done-regexp nil | |
378 "Matches any of the TODO state keywords except the last one.") | |
379 (make-variable-buffer-local 'org-not-done-regexp) | |
380 (defvar org-todo-line-regexp nil | |
381 "Matches a headline and puts TODO state into group 2 if present.") | |
382 (make-variable-buffer-local 'org-todo-line-regexp) | |
383 (defvar orb-nl-done-regexp nil | |
384 "Matches newline followed by a headline with the DONE keyword.") | |
385 (make-variable-buffer-local 'orb-nl-done-regexp) | |
386 (defvar org-looking-at-done-regexp nil | |
387 "Matches the DONE keyword a point.") | |
388 (make-variable-buffer-local 'org-looking-at-done-regexp) | |
389 (defvar org-deadline-regexp nil | |
390 "Matches the DEADLINE keyword.") | |
391 (make-variable-buffer-local 'org-deadline-regexp) | |
392 (defvar org-deadline-time-regexp nil | |
393 "Matches the DEADLINE keyword together with a time stamp.") | |
394 (make-variable-buffer-local 'org-deadline-time-regexp) | |
395 (defvar org-deadline-line-regexp nil | |
396 "Matches the DEADLINE keyword and the rest of the line.") | |
397 (make-variable-buffer-local 'org-deadline-line-regexp) | |
398 (defvar org-scheduled-regexp nil | |
399 "Matches the SCHEDULED keyword.") | |
400 (make-variable-buffer-local 'org-scheduled-regexp) | |
401 (defvar org-scheduled-time-regexp nil | |
402 "Matches the SCHEDULED keyword together with a time stamp.") | |
403 (make-variable-buffer-local 'org-scheduled-time-regexp) | |
404 | |
405 (defun org-set-regexps () | |
406 "Precompute regular expressions for current buffer." | |
407 (when (eq major-mode 'org-mode) | |
408 (let ((re (org-make-options-regexp | |
409 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO"))) | |
410 (splitre "[ \t]+") | |
411 kwds int key value cat) | |
412 (save-restriction | |
413 (save-excursion | |
414 (widen) | |
415 (goto-char (point-min)) | |
416 (while (re-search-forward re nil t) | |
417 (setq key (match-string 1) value (match-string 2)) | |
418 (cond | |
419 ((equal key "CATEGORY") | |
420 (setq cat (intern (car (org-split-string value splitre))))) | |
421 ((equal key "SEQ_TODO") | |
422 (setq int 'sequence | |
423 kwds (append kwds (org-split-string value splitre)))) | |
424 ((equal key "PRI_TODO") | |
425 (setq int 'priority | |
426 kwds (append kwds (org-split-string value splitre)))) | |
427 ((equal key "TYP_TODO") | |
428 (setq int 'type | |
429 kwds (append kwds (org-split-string value splitre))))) | |
430 ))) | |
431 (and cat (set (make-local-variable 'org-category) cat)) | |
432 (and kwds (set (make-local-variable 'org-todo-keywords) kwds)) | |
433 (and int (set (make-local-variable 'org-todo-interpretation) int))) | |
434 ;; Compute the regular expressions and other local variables | |
435 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) | |
436 org-todo-kwd-max-priority (1- (length org-todo-keywords)) | |
437 org-ds-keyword-length (+ 2 (max (length org-deadline-string) | |
438 (length org-scheduled-string))) | |
439 org-done-string | |
440 (nth (1- (length org-todo-keywords)) org-todo-keywords) | |
441 org-todo-regexp | |
442 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords | |
443 "\\|") "\\)\\>") | |
444 org-not-done-regexp | |
445 (concat "\\<\\(" | |
446 (mapconcat 'regexp-quote | |
447 (nreverse (cdr (reverse org-todo-keywords))) | |
448 "\\|") | |
449 "\\)\\>") | |
450 org-todo-line-regexp | |
451 (concat "^\\(\\*+\\)[ \t]*\\(" | |
452 (mapconcat 'regexp-quote org-todo-keywords "\\|") | |
453 "\\)? *\\(.*\\)") | |
454 orb-nl-done-regexp | |
455 (concat "[\r\n]\\*+[ \t]+" org-done-string "\\>") | |
456 org-looking-at-done-regexp (concat "^" org-done-string "\\>") | |
457 org-deadline-regexp (concat "\\<" org-deadline-string) | |
458 org-deadline-time-regexp | |
459 (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") | |
460 org-deadline-line-regexp | |
461 (concat "\\<\\(" org-deadline-string "\\).*") | |
462 org-scheduled-regexp | |
463 (concat "\\<" org-scheduled-string) | |
464 org-scheduled-time-regexp | |
465 (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) | |
466 (org-set-font-lock-defaults))) | |
467 | |
468 ;(add-hook 'hack-local-variables-hook 'org-set-regexps) | |
469 | |
470 (defgroup org-time nil | |
471 "Options concerning time stamps and deadlines in Org-mode." | |
472 :tag "Org Time" | |
473 :group 'org) | |
474 | |
475 (defcustom org-deadline-warning-days 30 | |
476 "No. of days before expiration during which a deadline becomes active. | |
477 This variable governs the display in the org file." | |
478 :group 'org-time | |
479 :type 'number) | |
480 | |
481 (defcustom org-popup-calendar-for-date-prompt t | |
482 "Non-nil means, pop up a calendar when prompting for a date. | |
483 In the calendar, the date can be selected with mouse-1. However, the | |
484 minibuffer will also be active, and you can simply enter the date as well. | |
485 When nil, only the minibuffer will be available." | |
486 :group 'org-time | |
487 :type 'number) | |
488 | |
489 (defcustom org-calendar-follow-timestamp-change t | |
490 "Non-nil means, make the calendar window follow timestamp changes. | |
491 When a timestamp is modified and the calendar window is visible, it will be | |
492 moved to the new date." | |
493 :group 'org-time | |
494 :type 'boolean) | |
495 | |
496 (defgroup org-agenda nil | |
497 "Options concerning agenda display Org-mode." | |
498 :tag "Org Agenda" | |
499 :group 'org) | |
500 | |
501 (defcustom org-agenda-files nil | |
502 "A list of org files for agenda/diary display. | |
503 Entries are added to this list with \\[org-add-file] and removed with | |
504 \\[org-remove-file]. You can also use customize to edit the list." | |
505 :group 'org-agenda | |
506 :type '(repeat file)) | |
507 | |
508 (defcustom org-select-timeline-window t | |
509 "Non-nil means, after creating a timeline, move cursor into Timeline window. | |
510 When nil, cursor will remain in the current window." | |
511 :group 'org-agenda | |
512 :type 'boolean) | |
513 | |
514 (defcustom org-select-agenda-window t | |
515 "Non-nil means, after creating an agenda, move cursor into Agenda window. | |
516 When nil, cursor will remain in the current window." | |
517 :group 'org-agenda | |
518 :type 'boolean) | |
519 | |
520 (defcustom org-agenda-show-all-dates t | |
521 "Non-nil means, `org-agenda' shows every day in the selected range. | |
522 When nil, only the days which actually have entries are shown." | |
523 :group 'org-agenda | |
524 :type 'boolean) | |
525 | |
526 ;; FIXME: First day of month works only for current month because it would | |
527 ;; require a variable ndays treatment. | |
528 (defcustom org-agenda-start-on-weekday 1 | |
529 "Non-nil means, start the overview always on the specified weekday. | |
530 0 Denotes Sunday, 1 denotes Monday etc. | |
531 When nil, always start on the current day." | |
532 :group 'org-agenda | |
533 :type '(choice (const :tag "Today" nil) | |
534 (const :tag "First day of month" t) | |
535 (number :tag "Weekday No."))) | |
536 | |
537 (defcustom org-agenda-ndays 7 | |
538 "Number of days to include in overview display." | |
539 :group 'org-agenda | |
540 :type 'number) | |
541 | |
542 (defcustom org-agenda-include-all-todo t | |
543 "Non-nil means, the multifile agenda will always contain alm TODO entries. | |
544 When nil, date-less entries will only be shown if `org-agenda' is called | |
545 with a prefix argument. | |
546 When non-nil, the TODO entries will be listed at the top of the agenda, before | |
547 the entries for specific days." | |
548 :group 'org-agenda | |
549 :type 'boolean) | |
550 | |
551 (defcustom org-agenda-include-diary nil | |
552 "Non-nil means, when preparing the agenda, also get the | |
553 entries from the emacs calendars diary." | |
554 :group 'org-agenda | |
555 :type 'boolean) | |
556 | |
557 | |
558 (defcustom org-agenda-sorting-strategy '(time-up category-keep priority-down) | |
559 "Sorting structure for the agenda items of a single day. | |
560 This is a list of symbols which will be used in sequence to determine | |
561 if an entry should be listed before another entry. The following | |
562 symbols are recognized. | |
563 | |
564 time-up Put entries with time-of-day indications first, early first | |
565 time-down Put entries with time-of-day indications first, late first | |
566 category-keep Keep the default order of categories, corresponding to the | |
567 sequence in `org-agenda-files'. | |
568 category-up Sort alphabetically by category, A-Z. | |
569 category-down Sort alphabetically by category, Z-A. | |
570 priority-up Sort numerically by priority, high priority last. | |
571 priority-down Sort numerically by priority, high priority first. | |
572 | |
573 The different possibilities will be tried in sequence, and testing stops | |
574 if one comparison returns a \"not-equal\". For example, the default | |
575 '(time-up category-keep priority-down) | |
576 means: Pull out all entries having a specified time of day and sort them, | |
577 in order to make a time schedule for the current day the first thing in the | |
578 agenda listing for the day. Of the entries without a time indication, keep | |
579 the grouped in categories, don't sort the categories, but keep them in | |
580 the sequence given in `org-agenda-files'. Within each category sort by | |
581 priority. | |
582 | |
583 Leaving out the `category-keep' would mean that items will be sorted across | |
584 categories by priority." | |
585 :group 'org-agenda | |
586 :type '(repeat | |
587 (choice | |
588 (const time-up) | |
589 (const time-down) | |
590 (const category-keep) | |
591 (const category-up) | |
592 (const category-down) | |
593 (const priority-up) | |
594 (const priority-down)))) | |
595 | |
596 (defcustom org-sort-agenda-notime-is-late t | |
597 "Non-nil means, items without time are considered late. | |
598 This is only relevant for sorting. When t, items which have no explicit | |
599 time like 15:30 will be considered as 24:01, i.e. later than any items which | |
600 do have a time. When nil, the default time is before 0:00." | |
601 :group 'org-agenda | |
602 :type 'boolean) | |
603 | |
604 (defvar org-category nil | |
605 "Variable used by org files to set a category for agenda display. | |
606 Such files should use a file variable to set it, for example | |
607 | |
608 -*- mode: org; org-category: \"ELisp\" | |
609 | |
610 If the file does not specify a category, the file's base name | |
611 is used instead.") | |
612 | |
613 (defgroup org-structure nil | |
614 "Options concerning structure editing in Org-mode." | |
615 :tag "Org Structure" | |
616 :group 'org) | |
617 | |
618 (defcustom org-adapt-indentation t | |
619 "Non-nil means, adapt indentation when promoting and demoting. | |
620 When this is set and the *entire* text in an entry is indented, the | |
621 indentation is increased by one space in a demotion command, and | |
622 decreased by one in a promotion command. If any line in the entry | |
623 body starts at column 0, indentation is not changed at all." | |
624 :group 'org-structure | |
625 :type 'boolean) | |
626 | |
627 (defcustom org-cycle-emulate-tab t | |
628 "Where should `org-cycle' emulate TAB. | |
629 nil Never | |
630 white Only in completely white lines | |
631 t Everywhere except in headlines" | |
632 :group 'org-structure | |
633 :type '(choice (const :tag "Never" nil) | |
634 (const :tag "Only in completely white lines" white) | |
635 (const :tag "Everywhere except in headlines" t) | |
636 )) | |
637 | |
638 (defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") | |
639 "Formats for `format-time-string' which are used for time stamps. | |
640 It is not recommended to change this constant.") | |
641 | |
642 (defgroup org-link nil | |
643 "Options concerning links in Org-mode." | |
644 :tag "Org Link" | |
645 :group 'org) | |
646 | |
647 (defcustom org-allow-space-in-links t | |
648 "Non-nil means, file names in links may contain space characters. | |
649 When nil, it becomes possible to put several links into a line." | |
650 :group 'org-link | |
651 :type 'boolean) | |
652 | |
653 (defcustom org-line-numbers-in-file-links t | |
654 "Non-nil means, file links from `org-store-link' contain line numbers. | |
655 The line number will be added to the file name with :NNN and interpreted | |
656 by the command `org-open-at-point'. | |
657 Using a prefix arg to the command \\[org-store-link] (`org-store-link') | |
658 negates this setting for the duration of the command." | |
659 :group 'org-link | |
660 :type 'boolean) | |
661 | |
662 (defcustom org-keep-stored-link-after-insertion nil | |
663 "Non-nil means, keep link in list for entire session. | |
664 | |
665 The command `org-store-link' adds a link pointing to the current | |
666 location to an internal list. These links accumulate during a session. | |
667 The command `org-insert-link' can be used to insert links into any | |
668 Org-mode file (offering completion for all stored links). When this | |
669 option is nil, every link which has been inserted once using `C-c C-l' | |
670 will be removed from the list, to make completing the unused links | |
671 more efficient." | |
672 :group 'org-link | |
673 :type 'boolean) | |
674 | |
675 (defcustom org-link-frame-setup | |
676 '((vm . vm-visit-folder-other-frame) | |
677 (gnus . gnus-other-frame) | |
678 (file . find-file-other-window)) | |
679 "Setup the frame configuration for following links. | |
680 When following a link with Emacs, it may often be useful to display | |
681 this link in another window or frame. This variable can be used to | |
682 set this up for the different types of links. | |
683 For VM, use any of | |
684 vm-visit-folder | |
685 vm-visit-folder-other-frame | |
686 For Gnus, use any of | |
687 gnus | |
688 gnus-other-frame | |
689 For FILE, use any of | |
690 find-file | |
691 find-file-other-window | |
692 find-file-other-frame | |
693 For the calendar, use the variable `calendar-setup'. | |
694 For BBDB, it is currently only possible to display the matches in | |
695 another window." | |
696 :group 'org-link | |
697 :type '(list | |
698 (cons (const vm) | |
699 (choice | |
700 (const vm-visit-folder) | |
701 (const vm-visit-folder-other-window) | |
702 (const vm-visit-folder-other-frame))) | |
703 (cons (const gnus) | |
704 (choice | |
705 (const gnus) | |
706 (const gnus-other-frame))) | |
707 (cons (const file) | |
708 (choice | |
709 (const find-file) | |
710 (const find-file-other-window) | |
711 (const find-file-other-frame))))) | |
712 | |
713 (defcustom org-usenet-links-prefer-google nil | |
714 "Non-nil means, `org-store-link' will create web links to google groups. | |
715 When nil, Gnus will be used for such links. | |
716 Using a prefix arg to the command \\[org-store-link] (`org-store-link') | |
717 negates this setting for the duration of the command." | |
718 :group 'org-link | |
719 :type 'boolean) | |
720 | |
721 (defcustom org-open-non-existing-files nil | |
722 "Non-nil means, `org-open-file' will open non-existing file. | |
723 When nil, an error will be generated." | |
724 :group 'org-link | |
725 :type 'boolean) | |
726 | |
727 (defcustom org-confirm-shell-links t | |
728 "Non-nil means, ask for confirmation before executing shell links. | |
729 The default is true, to keep new users from shooting into their own foot." | |
730 :group 'org-link | |
731 :type 'boolean) | |
732 | |
733 (defconst org-file-apps-defaults-linux | |
734 '((t . emacs) | |
735 ("jpg" . "xv %s") | |
736 ("gif" . "xv %s") | |
737 ("ppm" . "xv %s") | |
738 ("pgm" . "xv %s") | |
739 ("pbm" . "xv %s") | |
740 ("tif" . "xv %s") | |
741 ("png" . "xv %s") | |
742 ("ps" . "gv %s") | |
743 ("ps.gz" . "gv %s") | |
744 ("eps" . "gv %s") | |
745 ("eps.gz" . "gv %s") | |
746 ("dvi" . "xdvi %s") | |
747 ("mpeg" . "plaympeg %s") | |
748 ("mp3" . "plaympeg %s") | |
749 ("fig" . "xfig %s") | |
750 ("pdf" . "acroread %s") | |
751 ("doc" . "soffice %s") | |
752 ("ppt" . "soffice %s") | |
753 ("pps" . "soffice %s") | |
754 ("html" . "netscape -remote openURL(%s,new-window)") | |
755 ("htm" . "netscape -remote openURL(%s,new-window)") | |
756 ("xs" . "soffice %s")) | |
757 "Default file applications on a UNIX/LINUX system. | |
758 See `org-file-apps'.") | |
759 | |
760 (defconst org-file-apps-defaults-macosx | |
761 '((t . "open %s") | |
762 ("ps" . "gv %s") | |
763 ("ps.gz" . "gv %s") | |
764 ("eps" . "gv %s") | |
765 ("eps.gz" . "gv %s") | |
766 ("dvi" . "xdvi %s") | |
767 ("fig" . "xfig %s")) | |
768 "Default file applications on a MacOS X system. | |
769 The system \"open\" is known as a default, but we use X11 applications | |
770 for some files for which the OS does not have a good default. | |
771 See `org-file-apps'.") | |
772 | |
773 (defconst org-file-apps-defaults-windowsnt | |
774 '((t . (w32-shell-execute "open" file))) | |
775 "Default file applications on a Windows NT system. | |
776 The system \"open\" is used for most files. | |
777 See `org-file-apps'.") | |
778 | |
779 (defcustom org-file-apps | |
780 '( | |
781 ("txt" . emacs) | |
782 ("tex" . emacs) | |
783 ("ltx" . emacs) | |
784 ("org" . emacs) | |
785 ("el" . emacs) | |
786 ) | |
787 "External applications for opening `file:path' items in a document. | |
788 Org-mode uses system defaults for different file types, but | |
789 you can use this variable to set the application for a given file | |
790 extension. The entries in this list are cons cells with a file extension | |
791 and the corresponding command. Possible values for the command are: | |
792 `emacs' The file will be visited by the current Emacs process. | |
793 `default' Use the default application for this file type. | |
794 string A command to be executed by a shell. %s will be replaced | |
795 by the path to the file. | |
796 sexp A lisp form which will be evaluated. The file path will | |
797 be available in the lisp variable `file'. | |
798 For more examples, see the system specific constants | |
799 `org-file-apps-defaults-macosx' | |
800 `org-file-apps-defaults-windowsnt' | |
801 `org-file-apps-defaults-linux'." | |
802 :group 'org-link | |
803 :type '(repeat | |
804 (cons (string :tag "Extension") | |
805 (choice :value "" | |
806 (const :tag "Visit with Emacs" 'emacs) | |
807 (const :tag "Use system default" 'default) | |
808 (string :tag "Command") | |
809 (sexp :tag "Lisp form"))))) | |
810 | |
811 | |
812 (defgroup org-remember nil | |
813 "Options concerning interaction with remember.el." | |
814 :tag "Org Remember" | |
815 :group 'org) | |
816 | |
817 (defcustom org-directory "~/org" | |
818 "Directory with org files. | |
819 This directory will be used as default to prompt for org files. | |
820 Used by the hooks for remember.el." | |
821 :group 'org-remember | |
822 :type 'directory) | |
823 | |
824 (defcustom org-default-notes-file "~/.notes" | |
825 "Default target for storing notes. | |
826 Used by the hooks for remember.el. This can be a string, or nil to mean | |
827 the value of `remember-data-file'." | |
828 :group 'org-remember | |
829 :type '(choice | |
830 (const :tag "Default from remember-data-file" nil) | |
831 file)) | |
832 | |
833 (defcustom org-reverse-note-order nil | |
834 "Non-nil means, store new notes at the beginning of a file or entry. | |
835 When nil, new notes will be filed to the end of a file or entry." | |
836 :group 'org-remember | |
837 :type '(choice | |
838 (const :tag "Reverse always" t) | |
839 (const :tag "Reverse never" nil) | |
840 (repeat :tag "By file name regexp" | |
841 (cons regexp boolean)))) | |
842 | |
843 (defgroup org-table nil | |
844 "Options concerning tables in Org-mode." | |
845 :tag "Org Table" | |
846 :group 'org) | |
847 | |
848 (defcustom org-enable-table-editor t | |
849 "Non-nil means, lines starting with \"|\" are handled by the table editor. | |
850 When nil, such lines will be treated like ordinary lines." | |
851 :group 'org-table | |
852 :type 'boolean) | |
853 | |
854 (defcustom org-table-default-size "5x2" | |
855 "The default size for newly created tables, Columns x Rows." | |
856 :group 'org-table | |
857 :type 'string) | |
858 | |
859 (defcustom org-table-automatic-realign t | |
860 "Non-nil means, automatically re-align table when pressing TAB or RETURN. | |
861 When nil, aligning is only done with \\[org-table-align], or after column | |
862 removal/insertion." | |
863 :group 'org-table | |
864 :type 'boolean) | |
865 | |
866 (defcustom org-table-spaces-around-separators '(1 . 1) | |
867 "The number of spaces to be placed before and after separators." | |
868 :group 'org-table | |
869 :type '(cons (number :tag "Before \"|\"") (number :tag " After \"|\""))) | |
870 | |
871 (defcustom org-table-spaces-around-invisible-separators '(1 . 2) | |
872 "The number of spaces to be placed before and after separators. | |
873 This option applies when the column separators have been made invisible." | |
874 :group 'org-table | |
875 :type '(cons (number :tag "Before \"|\"") (number :tag " After \"|\""))) | |
876 | |
877 (defcustom org-table-number-regexp "^[<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*$" | |
878 "Regular expression for recognizing numbers in table columns. | |
879 If a table column contains mostly numbers, it will be aligned to the | |
880 right. If not, it will be aligned to the left. | |
881 | |
882 The default value of this option is a regular expression which allows | |
883 anything which looks remotely like a number as used in scientific | |
884 context. For example, all of the following will be considered a | |
885 number: | |
886 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5 | |
887 | |
888 Other options offered by the customize interface are more restrictive." | |
889 :group 'org-table | |
890 :type '(choice | |
891 (const :tag "Positive Integers" | |
892 "^[0-9]+$") | |
893 (const :tag "Integers" | |
894 "^[-+]?[0-9]+$") | |
895 (const :tag "Floating Point Numbers" | |
896 "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$") | |
897 (const :tag "Floating Point Number or Integer" | |
898 "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") | |
899 (const :tag "Exponential, Floating point, Integer" | |
900 "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") | |
901 (const :tag "Very General Number-Like" | |
902 "^[<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*$") | |
903 (string :tag "Regexp:"))) | |
904 | |
905 (defcustom org-table-number-fraction 0.5 | |
906 "Fraction of numbers in a column required to make the column align right. | |
907 In a column all non-white fields are considered. If at least this | |
908 fraction of fields is matched by `org-table-number-fraction', | |
909 alignment to the right border applies." | |
910 :group 'org-table | |
911 :type 'number) | |
912 | |
913 (defcustom org-export-highlight-first-table-line t | |
914 "Non-nil means, highlight the first table line. | |
915 In HTML export, this means use <th> instead of <td>. | |
916 In tables created with table.el, this applies to the first table line. | |
917 In Org-mode tables, all lines before the first horizontal separator | |
918 line will be formatted with <th> tags." | |
919 :group 'org-table | |
920 :type 'boolean) | |
921 | |
922 (defcustom org-table-tab-recognizes-table.el t | |
923 "Non-nil means, TAB will automatically notice a table.el table. | |
924 When it sees such a table, it moves point into it and - if necessary - | |
925 calls `table-recognize-table'." | |
926 :group 'org-table | |
927 :type 'boolean) | |
928 | |
929 (defcustom org-export-prefer-native-exporter-for-tables nil | |
930 "Non-nil means, always export tables created with table.el natively. | |
931 Natively means, use the HTML code generator in table.el. | |
932 When nil, Org-mode's own HTML generator is used when possible (i.e. if | |
933 the table does not use row- or column-spanning). This has the | |
934 advantage, that the automatic HTML conversions for math symbols and | |
935 sub/superscripts can be applied. Org-mode's HTML generator is also | |
936 much faster." | |
937 :group 'org-table | |
938 :type 'boolean) | |
939 | |
940 (defcustom org-enable-fixed-width-editor t | |
941 "Non-nil means, lines starting with \":\" are treated as fixed-width. | |
942 This currently only means, they are never auto-wrapped. | |
943 When nil, such lines will be treated like ordinary lines." | |
944 :group 'org-table | |
945 :type 'boolean) | |
946 | |
947 (defgroup org-export nil | |
948 "Options for exporting org-listings." | |
949 :tag "Org Export" | |
950 :group 'org) | |
951 | |
952 (defcustom org-export-language-setup | |
953 '(("en" "Author" "Date" "Table of Contents") | |
954 ("da" "Ophavsmand" "Dato" "Indhold") | |
955 ("de" "Autor" "Datum" "Inhaltsverzeichnis") | |
956 ("es" "Autor" "Fecha" "\xccndice") | |
957 ("fr" "Auteur" "Date" "Table des Mati\xe8res") | |
958 ("it" "Autore" "Data" "Indice") | |
959 ("nl" "Auteur" "Datum" "Inhoudsopgave") | |
960 ("nn" "Forfattar" "Dato" "Innhold") ;; nn = Norsk (nynorsk) | |
961 ("sv" "F\xf6rfattarens" "Datum" "Inneh\xe5ll")) | |
962 "Terms used in export text, translated to different languages. | |
963 Use the variable `org-export-default-language' to set the language, | |
964 or use the +OPTION lines for a per-file setting." | |
965 :group 'org-export | |
966 :type '(repeat | |
967 (list | |
968 (string :tag "HTML language tag") | |
969 (string :tag "Author") | |
970 (string :tag "Date") | |
971 (string :tag "Table of Contents")))) | |
972 | |
973 (defcustom org-export-default-language "en" | |
974 "The default language of HTML export, as a string. | |
975 This should have an association in `org-export-language-setup'" | |
976 :group 'org-export | |
977 :type 'string) | |
978 | |
979 (defcustom org-export-headline-levels 3 | |
980 "The last level which is still exported as a headline. | |
981 Inferior levels will produce itemize lists when exported. | |
982 Note that a numeric prefix argument to an exporter function overrides | |
983 this setting. | |
984 | |
985 This option can also be set with the +OPTIONS line, e.g. \"H:2\"." | |
986 :group 'org-export | |
987 :type 'number) | |
988 | |
989 (defcustom org-export-with-section-numbers t | |
990 "Non-nil means, add section numbers to headlines when exporting. | |
991 | |
992 This option can also be set with the +OPTIONS line, e.g. \"num:t\"." | |
993 :group 'org-export | |
994 :type 'boolean) | |
995 | |
996 (defcustom org-export-with-toc t | |
997 "Non-nil means, create a table of contents in exported files. | |
998 The TOC contains headlines with levels up to`org-export-headline-levels'. | |
999 | |
1000 Headlines which contain any TODO items will be marked with \"(*)\" in | |
1001 ASCII export, and with red color in HTML output. | |
1002 | |
1003 In HTML output, the TOC will be clickable. | |
1004 | |
1005 This option can also be set with the +OPTIONS line, e.g. \"toc:nil\"." | |
1006 :group 'org-export | |
1007 :type 'boolean) | |
1008 | |
1009 (defcustom org-export-preserve-breaks nil | |
1010 "Non-nil means, preserve all line breaks when exporting. | |
1011 Normally, in HTML output paragraphs will be reformatted. In ASCII | |
1012 export, line breaks will always be preserved, regardless of this variable. | |
1013 | |
1014 This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"." | |
1015 :group 'org-export | |
1016 :type 'boolean) | |
1017 | |
1018 (defcustom org-export-html-inline-images t | |
1019 "Non-nil means, inline images into exported HTML pages. | |
1020 The link will still be to the original location of the image file. | |
1021 So if you are moving the page, lets say to your public HTML site, | |
1022 you will have to move the image and maybe change the link." | |
1023 :group 'org-export | |
1024 :type 'boolean) | |
1025 | |
1026 (defcustom org-export-html-expand t | |
1027 "Non-nil means, for HTML export, treat @<...> as HTML tag. | |
1028 When nil, these tags will be exported as plain text and therefore | |
1029 not be interpreted by a browser. | |
1030 | |
1031 This option can also be set with the +OPTIONS line, e.g. \"@:nil\"." | |
1032 :group 'org-export | |
1033 :type 'boolean) | |
1034 | |
1035 (defcustom org-export-with-fixed-width t | |
1036 "Non-nil means, lines starting with \":\" will be in fixed width font. | |
1037 This can be used to have preformatted text, fragments of code etc. For | |
1038 example | |
1039 : ;; Some Lisp examples | |
1040 : (while (defc cnt) | |
1041 : (ding)) | |
1042 will be looking just like this in also HTML. In ASCII export, this option | |
1043 has no effect. | |
1044 | |
1045 This option can also be set with the +OPTIONS line, e.g. \"::nil\"." | |
1046 :group 'org-export | |
1047 :type 'boolean) | |
1048 | |
1049 (defcustom org-export-with-tables t | |
1050 "Non-nil means, lines starting with \"|\" define a table | |
1051 For example: | |
1052 | |
1053 | Name | Address | Birthday | | |
1054 |-------------+----------+-----------| | |
1055 | Arthur Dent | England | 29.2.2100 | | |
1056 | |
1057 In ASCII export, this option has no effect. | |
1058 | |
1059 This option can also be set with the +OPTIONS line, e.g. \"|:nil\"." | |
1060 :group 'org-export | |
1061 :type 'boolean) | |
1062 | |
1063 (defcustom org-export-html-table-tag | |
1064 "<table border=1 cellspacing=0 cellpadding=6>" | |
1065 "The HTML tag used to start a table. | |
1066 This must be a <table> tag, but you may change the options like | |
1067 borders and spacing." | |
1068 :group 'org-export | |
1069 :type 'string) | |
1070 | |
1071 (defcustom org-export-with-emphasize t | |
1072 "Non-nil means, interprete *word*, /word/, and _word_ as emphasized text. | |
1073 If the export target supports emphasizing text, the word will be | |
1074 typeset in bold, italic, or underlined, respectively. Works only for | |
1075 single words, but you can say: I *really* *mean* *this*. | |
1076 In ASCII export, this option has no effect. | |
1077 | |
1078 This option can also be set with the +OPTIONS line, e.g. \"*:nil\"." | |
1079 :group 'org-export | |
1080 :type 'boolean) | |
1081 | |
1082 (defcustom org-match-sexp-depth 3 | |
1083 "Number of stacked braces for sub/superscript matching. | |
1084 This has to be set before loading org.el to be effective." | |
1085 :group 'org-export | |
1086 :type 'integer) | |
1087 | |
1088 ;; FIXME: Should () parens be removed as well in sub/superscripts? | |
1089 (defcustom org-export-with-sub-superscripts t | |
1090 "Non-nil means, interprete \"_\" and \"^\" for export. | |
1091 When this option is turned on, you can use TeX-like syntax for sub- and | |
1092 superscripts. Several characters after \"_\" or \"^\" will be | |
1093 considered as a single item - so grouping with {} is normally not | |
1094 needed. For example, the following things will be parsed as single | |
1095 sub- or superscripts. | |
1096 | |
1097 10^24 or 10^tau several digits will be considered 1 item | |
1098 10^-12 or 10^-tau a leading sign with digits or a word | |
1099 x^2-y^3 will be read as x^2 - y^3, because items are | |
1100 terminated by almost any nonword/nondigit char. | |
1101 x_{i^2} or x^(2-i) braces or parenthesis do grouping. | |
1102 | |
1103 Still, ambiguity is possible - so when in doubt use {} to enclose the | |
1104 sub/superscript. | |
1105 In ASCII export, this option has no effect. | |
1106 | |
1107 This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." | |
1108 :group 'org-export | |
1109 :type 'boolean) | |
1110 | |
1111 (defcustom org-export-with-TeX-macros t | |
1112 "Non-nil means, interprete simple TeX-like macros when exporting. | |
1113 For example, HTML export converts \\alpha to α and \\AA to Å. | |
1114 No only real TeX macros will work here, but the standard HTML entities | |
1115 for math can be used as macro names as well. For a list of supported | |
1116 names in HTML export, see the constant `org-html-entities'. | |
1117 In ASCII export, this option has no effect. | |
1118 | |
1119 This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." | |
1120 :group 'org-export | |
1121 :type 'boolean) | |
1122 | |
1123 (defcustom org-export-html-with-timestamp nil | |
1124 "Non-nil means, write `org-export-html-html-helper-timestamp' | |
1125 into the exported html text. Otherwise, the buffer will just be saved | |
1126 to a file." | |
1127 :group 'org-export | |
1128 :type 'boolean) | |
1129 | |
1130 (defcustom org-export-html-html-helper-timestamp | |
1131 "<br><br><hr><p><!-- hhmts start --> <!-- hhmts end -->\n" | |
1132 "The HTML tag used as timestamp delimiter for HTML-helper-mode." | |
1133 :group 'org-export | |
1134 :type 'string) | |
1135 | |
1136 (defcustom org-export-ascii-show-new-buffer t | |
1137 "Non-nil means, popup buffer containing the exported ASCII text. | |
1138 Otherwise the buffer will just be saved to a file and stay hidden." | |
1139 :group 'org-export | |
1140 :type 'boolean) | |
1141 | |
1142 (defcustom org-export-html-show-new-buffer nil | |
1143 "Non-nil means, popup buffer containing the exported html text. | |
1144 Otherwise, the buffer will just be saved to a file and stay hidden." | |
1145 :group 'org-export | |
1146 :type 'boolean) | |
1147 | |
1148 | |
1149 (defgroup org-faces nil | |
1150 "Faces for highlighting in Org-mode." | |
1151 :tag "Org Faces" | |
1152 :group 'org) | |
1153 | |
1154 (defface org-level-1-face ;; font-lock-function-name-face | |
1155 '((((type tty) (class color)) (:foreground "blue" :weight bold)) | |
1156 (((class color) (background light)) (:foreground "Blue")) | |
1157 (((class color) (background dark)) (:foreground "LightSkyBlue")) | |
1158 (t (:inverse-video t :bold t))) | |
1159 "Face used for level 1 headlines." | |
1160 :group 'org-faces) | |
1161 | |
1162 (defface org-level-2-face ;; font-lock-variable-name-face | |
1163 '((((type tty) (class color)) (:foreground "yellow" :weight light)) | |
1164 (((class color) (background light)) (:foreground "DarkGoldenrod")) | |
1165 (((class color) (background dark)) (:foreground "LightGoldenrod")) | |
1166 (t (:bold t :italic t))) | |
1167 "Face used for level 2 headlines." | |
1168 :group 'org-faces) | |
1169 | |
1170 (defface org-level-3-face ;; font-lock-keyword-face | |
1171 '((((type tty) (class color)) (:foreground "cyan" :weight bold)) | |
1172 (((class color) (background light)) (:foreground "Purple")) | |
1173 (((class color) (background dark)) (:foreground "Cyan")) | |
1174 (t (:bold t))) | |
1175 "Face used for level 3 headlines." | |
1176 :group 'org-faces) | |
1177 | |
1178 (defface org-level-4-face ;; font-lock-comment-face | |
1179 '((((type tty pc) (class color) (background light)) (:foreground "red")) | |
1180 (((type tty pc) (class color) (background dark)) (:foreground "red1")) | |
1181 (((class color) (background light)) (:foreground "Firebrick")) | |
1182 (((class color) (background dark)) (:foreground "chocolate1")) | |
1183 (t (:bold t :italic t))) | |
1184 "Face used for level 4 headlines." | |
1185 :group 'org-faces) | |
1186 | |
1187 (defface org-level-5-face ;; font-lock-type-face | |
1188 '((((type tty) (class color)) (:foreground "green")) | |
1189 (((class color) (background light)) (:foreground "ForestGreen")) | |
1190 (((class color) (background dark)) (:foreground "PaleGreen")) | |
1191 (t (:bold t :underline t))) | |
1192 "Face used for level 5 headlines." | |
1193 :group 'org-faces) | |
1194 | |
1195 (defface org-level-6-face ;; font-lock-constant-face | |
1196 '((((type tty) (class color)) (:foreground "magenta")) | |
1197 (((class color) (background light)) (:foreground "CadetBlue")) | |
1198 (((class color) (background dark)) (:foreground "Aquamarine")) | |
1199 (t (:bold t :underline t))) | |
1200 "Face used for level 6 headlines." | |
1201 :group 'org-faces) | |
1202 | |
1203 (defface org-level-7-face ;; font-lock-builtin-face | |
1204 '((((type tty) (class color)) (:foreground "blue" :weight light)) | |
1205 (((class color) (background light)) (:foreground "Orchid")) | |
1206 (((class color) (background dark)) (:foreground "LightSteelBlue")) | |
1207 (t (:bold t))) | |
1208 "Face used for level 7 headlines." | |
1209 :group 'org-faces) | |
1210 | |
1211 (defface org-level-8-face ;;font-lock-string-face | |
1212 '((((type tty) (class color)) (:foreground "green")) | |
1213 (((class color) (background light)) (:foreground "RosyBrown")) | |
1214 (((class color) (background dark)) (:foreground "LightSalmon")) | |
1215 (t (:italic t))) | |
1216 "Face used for level 8 headlines." | |
1217 :group 'org-faces) | |
1218 | |
1219 (defface org-warning-face ;; font-lock-warning-face | |
1220 '((((type tty) (class color)) (:foreground "red")) | |
1221 (((class color) (background light)) (:foreground "Red" :bold t)) | |
1222 (((class color) (background dark)) (:foreground "Pink" :bold t)) | |
1223 (t (:inverse-video t :bold t))) | |
1224 "Face for deadlines and TODO keyords." | |
1225 :group 'org-faces) | |
1226 | |
1227 ;; Inheritance does not work for xemacs, unfortunately. | |
1228 ;; We just copy the definitions and waste some space.... | |
1229 | |
1230 (defface org-deadline-announce-face | |
1231 '((((type tty) (class color)) (:foreground "blue" :weight bold)) | |
1232 (((class color) (background light)) (:foreground "Blue")) | |
1233 (((class color) (background dark)) (:foreground "LightSkyBlue")) | |
1234 (t (:inverse-video t :bold t))) | |
1235 "Face for upcoming deadlines." | |
1236 :group 'org-faces) | |
1237 | |
1238 (defface org-scheduled-today-face | |
1239 '((((type tty) (class color)) (:foreground "green")) | |
1240 (((class color) (background light)) (:foreground "DarkGreen")) | |
1241 (((class color) (background dark)) (:foreground "PaleGreen")) | |
1242 (t (:bold t :underline t))) | |
1243 "Face for items scheduled for a certain day." | |
1244 :group 'org-faces) | |
1245 | |
1246 (defface org-scheduled-previously-face | |
1247 '((((type tty pc) (class color) (background light)) (:foreground "red")) | |
1248 (((type tty pc) (class color) (background dark)) (:foreground "red1")) | |
1249 (((class color) (background light)) (:foreground "Firebrick")) | |
1250 (((class color) (background dark)) (:foreground "chocolate1")) | |
1251 (t (:bold t :italic t))) | |
1252 "Face for items scheduled previously, and not yet done." | |
1253 :group 'org-faces) | |
1254 | |
1255 (defface org-link-face | |
1256 '((((type tty) (class color)) (:foreground "cyan" :weight bold)) | |
1257 (((class color) (background light)) (:foreground "Purple")) | |
1258 (((class color) (background dark)) (:foreground "Cyan")) | |
1259 (t (:bold t))) | |
1260 "Face for links." | |
1261 :group 'org-faces) | |
1262 | |
1263 (defface org-done-face ;; font-lock-type-face | |
1264 '((((type tty) (class color)) (:foreground "green")) | |
1265 (((class color) (background light)) (:foreground "ForestGreen" :bold t)) | |
1266 (((class color) (background dark)) (:foreground "PaleGreen" :bold t)) | |
1267 (t (:bold t :underline t))) | |
1268 "Face used for DONE." | |
1269 :group 'org-faces) | |
1270 | |
1271 (defface org-table-face ;; font-lock-function-name-face | |
1272 '((((type tty) (class color)) (:foreground "blue" :weight bold)) | |
1273 (((class color) (background light)) (:foreground "Blue")) | |
1274 (((class color) (background dark)) (:foreground "LightSkyBlue")) | |
1275 (t (:inverse-video t :bold t))) | |
1276 "Face used for tables." | |
1277 :group 'org-faces) | |
1278 | |
1279 (defvar org-level-faces | |
1280 '( | |
1281 org-level-1-face | |
1282 org-level-2-face | |
1283 org-level-3-face | |
1284 org-level-4-face | |
1285 org-level-5-face | |
1286 org-level-6-face | |
1287 org-level-7-face | |
1288 org-level-8-face | |
1289 )) | |
1290 (defvar org-n-levels (length org-level-faces)) | |
1291 | |
1292 | |
1293 ;; Tell the compiler about dynamically scoped variables, | |
1294 ;; and variables from other packages | |
1295 (eval-when-compile | |
1296 (defvar zmacs-regions) | |
1297 (defvar org-transient-mark-mode) | |
1298 (defvar org-html-entities) | |
1299 (defvar org-goto-start-pos) | |
1300 (defvar org-cursor-color) | |
1301 (defvar org-time-was-given) | |
1302 (defvar org-ts-what) | |
1303 (defvar timecnt) | |
1304 (defvar levels-open) | |
1305 (defvar title) | |
1306 (defvar author) | |
1307 (defvar email) | |
1308 (defvar text) | |
1309 (defvar entry) | |
1310 (defvar date) | |
1311 (defvar language) | |
1312 (defvar options) | |
1313 (defvar ans1) | |
1314 (defvar ans2) | |
1315 (defvar starting-day) | |
1316 (defvar include-all-loc) | |
1317 (defvar vm-message-pointer) | |
1318 (defvar vm-folder-directory) | |
1319 (defvar wl-summary-buffer-elmo-folder) | |
1320 (defvar wl-summary-buffer-folder-name) | |
1321 (defvar gnus-group-name) | |
1322 (defvar gnus-article-current) | |
1323 (defvar w3m-current-url) | |
1324 (defvar org-selected-point) | |
1325 (defvar calendar-mode-map) | |
1326 (defvar remember-save-after-remembering) | |
1327 (defvar remember-data-file)) | |
1328 | |
1329 | |
1330 ;;; Define the mode | |
1331 | |
1332 (defvar org-mode-map (copy-keymap outline-mode-map) | |
1333 "Keymap for Org-mode.") | |
1334 | |
1335 (defvar org-struct-menu) | |
1336 (defvar org-org-menu) | |
1337 | |
1338 ;;;###autoload | |
1339 (defun org-mode (&optional arg) | |
1340 "Outline-based notes management and organizer, alias | |
1341 \"Carstens outline-mode for keeping track of everything.\" | |
1342 | |
1343 Org-mode develops organizational tasks around a NOTES file which | |
1344 contains information about projects as plain text. Org-mode is | |
1345 implemented on top of outline-mode, which is ideal to keep the content | |
1346 of large files well structured. It supports ToDo items, deadlines and | |
1347 time stamps, which magically appear in the diary listing of the Emacs | |
1348 calendar. Tables are easily created with a built-in table editor. | |
1349 Plain text URL-like links connect to websites, emails (VM), Usenet | |
1350 messages (Gnus), BBDB entries, and any files related to the project. | |
1351 For printing and sharing of notes, an Org-mode file (or a part of it) | |
1352 can be exported as a well-structured ASCII or HTML file. | |
1353 | |
1354 + The following commands are available: | |
1355 | |
1356 \\{org-mode-map}" | |
1357 (interactive "P") | |
1358 (outline-mode) | |
1359 (setq major-mode 'org-mode) | |
1360 (setq mode-name "Org") | |
1361 (use-local-map org-mode-map) | |
1362 (easy-menu-add org-org-menu) | |
1363 (org-install-agenda-files-menu) | |
1364 (setq outline-regexp "\\*+") | |
1365 (if org-startup-truncated (setq truncate-lines t)) | |
1366 (org-set-regexps) | |
1367 (set (make-local-variable 'font-lock-unfontify-region-function) | |
1368 'org-unfontify-region) | |
1369 ;; Activate before-change-function | |
1370 (add-hook 'before-change-functions 'org-before-change-function nil | |
1371 'local) | |
1372 ;; Inhibit auto-fill for headers, tables and fixed-width lines. | |
1373 (set (make-local-variable 'auto-fill-inhibit-regexp) | |
1374 (concat "\\*" | |
1375 (if (or org-enable-table-editor org-enable-fixed-width-editor) | |
1376 (concat | |
1377 "\\|[ \t]*[" | |
1378 (if org-enable-table-editor "|" "") | |
1379 (if org-enable-fixed-width-editor ":" "") | |
1380 "]")))) | |
1381 ;; Hook, and startup actions | |
1382 (if (or arg | |
1383 (and org-insert-mode-line-in-empty-file | |
1384 (= (point-min) (point-max)))) | |
1385 (save-excursion | |
1386 (goto-char (point-min)) | |
1387 (insert " -*- mode: org -*-\n\n"))) | |
1388 (run-hooks 'org-mode-hook) | |
1389 (if org-startup-with-deadline-check | |
1390 (call-interactively 'org-check-deadlines) | |
1391 (if org-startup-folded (org-cycle t)))) | |
1392 | |
1393 ;;; Font-Lock stuff | |
1394 | |
1395 (defvar org-mouse-map (make-sparse-keymap)) | |
1396 (define-key org-mouse-map | |
1397 (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse) | |
1398 (define-key org-mouse-map | |
1399 (if org-xemacs-p [button3] [mouse-3]) 'org-find-file-at-mouse) | |
1400 | |
1401 (require 'font-lock) | |
1402 | |
1403 (defconst org-link-regexp | |
1404 (if org-allow-space-in-links | |
1405 "\\(https?\\|ftp\\|mailto\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^\t\n\r]+[^ \t\n\r]\\)" | |
1406 "\\(https?\\|ftp\\|mailto\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^ \t\n\r]+\\)" | |
1407 ) | |
1408 "Regular expression for matching links.") | |
1409 (defconst org-ts-lengths | |
1410 (cons (length (format-time-string (car org-time-stamp-formats))) | |
1411 (length (format-time-string (cdr org-time-stamp-formats)))) | |
1412 "This holds the lengths of the two different time formats.") | |
1413 (defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*\\)>" | |
1414 "Regular expression for fast time stamp matching.") | |
1415 (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" | |
1416 "Regular expression matching time strings for analysis.") | |
1417 (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 ">") | |
1418 "Regular expression matching time stamps, with groups.") | |
1419 (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) | |
1420 "Regular expression matching a time stamp range.") | |
1421 (defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" | |
1422 org-ts-regexp "\\)?") | |
1423 "Regular expression matching a time stamp or time stamp range.") | |
1424 | |
1425 (defun org-activate-links (limit) | |
1426 "Run through the buffer and add overlays to links." | |
1427 (if (re-search-forward org-link-regexp limit t) | |
1428 (progn | |
1429 (add-text-properties (match-beginning 0) (match-end 0) | |
1430 (list 'mouse-face 'highlight | |
1431 'keymap org-mouse-map)) | |
1432 t))) | |
1433 | |
1434 (defun org-activate-dates (limit) | |
1435 "Run through the buffer and add overlays to links." | |
1436 (if (re-search-forward org-tsr-regexp limit t) | |
1437 (progn | |
1438 (add-text-properties (match-beginning 0) (match-end 0) | |
1439 (list 'mouse-face 'highlight | |
1440 'keymap org-mouse-map)) | |
1441 t))) | |
1442 | |
1443 | |
1444 (defun org-font-lock-level () | |
1445 (save-excursion | |
1446 (org-back-to-heading t) | |
1447 (- (match-end 0) (match-beginning 0)))) | |
1448 | |
1449 (defun org-set-font-lock-defaults () | |
1450 (let ((org-font-lock-extra-keywords | |
1451 (list | |
1452 '(org-activate-links (0 'org-link-face)) | |
1453 '(org-activate-dates (0 'org-link-face)) | |
1454 (list (concat "^\\*+[ \t]*" org-not-done-regexp) '(1 'org-warning-face t)) | |
1455 (list (concat "\\[#[A-Z]\\]") '(0 'org-warning-face t)) | |
1456 (list (concat "\\<" org-deadline-string) '(0 'org-warning-face t)) | |
1457 (list (concat "\\<" org-scheduled-string) '(0 'org-warning-face t)) | |
1458 ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" | |
1459 ;; (3 'bold)) | |
1460 ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" | |
1461 ;; (3 'italic)) | |
1462 ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" | |
1463 ;; (3 'underline)) | |
1464 '("\\<FIXME\\>" (0 'org-warning-face t)) | |
1465 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") | |
1466 '(1 'org-warning-face t)) | |
1467 '("^#.*" (0 'font-lock-comment-face t)) | |
1468 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") | |
1469 '(1 'org-done-face t)) | |
1470 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" | |
1471 (1 'org-table-face t)) | |
1472 '("^[ \t]*\\(:.*\\)" (1 'org-table-face t))))) | |
1473 (set (make-local-variable 'org-font-lock-keywords) | |
1474 (append | |
1475 (if org-noutline-p ; FIXME: I am not sure if eval will work | |
1476 ; on XEmacs if noutline is ever ported | |
1477 '((eval . (list "^\\(\\*+\\).*" | |
1478 0 '(nth | |
1479 (% (- (match-end 1) (match-beginning 1) 1) | |
1480 org-n-levels) | |
1481 org-level-faces) | |
1482 nil t))) | |
1483 '(("^\\(\\(\\*+\\)[^\r\n]*\\)[\n\r]" | |
1484 (1 (nth (% (- (match-end 2) (match-beginning 2) 1) | |
1485 org-n-levels) | |
1486 org-level-faces) | |
1487 nil t)))) | |
1488 org-font-lock-extra-keywords)) | |
1489 (set (make-local-variable 'font-lock-defaults) | |
1490 '(org-font-lock-keywords t nil nil backward-paragraph)) | |
1491 (kill-local-variable 'font-lock-keywords) nil)) | |
1492 | |
1493 (defvar org-font-lock-keywords nil) | |
1494 | |
1495 (defun org-unfontify-region (beg end &optional maybe_loudly) | |
1496 "Remove fontification and activation overlays from links." | |
1497 (font-lock-default-unfontify-region beg end) | |
1498 (let* ((modified (buffer-modified-p)) ;; FIXME: Why did I add this??? | |
1499 (buffer-undo-list t) | |
1500 (inhibit-read-only t) (inhibit-point-motion-hooks t) | |
1501 (inhibit-modification-hooks t) | |
1502 deactivate-mark buffer-file-name buffer-file-truename) | |
1503 (remove-text-properties beg end '(mouse-face nil keymap nil)))) | |
1504 | |
1505 ;;; Visibility cycling | |
1506 | |
1507 (defvar org-cycle-global-status nil) | |
1508 (defvar org-cycle-subtree-status nil) | |
1509 (defun org-cycle (&optional arg) | |
1510 "Visibility cycling for outline(-minor)-mode. | |
1511 | |
1512 - When this function is called with a prefix argument, rotate the entire | |
1513 buffer through 3 states (global cycling) | |
1514 1. OVERVIEW: Show only top-level headlines. | |
1515 2. CONTENTS: Show all headlines of all levels, but no body text. | |
1516 3. SHOW ALL: Show everything. | |
1517 | |
1518 - When point is at the beginning of a headline, rotate the subtree started | |
1519 by this line through 3 different states (local cycling) | |
1520 1. FOLDED: Only the main headline is shown. | |
1521 2. CHILDREN: The main headline and the direct children are shown. From | |
1522 this state, you can move to one of the children and | |
1523 zoom in further. | |
1524 3. SUBTREE: Show the entire subtree, including body text. | |
1525 | |
1526 - When point is not at the beginning of a headline, execute | |
1527 `indent-relative', like TAB normally does. See the option | |
1528 `org-cycle-emulate-tab' for details. | |
1529 | |
1530 - Special case: if point is the the beginning of the buffer and there is | |
1531 no headline in line 1, this function will act as if called with prefix arg." | |
1532 (interactive "P") | |
1533 | |
1534 (if (and (bobp) (not (looking-at outline-regexp))) | |
1535 ; special case: use global cycling | |
1536 (setq arg t)) | |
1537 | |
1538 (cond | |
1539 | |
1540 ((org-at-table-p 'any) | |
1541 ;; Enter the table or move to the next field in the table | |
1542 (or (org-table-recognize-table.el) | |
1543 (org-table-next-field))) | |
1544 | |
1545 (arg ;; Global cycling | |
1546 | |
1547 (cond | |
1548 ((and (eq last-command this-command) | |
1549 (eq org-cycle-global-status 'overview)) | |
1550 ;; We just created the overview - now do table of contents | |
1551 ;; This can be slow in very large buffers, so indicate action | |
1552 (message "CONTENTS...") | |
1553 (save-excursion | |
1554 ;; Visit all headings and show their offspring | |
1555 (goto-char (point-max)) | |
1556 (catch 'exit | |
1557 (while (and (progn (condition-case nil | |
1558 (outline-previous-visible-heading 1) | |
1559 (error (goto-char (point-min)))) | |
1560 t) | |
1561 (looking-at outline-regexp)) | |
1562 (show-branches) | |
1563 (if (bobp) (throw 'exit nil)))) | |
1564 (message "CONTENTS...done")) | |
1565 (setq org-cycle-global-status 'contents)) | |
1566 ((and (eq last-command this-command) | |
1567 (eq org-cycle-global-status 'contents)) | |
1568 ;; We just showed the table of contents - now show everything | |
1569 (show-all) | |
1570 (message "SHOW ALL") | |
1571 (setq org-cycle-global-status 'all)) | |
1572 (t | |
1573 ;; Default action: go to overview | |
1574 (hide-sublevels 1) | |
1575 (message "OVERVIEW") | |
1576 (setq org-cycle-global-status 'overview)))) | |
1577 | |
1578 ((save-excursion (beginning-of-line 1) (looking-at outline-regexp)) | |
1579 ;; At a heading: rotate between three different views | |
1580 (org-back-to-heading) | |
1581 (let ((goal-column 0) beg eoh eol eos nxh) | |
1582 ;; First, some boundaries | |
1583 (save-excursion | |
1584 (org-back-to-heading) (setq beg (point)) | |
1585 (save-excursion | |
1586 (beginning-of-line 2) | |
1587 (while (and (not (eobp)) ;; this is like `next-line' | |
1588 (get-char-property (1- (point)) 'invisible)) | |
1589 (beginning-of-line 2)) (setq eol (point))) | |
1590 (outline-end-of-heading) (setq eoh (point)) | |
1591 (outline-end-of-subtree) (setq eos (point)) | |
1592 (outline-next-heading) (setq nxh (point))) | |
1593 ;; Find out what to do next and set `this-command' | |
1594 (cond | |
1595 ((= eos eoh) | |
1596 ;; Nothing is hidden behind this heading | |
1597 (message "EMPTY ENTRY") | |
1598 (setq org-cycle-subtree-status nil)) | |
1599 ((>= eol eos) | |
1600 ;; Entire subtree is hidden in one line: open it | |
1601 (show-entry) | |
1602 (show-children) | |
1603 (message "CHILDREN") | |
1604 (setq org-cycle-subtree-status 'children)) | |
1605 ((and (eq last-command this-command) | |
1606 (eq org-cycle-subtree-status 'children)) | |
1607 ;; We just showed the children, now show everything. | |
1608 (show-subtree) | |
1609 (message "SUBTREE") | |
1610 (setq org-cycle-subtree-status 'subtree)) | |
1611 (t | |
1612 ;; Default action: hide the subtree. | |
1613 (hide-subtree) | |
1614 (message "FOLDED") | |
1615 (setq org-cycle-subtree-status 'folded))))) | |
1616 | |
1617 ;; TAB emulation | |
1618 (buffer-read-only (org-back-to-heading)) | |
1619 ((if (and (eq org-cycle-emulate-tab 'white) | |
1620 (save-excursion (beginning-of-line 1) (looking-at "[ \t]+$"))) | |
1621 t | |
1622 (eq org-cycle-emulate-tab t)) | |
1623 (if (and (looking-at "[ \n\r\t]") | |
1624 (string-match "^[ \t]*$" (buffer-substring | |
1625 (point-at-bol) (point)))) | |
1626 (progn | |
1627 (beginning-of-line 1) | |
1628 (and (looking-at "[ \t]+") (replace-match "")))) | |
1629 (indent-relative)) | |
1630 | |
1631 (t (save-excursion | |
1632 (org-back-to-heading) | |
1633 (org-cycle))))) | |
1634 | |
1635 (defvar org-goto-window-configuration nil) | |
1636 (defvar org-goto-marker nil) | |
1637 (defvar org-goto-map (make-sparse-keymap)) | |
1638 (let ((cmds '(isearch-forward isearch-backward)) cmd) | |
1639 (while (setq cmd (pop cmds)) | |
1640 (substitute-key-definition cmd cmd org-goto-map global-map))) | |
1641 (define-key org-goto-map [(return)] 'org-goto-ret) | |
1642 (define-key org-goto-map [(left)] 'org-goto-left) | |
1643 (define-key org-goto-map [(right)] 'org-goto-right) | |
1644 (define-key org-goto-map [(?q)] 'org-goto-quit) | |
1645 (define-key org-goto-map [(control ?g)] 'org-goto-quit) | |
1646 (define-key org-goto-map [(tab)] 'org-cycle) | |
1647 (define-key org-goto-map [(down)] 'outline-next-visible-heading) | |
1648 (define-key org-goto-map [(up)] 'outline-previous-visible-heading) | |
1649 (define-key org-goto-map "n" 'outline-next-visible-heading) | |
1650 (define-key org-goto-map "p" 'outline-previous-visible-heading) | |
1651 (define-key org-goto-map "f" 'outline-forward-same-level) | |
1652 (define-key org-goto-map "b" 'outline-backward-same-level) | |
1653 (define-key org-goto-map "u" 'outline-up-heading) | |
1654 (define-key org-goto-map "\C-c\C-n" 'outline-next-visible-heading) | |
1655 (define-key org-goto-map "\C-c\C-p" 'outline-previous-visible-heading) | |
1656 (define-key org-goto-map "\C-c\C-f" 'outline-forward-same-level) | |
1657 (define-key org-goto-map "\C-c\C-b" 'outline-backward-same-level) | |
1658 (define-key org-goto-map "\C-c\C-u" 'outline-up-heading) | |
1659 (let ((l '(1 2 3 4 5 6 7 8 9 0))) | |
1660 (while l (define-key org-goto-map (int-to-string (pop l)) 'digit-argument))) | |
1661 | |
1662 (defconst org-goto-help | |
1663 "Select a location to jump to, press RET | |
1664 \[Up]/[Down]=next/prev headline TAB=cycle visibility RET=select [Q]uit") | |
1665 | |
1666 (defun org-goto () | |
1667 "Go to a different location of the document, keeping current visibility. | |
1668 | |
1669 When you want to go to a different location in a document, the fastest way | |
1670 is often to fold the entire buffer and then dive into the tree. This | |
1671 method has the disadvantage, than the previous location will be folded, and | |
1672 that can be unwanted. | |
1673 | |
1674 This command works around this by showing a copy of the current buffer in | |
1675 overview mode. You can dive into the tree in that copy, to find the | |
1676 location you want to reach. When pressing RET, the command returns to the | |
1677 original buffer in which the visibility is still unchanged. It then jumps | |
1678 to the new location, making it and the headline hierarchy above it visible." | |
1679 (interactive) | |
1680 (let* ((org-goto-start-pos (point)) | |
1681 (selected-point | |
1682 (org-get-location (current-buffer) org-goto-help))) | |
1683 (if selected-point | |
1684 (progn | |
1685 (goto-char selected-point) | |
1686 (if (org-invisible-p) (org-show-hierarchy-above))) | |
1687 (error "Quit")))) | |
1688 | |
1689 (defun org-get-location (buf help) | |
1690 "Let the user select a location in the Org-mode buffer BUF. | |
1691 This function uses a recursive edit. It returns the selected position | |
1692 or nil." | |
1693 (let (org-selected-point) | |
1694 (save-excursion | |
1695 (save-window-excursion | |
1696 (delete-other-windows) | |
1697 (switch-to-buffer (get-buffer-create "*org-goto*")) | |
1698 (with-output-to-temp-buffer "*Help*" | |
1699 (princ help)) | |
1700 (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*")) | |
1701 (setq buffer-read-only nil) | |
1702 (erase-buffer) | |
1703 (insert-buffer buf) | |
1704 (let ((org-startup-truncated t) | |
1705 (org-startup-folded t) | |
1706 (org-startup-with-deadline-check nil)) | |
1707 (org-mode)) | |
1708 (setq buffer-read-only t) | |
1709 (if (boundp 'org-goto-start-pos) | |
1710 (goto-char org-goto-start-pos) | |
1711 (goto-char (point-min))) | |
1712 (org-beginning-of-line) | |
1713 (message "Select location and press RET") | |
1714 ;; now we make sure that during selection, ony very few keys work | |
1715 ;; and that it is impossible to switch to another window. | |
1716 (let ((gm (current-global-map)) | |
1717 (overriding-local-map org-goto-map)) | |
1718 (unwind-protect | |
1719 (progn | |
1720 (use-global-map org-goto-map) | |
1721 (recursive-edit)) | |
1722 (use-global-map gm))))) | |
1723 (kill-buffer "*org-goto*") | |
1724 org-selected-point)) | |
1725 | |
1726 ;; FIXME: It may not be a good idea to temper with the prefix argument... | |
1727 (defun org-goto-ret (&optional arg) | |
1728 "Finish org-goto by going to the new location." | |
1729 (interactive "P") | |
1730 (setq org-selected-point (point) | |
1731 current-prefix-arg arg) | |
1732 (throw 'exit nil)) | |
1733 | |
1734 (defun org-goto-left (&optional arg) | |
1735 "Finish org-goto by going to the new location." | |
1736 (interactive "P") | |
1737 (if (org-on-heading-p) | |
1738 (progn | |
1739 (beginning-of-line 1) | |
1740 (setq org-selected-point (point) | |
1741 current-prefix-arg (- (match-end 0) (match-beginning 0))) | |
1742 (throw 'exit nil)) | |
1743 (error "Not on a heading"))) | |
1744 | |
1745 (defun org-goto-right (&optional arg) | |
1746 "Finish org-goto by going to the new location." | |
1747 (interactive "P") | |
1748 (if (org-on-heading-p) | |
1749 (progn | |
1750 (outline-end-of-subtree) | |
1751 (or (eobp) (forward-char 1)) | |
1752 (setq org-selected-point (point) | |
1753 current-prefix-arg (- (match-end 0) (match-beginning 0))) | |
1754 (throw 'exit nil)) | |
1755 (error "Not on a heading"))) | |
1756 | |
1757 (defun org-goto-quit () | |
1758 "Finish org-goto without cursor motion." | |
1759 (interactive) | |
1760 (setq org-selected-point nil) | |
1761 (throw 'exit nil)) | |
1762 | |
1763 ;;; Promotion, Demotion, Inserting new headlines | |
1764 | |
1765 (defvar org-ignore-region nil | |
1766 "To temporary disable the active region.") | |
1767 | |
1768 (defun org-insert-heading () | |
1769 "Insert a new heading with same depth at point." | |
1770 (interactive) | |
1771 (let* ((head (save-excursion | |
1772 (condition-case nil | |
1773 (org-back-to-heading) | |
1774 (error (outline-next-heading))) | |
1775 (prog1 (match-string 0) | |
1776 (funcall outline-level))))) | |
1777 (unless (bolp) (newline)) | |
1778 (insert head) | |
1779 (unless (eolp) | |
1780 (save-excursion (newline-and-indent))) | |
1781 (unless (equal (char-before) ?\ ) | |
1782 (insert " ")) | |
1783 (run-hooks 'org-insert-heading-hook))) | |
1784 | |
1785 (defun org-promote-subtree (&optional arg) | |
1786 "Promote the entire subtree. | |
1787 See also `org-promote'." | |
1788 (interactive "P") | |
1789 (org-map-tree 'org-promote)) | |
1790 | |
1791 (defun org-demote-subtree (&optional arg) | |
1792 "Demote the entire subtree. See `org-demote'. | |
1793 See also `org-promote'." | |
1794 (interactive "P") | |
1795 (org-map-tree 'org-demote)) | |
1796 | |
1797 (defun org-do-promote (&optional arg) | |
1798 "Promote the current heading higher up the tree. | |
1799 If the region is active in transient-mark-mode, promote all headings | |
1800 in the region." | |
1801 (interactive "P") | |
1802 (save-excursion | |
1803 (if (org-region-active-p) | |
1804 (org-map-region 'org-promote (region-beginning) (region-end)) | |
1805 (org-promote))) | |
1806 (org-fix-position-after-promote)) | |
1807 | |
1808 (defun org-do-demote (&optional arg) | |
1809 "Demote the current heading lower down the tree. | |
1810 If the region is active in transient-mark-mode, demote all headings | |
1811 in the region." | |
1812 (interactive "P") | |
1813 (save-excursion | |
1814 (if (org-region-active-p) | |
1815 (org-map-region 'org-demote (region-beginning) (region-end)) | |
1816 (org-demote))) | |
1817 (org-fix-position-after-promote)) | |
1818 | |
1819 (defun org-fix-position-after-promote () | |
1820 "Make sure that after pro/demotion cursor position is right." | |
1821 (and (equal (char-after) ?\ ) | |
1822 (equal (char-before) ?*) | |
1823 (forward-char 1))) | |
1824 | |
1825 (defun org-promote () | |
1826 "Promote the current heading higher up the tree. | |
1827 If the region is active in transient-mark-mode, promote all headings | |
1828 in the region." | |
1829 (org-back-to-heading t) | |
1830 (let* ((level (save-match-data (funcall outline-level))) | |
1831 (up-head (make-string (1- level) ?*))) | |
1832 (if (= level 1) (error "Cannot promote to level 0. UNDO to recover.")) | |
1833 (replace-match up-head nil t) | |
1834 (if org-adapt-indentation | |
1835 (org-fixup-indentation "^ " "" "^ ?\\S-")))) | |
1836 | |
1837 (defun org-demote () | |
1838 "Demote the current heading lower down the tree. | |
1839 If the region is active in transient-mark-mode, demote all headings | |
1840 in the region." | |
1841 (org-back-to-heading t) | |
1842 (let* ((level (save-match-data (funcall outline-level))) | |
1843 (down-head (make-string (1+ level) ?*))) | |
1844 (replace-match down-head nil t) | |
1845 (if org-adapt-indentation | |
1846 (org-fixup-indentation "^ " " " "^\\S-")))) | |
1847 | |
1848 (defun org-map-tree (fun) | |
1849 "Call FUN for every heading underneath the current one." | |
1850 (org-back-to-heading) | |
1851 (let ((level (outline-level))) | |
1852 (save-excursion | |
1853 (funcall fun) | |
1854 (while (and (progn | |
1855 (outline-next-heading) | |
1856 (> (funcall outline-level) level)) | |
1857 (not (eobp))) | |
1858 (funcall fun))))) | |
1859 | |
1860 (defun org-map-region (fun beg end) | |
1861 "Call FUN for every heading between BEG and END." | |
1862 (let ((org-ignore-region t)) | |
1863 (save-excursion | |
1864 (setq end (copy-marker end)) | |
1865 (goto-char beg) | |
1866 ;; (if (fboundp 'deactivate-mark) (deactivate-mark)) | |
1867 ;; (if (fboundp 'zmacs-deactivate-region) (zmacs-deactivate-region)) | |
1868 (if (and (re-search-forward (concat "^" outline-regexp) nil t) | |
1869 (< (point) end)) | |
1870 (funcall fun)) | |
1871 (while (and (progn | |
1872 (outline-next-heading) | |
1873 (< (point) end)) | |
1874 (not (eobp))) | |
1875 (funcall fun))))) | |
1876 | |
1877 (defun org-fixup-indentation (from to prohibit) | |
1878 "Change the indentation in the current entry by re-replacing FROM with TO. | |
1879 However, if the regexp PROHIBIT matches at all, don't do anything. | |
1880 This is being used to change indentation along with the length of the | |
1881 heading marker. But if there are any lines which are not indented, nothing | |
1882 is changed at all." | |
1883 (save-excursion | |
1884 (let ((end (save-excursion (outline-next-heading) | |
1885 (point-marker)))) | |
1886 (unless (save-excursion (re-search-forward prohibit end t)) | |
1887 (while (re-search-forward from end t) | |
1888 (replace-match to) | |
1889 (beginning-of-line 2))) | |
1890 (move-marker end nil)))) | |
1891 | |
1892 ;;; Vertical tree motion, cutting and pasting of subtrees | |
1893 | |
1894 (defun org-move-subtree-up (&optional arg) | |
1895 "Move the current subtree up past ARG headlines of the same level." | |
1896 (interactive "p") | |
1897 (org-move-subtree-down (- (prefix-numeric-value arg)))) | |
1898 | |
1899 (defun org-move-subtree-down (&optional arg) | |
1900 "Move the current subtree down past ARG headlines of the same level." | |
1901 (interactive "p") | |
1902 (setq arg (prefix-numeric-value arg)) | |
1903 (let ((movfunc (if (> arg 0) 'outline-get-next-sibling | |
1904 'outline-get-last-sibling)) | |
1905 (ins-point (make-marker)) | |
1906 (cnt (abs arg)) | |
1907 beg end txt folded) | |
1908 ;; Select the tree | |
1909 (org-back-to-heading) | |
1910 (setq beg (point)) | |
1911 (save-match-data | |
1912 (save-excursion (outline-end-of-heading) | |
1913 (setq folded (org-invisible-p))) | |
1914 (outline-end-of-subtree)) | |
1915 (if (equal (char-after) ?\n) (forward-char 1)) | |
1916 (setq end (point)) | |
1917 ;; Find insertion point, with error handling | |
1918 (goto-char beg) | |
1919 (while (> cnt 0) | |
1920 (or (and (funcall movfunc) (looking-at outline-regexp)) | |
1921 (progn (goto-char beg) | |
1922 (error "Cannot move past superior level or buffer limit"))) | |
1923 (setq cnt (1- cnt))) | |
1924 (if (> arg 0) | |
1925 ;; Moving forward - still need to move over subtree | |
1926 (progn (outline-end-of-subtree) | |
1927 (if (equal (char-after) ?\n) (forward-char 1)))) | |
1928 (move-marker ins-point (point)) | |
1929 (setq txt (buffer-substring beg end)) | |
1930 (delete-region beg end) | |
1931 (insert txt) | |
1932 (goto-char ins-point) | |
1933 (if folded (hide-subtree)) | |
1934 (move-marker ins-point nil))) | |
1935 | |
1936 (defvar org-subtree-clip "" | |
1937 "Clipboard for cut and paste of subtrees. | |
1938 This is actually only a cpoy of the kill, because we use the normal kill | |
1939 ring. We need it to check if the kill was created by `org-copy-subtree'.") | |
1940 | |
1941 (defvar org-subtree-clip-folded nil | |
1942 "Was the last copied suptree folded? | |
1943 This is used to fold the tree back after pasting.") | |
1944 | |
1945 (defun org-cut-subtree (&optional arg) | |
1946 "Cut the current subtree into the clipboard. | |
1947 This is a short-hand for marking the subtree and then cutting it." | |
1948 (interactive "p") | |
1949 (org-copy-subtree arg 'cut)) | |
1950 | |
1951 (defun org-copy-subtree (&optional arg cut) | |
1952 "Cut the current subtree into the clipboard. | |
1953 This is a short-hand for marking the subtree and then copying it. | |
1954 If CUT is non nil, actually cur the subtree." | |
1955 (interactive "p") | |
1956 (let (beg end folded) | |
1957 (org-back-to-heading) | |
1958 (setq beg (point)) | |
1959 (save-match-data | |
1960 (save-excursion (outline-end-of-heading) | |
1961 (setq folded (org-invisible-p))) | |
1962 (outline-end-of-subtree)) | |
1963 (if (equal (char-after) ?\n) (forward-char 1)) | |
1964 (setq end (point)) | |
1965 (goto-char beg) | |
1966 (when (> end beg) | |
1967 (setq org-subtree-clip-folded folded) | |
1968 (if cut (kill-region beg end) (copy-region-as-kill beg end)) | |
1969 (setq org-subtree-clip (current-kill 0)) | |
1970 (message "%s: Subtree with %d characters" | |
1971 (if cut "Cut" "Copied") | |
1972 (length org-subtree-clip))))) | |
1973 | |
1974 (defun org-paste-subtree (&optional level tree) | |
1975 "Paste the clipboard as a subtree, with modification of headline level. | |
1976 The entire subtree is promoted or demoted in order to match a new headline | |
1977 level. By default, the new level is derived from the visible headings | |
1978 before and after the insertion point, and taken to be the inferior headline | |
1979 level of the two. So if the previous visible heading is level 3 and the | |
1980 next is level 4 (or vice versa), level 4 will be used for insertion. | |
1981 This makes sure that the subtree remains an independent subtree and does | |
1982 not swallow low level entries. | |
1983 | |
1984 You can also force a different level, either by using a numeric prefix | |
1985 argument, or by inserting the heading marker by hand. For example, if the | |
1986 cursor is after \"*****\", then the tree will be shifted to level 5. | |
1987 | |
1988 If you want to insert the tree as is, just use \\[yank]. | |
1989 | |
1990 If optional TREE is given, use this text instead of the kill ring." | |
1991 (interactive "P") | |
1992 (unless (org-kill-is-subtree-p tree) | |
1993 (error | |
1994 (substitute-command-keys | |
1995 "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) | |
1996 (let* ((txt (or tree (current-kill 0))) | |
1997 (^re (concat "^\\(" outline-regexp "\\)")) | |
1998 (re (concat "\\(" outline-regexp "\\)")) | |
1999 (^re_ (concat "\\(" outline-regexp "\\)[ \t]*")) | |
2000 | |
2001 (old-level (if (string-match ^re txt) | |
2002 (- (match-end 0) (match-beginning 0)) | |
2003 -1)) | |
2004 (force-level (cond (level (prefix-numeric-value level)) | |
2005 ((string-match | |
2006 ^re_ (buffer-substring (point-at-bol) (point))) | |
2007 (- (match-end 0) (match-beginning 0))) | |
2008 (t nil))) | |
2009 (prevous-level (save-excursion | |
2010 (outline-previous-visible-heading 1) | |
2011 (if (looking-at re) | |
2012 (- (match-end 0) (match-beginning 0)) | |
2013 1))) | |
2014 (next-level (save-excursion | |
2015 (outline-next-visible-heading 1) | |
2016 (if (looking-at re) | |
2017 (- (match-end 0) (match-beginning 0)) | |
2018 1))) | |
2019 (new-level (or force-level (max prevous-level next-level))) | |
2020 (shift (if (or (= old-level -1) | |
2021 (= new-level -1) | |
2022 (= old-level new-level)) | |
2023 0 | |
2024 (- new-level old-level))) | |
2025 (shift1 shift) | |
2026 (delta (if (> shift 0) -1 1)) | |
2027 (func (if (> shift 0) 'org-demote 'org-promote)) | |
2028 beg end) | |
2029 ;; Remove the forces level indicator | |
2030 (if force-level | |
2031 (delete-region (point-at-bol) (point))) | |
2032 ;; Make sure we start at the beginning of an empty line | |
2033 (if (not (bolp)) (insert "\n")) | |
2034 (if (not (looking-at "[ \t]*$")) | |
2035 (progn (insert "\n") (backward-char 1))) | |
2036 ;; Paste | |
2037 (setq beg (point)) | |
2038 (insert txt) | |
2039 (setq end (point)) | |
2040 (goto-char beg) | |
2041 ;; Shift if necessary | |
2042 (if (= shift 0) | |
2043 (message "Pasted at level %d, without shift" new-level) | |
2044 (save-restriction | |
2045 (narrow-to-region beg end) | |
2046 (while (not (= shift 0)) | |
2047 (org-map-region func (point-min) (point-max)) | |
2048 (setq shift (+ delta shift))) | |
2049 (goto-char (point-min)) | |
2050 (message "Pasted at level %d, with shift by %d levels" | |
2051 new-level shift1))) | |
2052 (if (and (eq org-subtree-clip (current-kill 0)) | |
2053 org-subtree-clip-folded) | |
2054 ;; The tree was folded before it was killed/copied | |
2055 (hide-subtree)))) | |
2056 | |
2057 (defun org-kill-is-subtree-p (&optional txt) | |
2058 "Check if the current kill is an outline subtree, or a set of trees. | |
2059 Returns nil if kill does not start with a headline, or if the first | |
2060 headline level is not the largest headline level in the tree. | |
2061 So this will actually acceept several entries of equal levels as well, | |
2062 which is OK for `org-paste-subtree'. | |
2063 If optional TXT is given, check this string instead of the current kill." | |
2064 (let* ((kill (or txt (current-kill 0) "")) | |
2065 (start-level (and (string-match (concat "\\`" outline-regexp) kill) | |
2066 (- (match-end 0) (match-beginning 0)))) | |
2067 (re (concat "^" outline-regexp)) | |
2068 (start 1)) | |
2069 (if (not start-level) | |
2070 nil ;; does not even start with a heading | |
2071 (catch 'exit | |
2072 (while (setq start (string-match re kill (1+ start))) | |
2073 (if (< (- (match-end 0) (match-beginning 0)) start-level) | |
2074 (throw 'exit nil))) | |
2075 t)))) | |
2076 | |
2077 ;;; Completion | |
2078 | |
2079 (defun org-complete (&optional arg) | |
2080 "Perform completion on word at point. | |
2081 At the beginning of a headline, this completes TODO keywords as given in | |
2082 `org-todo-keywords'. | |
2083 If the current word is preceeded by a backslash, completes the TeX symbols | |
2084 that are supported for HTML support. | |
2085 If the current word is preceeded by \"#+\", completes special words for | |
2086 setting file options. | |
2087 At all other locations, this simply calls `ispell-complete-word'." | |
2088 (interactive "P") | |
2089 (catch 'exit | |
2090 (let* ((end (point)) | |
2091 (beg (save-excursion | |
2092 (if (equal (char-before (point)) ?\ ) (backward-char 1)) | |
2093 (skip-chars-backward "a-zA-Z0-9_:") | |
2094 (point))) | |
2095 (texp (equal (char-before beg) ?\\)) | |
2096 (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) | |
2097 beg) | |
2098 "#+")) | |
2099 (pattern (buffer-substring-no-properties beg end)) | |
2100 (completion-ignore-case opt) | |
2101 (type nil) | |
2102 (table (cond | |
2103 (opt | |
2104 (setq type :opt) | |
2105 (mapcar (lambda (x) | |
2106 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) | |
2107 (cons (match-string 2 x) (match-string 1 x))) | |
2108 (org-split-string (org-get-current-options) "\n"))) | |
2109 (texp | |
2110 (setq type :tex) | |
2111 org-html-entities) | |
2112 ((string-match "\\`\\*+[ \t]*\\'" | |
2113 (buffer-substring (point-at-bol) beg)) | |
2114 (setq type :todo) | |
2115 (mapcar 'list org-todo-keywords)) | |
2116 (t (progn (ispell-complete-word arg) (throw 'exit nil))))) | |
2117 (completion (try-completion pattern table))) | |
2118 (cond ((eq completion t) | |
2119 (if (equal type :opt) | |
2120 (insert (substring (cdr (assoc (upcase pattern) table)) | |
2121 (length pattern))))) | |
2122 ((null completion) | |
2123 (message "Can't find completion for \"%s\"" pattern) | |
2124 (ding)) | |
2125 ((not (string= pattern completion)) | |
2126 (delete-region beg end) | |
2127 (if (string-match " +$" completion) | |
2128 (setq completion (replace-match "" t t completion))) | |
2129 (insert completion) | |
2130 (if (get-buffer-window "*Completions*") | |
2131 (delete-window (get-buffer-window "*Completions*"))) | |
2132 (if (and (eq type :todo) | |
2133 (assoc completion table)) | |
2134 (insert " ")) | |
2135 (if (and (equal type :opt) (assoc completion table)) | |
2136 (message (substitute-command-keys | |
2137 "Press \\[org-complete] again to insert example settings")))) | |
2138 (t | |
2139 (message "Making completion list...") | |
2140 (let ((list (sort (all-completions pattern table) 'string<))) | |
2141 (with-output-to-temp-buffer "*Completions*" | |
2142 (display-completion-list list))) | |
2143 (message "Making completion list...%s" "done")))))) | |
2144 | |
2145 ;;; Comments, TODO and DEADLINE | |
2146 | |
2147 (defun org-toggle-comment () | |
2148 "Change the COMMENT state of an entry." | |
2149 (interactive) | |
2150 (save-excursion | |
2151 (org-back-to-heading) | |
2152 (if (looking-at (concat outline-regexp | |
2153 "\\( +\\<" org-comment-string "\\>\\)")) | |
2154 (replace-match "" t t nil 1) | |
2155 (if (looking-at outline-regexp) | |
2156 (progn | |
2157 (goto-char (match-end 0)) | |
2158 (insert " " org-comment-string)))))) | |
2159 | |
2160 (defun org-todo (&optional arg) | |
2161 "Change the TODO state of an item. | |
2162 The state of an item is given by a keyword at the start of the heading, | |
2163 like | |
2164 *** TODO Write paper | |
2165 *** DONE Call mom | |
2166 | |
2167 The different keywords are specified in the variable `org-todo-keywords'. By | |
2168 default the available states are \"TODO\" and \"DONE\". | |
2169 So for this example: when the item starts with TODO, it is changed to DONE. | |
2170 When it starts with DONE, the DONE is removed. And when neither TODO nor | |
2171 DONE are present, add TODO at the beginning of the heading. | |
2172 | |
2173 With prefix arg, use completion to determined the new state. With numeric | |
2174 prefix arg, switch to that state." | |
2175 (interactive "P") | |
2176 (save-excursion | |
2177 (org-back-to-heading) | |
2178 (if (looking-at outline-regexp) (goto-char (match-end 0))) | |
2179 (or (looking-at (concat " +" org-todo-regexp " *")) | |
2180 (looking-at " *")) | |
2181 (let* ((this (match-string 1)) | |
2182 (completion-ignore-case t) | |
2183 (member (member this org-todo-keywords)) | |
2184 (tail (cdr member)) | |
2185 (state (cond | |
2186 ((equal arg '(4)) | |
2187 ;; Read a state with completion | |
2188 (completing-read "State: " (mapcar (lambda(x) (list x)) | |
2189 org-todo-keywords) | |
2190 nil t)) | |
2191 (arg | |
2192 ;; user requests a specific state | |
2193 (nth (1- (prefix-numeric-value arg)) | |
2194 org-todo-keywords)) | |
2195 ((null member) (car org-todo-keywords)) | |
2196 ((null tail) nil) ;; -> first entry | |
2197 ((eq org-todo-interpretation 'sequence) | |
2198 (car tail)) | |
2199 ((memq org-todo-interpretation '(type priority)) | |
2200 (if (eq this-command last-command) | |
2201 (car tail) | |
2202 (if (> (length tail) 0) org-done-string nil))) | |
2203 (t nil))) | |
2204 (next (if state (concat " " state " ") " "))) | |
2205 (replace-match next t t) | |
2206 (run-hooks 'org-after-todo-state-change-hook))) | |
2207 ;; Fixup cursor location if close to the keyword | |
2208 (if (and (outline-on-heading-p) | |
2209 (not (bolp)) | |
2210 (save-excursion (goto-char (point-at-bol)) | |
2211 (looking-at org-todo-line-regexp)) | |
2212 (< (point) (+ 2 (or (match-end 2) (match-end 1))))) | |
2213 (progn | |
2214 (goto-char (or (match-end 2) (match-end 1))) | |
2215 (just-one-space)))) | |
2216 | |
2217 (defun org-show-todo-tree (arg) | |
2218 "Make a compact tree which shows all headlines marked with TODO. | |
2219 The tree will show the lines where the regexp matches, and all higher | |
2220 headlines above the match." | |
2221 (interactive "P") | |
2222 (let ((case-fold-search nil) | |
2223 (kwd-re (if arg org-todo-regexp org-not-done-regexp))) | |
2224 (message "%d TODO entries found" | |
2225 (org-occur (concat "^" outline-regexp " +" kwd-re ))))) | |
2226 | |
2227 (defun org-deadline () | |
2228 "Insert the DEADLINE: string to make a deadline. | |
2229 A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] | |
2230 to modify it to the correct date." | |
2231 (interactive) | |
2232 (insert | |
2233 org-deadline-string " " | |
2234 (format-time-string (car org-time-stamp-formats) | |
2235 (org-read-date nil 'to-time))) | |
2236 (message (substitute-command-keys | |
2237 "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) | |
2238 | |
2239 (defun org-schedule () | |
2240 "Insert the SCHEDULED: string to schedule a TODO item. | |
2241 A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] | |
2242 to modify it to the correct date." | |
2243 (interactive) | |
2244 (insert | |
2245 org-scheduled-string " " | |
2246 (format-time-string (car org-time-stamp-formats) | |
2247 (org-read-date nil 'to-time))) | |
2248 (message (substitute-command-keys | |
2249 "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) | |
2250 | |
2251 | |
2252 (defun org-occur (regexp &optional callback) | |
2253 "Make a compact tree which shows all matches of REGEXP. | |
2254 The tree will show the lines where the regexp matches, and all higher | |
2255 headlines above the match. It will also show the heading after the match, | |
2256 to make sure editing the matching entry is easy. | |
2257 if CALLBACK is non-nil, it is a function which is called to confirm | |
2258 that the match should indeed be shown." | |
2259 (interactive "sRegexp: ") | |
2260 (setq regexp (org-check-occur-regexp regexp)) | |
2261 (let ((cnt 0)) | |
2262 (save-excursion | |
2263 (goto-char (point-min)) | |
2264 (hide-sublevels 1) | |
2265 (while (re-search-forward regexp nil t) | |
2266 (when (or (not callback) | |
2267 (funcall callback)) | |
2268 (setq cnt (1+ cnt)) | |
2269 (org-show-hierarchy-above)))) | |
2270 (if (interactive-p) | |
2271 (message "%d match(es) for regexp %s" cnt regexp)) | |
2272 cnt)) | |
2273 | |
2274 | |
2275 (defun org-show-hierarchy-above () | |
2276 "Make sure point and the headings hierarchy above is visible." | |
2277 (if (org-on-heading-p t) | |
2278 (org-flag-heading nil) ; only show the heading | |
2279 (org-show-hidden-entry)) ; show entire entry | |
2280 (save-excursion | |
2281 (and (outline-next-heading) | |
2282 (org-flag-heading nil))) ; show the next heading | |
2283 (save-excursion ; show all higher headings | |
2284 (while (condition-case nil | |
2285 (progn (org-up-heading-all 1) t) | |
2286 (error nil)) | |
2287 (org-flag-heading nil)))) | |
2288 | |
2289 ;;; Priorities | |
2290 | |
2291 (defvar org-priority-regexp ".*?\\(\\[#\\([A-Z]\\)\\] ?\\)" | |
2292 "Regular expression matching the priority indicator.") | |
2293 | |
2294 (defun org-priority-up () | |
2295 "Increase the priority of the current item." | |
2296 (interactive) | |
2297 (org-priority 'up)) | |
2298 | |
2299 (defun org-priority-down () | |
2300 "Decrease the priority of the current item." | |
2301 (interactive) | |
2302 (org-priority 'down)) | |
2303 | |
2304 (defun org-priority (&optional action) | |
2305 "Change the priority of an item by ARG. | |
2306 ACTION can be set, up, or down." | |
2307 (interactive) | |
2308 (setq action (or action 'set)) | |
2309 (let (current new news have remove) | |
2310 (save-excursion | |
2311 (org-back-to-heading) | |
2312 (if (looking-at org-priority-regexp) | |
2313 (setq current (string-to-char (match-string 2)) | |
2314 have t) | |
2315 (setq current org-default-priority)) | |
2316 (cond | |
2317 ((eq action 'set) | |
2318 (message (format "Priority A-%c, SPC to remove: " org-lowest-priority)) | |
2319 (setq new (read-char-exclusive)) | |
2320 (if (equal new ?\ ) (setq remove t))) | |
2321 ((eq action 'up) | |
2322 (setq new (1- current))) | |
2323 ((eq action 'down) | |
2324 (setq new (1+ current))) | |
2325 (t (error "Illegal ection"))) | |
2326 (setq new (min (max ?A (upcase new)) org-lowest-priority)) | |
2327 (setq news (format "%c" new)) | |
2328 (if have | |
2329 (if remove | |
2330 (replace-match "" t t nil 1) | |
2331 (replace-match news t t nil 2)) | |
2332 (looking-at org-todo-line-regexp) | |
2333 (if (match-end 2) | |
2334 (progn | |
2335 (goto-char (match-end 2)) | |
2336 (insert " [#" news "]")) | |
2337 (goto-char (match-beginning 3)) | |
2338 (insert "[#" news "] ")))) | |
2339 (if remove | |
2340 (message "Priority removed") | |
2341 (message "Priority of current item set to %s" news)))) | |
2342 | |
2343 | |
2344 (defun org-get-priority (s) | |
2345 "Find priority cookie and return priority." | |
2346 (save-match-data | |
2347 (if (not (string-match org-priority-regexp s)) | |
2348 (* 1000 (- org-lowest-priority org-default-priority)) | |
2349 (* 1000 (- org-lowest-priority | |
2350 (string-to-char (match-string 2 s))))))) | |
2351 | |
2352 ;;; Timestamps | |
2353 | |
2354 (defvar org-last-changed-timestamp nil) | |
2355 | |
2356 (defun org-time-stamp (arg) | |
2357 "Prompt for a date/time and insert a time stamp. | |
2358 If the user specifies a time like HH:MM, or if this command is called | |
2359 with a prefix argument, the time stamp will contain date and time. | |
2360 Otherwise, only the date will be included. All parts of a date not | |
2361 specified by the user will be filled in from the current date/time. | |
2362 So if you press just return without typing anything, the time stamp | |
2363 will represent the current date/time. If there is already a timestamp | |
2364 at the cursoe, it will be modified." | |
2365 (interactive "P") | |
2366 (let ((fmt (if arg (cdr org-time-stamp-formats) | |
2367 (car org-time-stamp-formats))) | |
2368 (org-time-was-given nil) | |
2369 time) | |
2370 (cond | |
2371 ((and (org-at-timestamp-p) | |
2372 (eq last-command 'org-time-stamp) | |
2373 (eq this-command 'org-time-stamp)) | |
2374 (insert "--") | |
2375 (setq time (let ((this-command this-command)) | |
2376 (org-read-date arg 'totime))) | |
2377 (if org-time-was-given (setq fmt (cdr org-time-stamp-formats))) | |
2378 (insert (format-time-string fmt time))) | |
2379 ((org-at-timestamp-p) | |
2380 (setq time (let ((this-command this-command)) | |
2381 (org-read-date arg 'totime))) | |
2382 (and (org-at-timestamp-p) (replace-match | |
2383 (setq org-last-changed-timestamp | |
2384 (format-time-string fmt time)) | |
2385 t t)) | |
2386 (message "Timestamp updated")) | |
2387 (t | |
2388 (setq time (let ((this-command this-command)) | |
2389 (org-read-date arg 'totime))) | |
2390 (if org-time-was-given (setq fmt (cdr org-time-stamp-formats))) | |
2391 (insert (format-time-string fmt time)))))) | |
2392 | |
2393 ;;; FIXME: Make the function take "Fri" as "next friday" | |
2394 (defun org-read-date (&optional with-time to-time) | |
2395 "Read a date and make things smooth for the user. | |
2396 The prompt will suggest to enter an ISO date, but you can also enter anything | |
2397 which will at least partially be understood by `parse-time-string'. | |
2398 Unrecognized parts of the date will default to the current day, month ,year, | |
2399 hour and minute. For example, | |
2400 3-2-5 --> 2003-02-05 | |
2401 feb 15 --> currentyear-02-15 | |
2402 sep 12 9 --> 2009-09-12 | |
2403 12:45 --> today 12:45 | |
2404 22 sept 0:34 --> currentyear-09-22 0:34 | |
2405 12 --> currentyear-currentmonth-12 | |
2406 etc. | |
2407 The function understands only English month and weekday abbreviations, | |
2408 but this can be configured with the variables `parse-time-months' and | |
2409 `parse-time-weekdays'. | |
2410 | |
2411 While prompting, a calendar is popped up - you can also select the | |
2412 date with the mouse (button 1). The calendar shows a period of three | |
2413 month. To scroll it to other months, use the keys `>' and `<'. | |
2414 If you don't like the calendar, turn it off with | |
2415 \(setq org-popup-calendar-for-date-prompt nil). | |
2416 | |
2417 With optional argument TO-TIME, the date will immediately be converted | |
2418 to an internal time. | |
2419 With an optional argument WITH-TIME, the prompt will suggest to also | |
2420 insert a time. Note that when WITH-TIME is not set, you can still | |
2421 enter a time, and this function will inform the calling routine about | |
2422 this change. The calling routine may then choose to change the format | |
2423 used to insert the time stamp into the buffer to include the time." | |
2424 (let* ((default-time | |
2425 ;; Default time is either today, or, when entering a range, | |
2426 ;; the range start. | |
2427 (if (save-excursion | |
2428 (re-search-backward | |
2429 (concat org-ts-regexp "--\\=") | |
2430 (- (point) 20) t)) | |
2431 (apply | |
2432 'encode-time | |
2433 (mapcar (lambda(x) (or x 0)) ;; FIXME: Problem with timezone? | |
2434 (parse-time-string (match-string 1)))) | |
2435 (current-time))) | |
2436 (timestr (format-time-string | |
2437 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time)) | |
2438 (prompt (format "YYYY-MM-DD [%s]: " timestr)) | |
2439 ans ans1 ans2 | |
2440 second minute hour day month year tl) | |
2441 | |
2442 (if org-popup-calendar-for-date-prompt | |
2443 ;; Also show a calendar for date selection | |
2444 ;; Copied (with modifications) from planner.el by John Wiegley | |
2445 (save-excursion | |
2446 (save-window-excursion | |
2447 (calendar) | |
2448 (calendar-forward-day (- (time-to-days default-time) | |
2449 (calendar-absolute-from-gregorian | |
2450 (calendar-current-date)))) | |
2451 (let* ((old-map (current-local-map)) | |
2452 (map (copy-keymap calendar-mode-map)) | |
2453 (minibuffer-local-map (copy-keymap minibuffer-local-map))) | |
2454 (define-key map (kbd "RET") 'org-calendar-select) | |
2455 (define-key map (if org-xemacs-p [button1] [mouse-1]) | |
2456 'org-calendar-select) | |
2457 (define-key minibuffer-local-map [(meta shift left)] | |
2458 (lambda () (interactive) | |
2459 (org-eval-in-calendar '(calendar-backward-month 1)))) | |
2460 (define-key minibuffer-local-map [(meta shift right)] | |
2461 (lambda () (interactive) | |
2462 (org-eval-in-calendar '(calendar-forward-month 1)))) | |
2463 (define-key minibuffer-local-map [(shift up)] | |
2464 (lambda () (interactive) | |
2465 (org-eval-in-calendar '(calendar-backward-week 1)))) | |
2466 (define-key minibuffer-local-map [(shift down)] | |
2467 (lambda () (interactive) | |
2468 (org-eval-in-calendar '(calendar-forward-week 1)))) | |
2469 (define-key minibuffer-local-map [(shift left)] | |
2470 (lambda () (interactive) | |
2471 (org-eval-in-calendar '(calendar-backward-day 1)))) | |
2472 (define-key minibuffer-local-map [(shift right)] | |
2473 (lambda () (interactive) | |
2474 (org-eval-in-calendar '(calendar-forward-day 1)))) | |
2475 (define-key minibuffer-local-map ">" | |
2476 (lambda () (interactive) | |
2477 (org-eval-in-calendar '(scroll-calendar-left 1)))) | |
2478 (define-key minibuffer-local-map "<" | |
2479 (lambda () (interactive) | |
2480 (org-eval-in-calendar '(scroll-calendar-right 1)))) | |
2481 (unwind-protect | |
2482 (progn | |
2483 (use-local-map map) | |
2484 (setq ans (read-string prompt "" nil nil)) | |
2485 (setq ans (or ans1 ans2 ans))) | |
2486 (use-local-map old-map))))) | |
2487 ;; Naked prompt only | |
2488 (setq ans (read-string prompt "" nil timestr))) | |
2489 | |
2490 (if (string-match | |
2491 "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans) | |
2492 (progn | |
2493 (setq year (if (match-end 2) | |
2494 (string-to-number (match-string 2 ans)) | |
2495 (string-to-number (format-time-string "%Y"))) | |
2496 month (string-to-number (match-string 3 ans)) | |
2497 day (string-to-number (match-string 4 ans))) | |
2498 (if (< year 100) (setq year (+ 2000 year))) | |
2499 (setq ans (replace-match (format "%04d-%02d-%02d" year month day) | |
2500 t t ans)))) | |
2501 (setq tl (parse-time-string ans) | |
2502 year (or (nth 5 tl) (string-to-number (format-time-string "%Y"))) | |
2503 month (or (nth 4 tl) (string-to-number (format-time-string "%m"))) | |
2504 day (or (nth 3 tl) (string-to-number (format-time-string "%d"))) | |
2505 hour (or (nth 2 tl) (string-to-number (format-time-string "%H"))) | |
2506 minute (or (nth 1 tl) (string-to-number (format-time-string "%M"))) | |
2507 second (or (nth 0 tl) 0)) | |
2508 (if (and (boundp 'org-time-was-given) | |
2509 (nth 2 tl)) | |
2510 (setq org-time-was-given t)) | |
2511 (if (< year 100) (setq year (+ 2000 year))) | |
2512 (if to-time | |
2513 (encode-time second minute hour day month year) | |
2514 (if (or (nth 1 tl) (nth 2 tl)) | |
2515 (format "%04d-%02d-%02d %02d:%02d" year month day hour minute) | |
2516 (format "%04d-%02d-%02d" year month day))))) | |
2517 | |
2518 (defun org-eval-in-calendar (form) | |
2519 "Eval FORM in the calendar window and return to current window. | |
2520 Also, store the cursor date in variable ans2." | |
2521 (let ((sw (selected-window))) | |
2522 (select-window (get-buffer-window "*Calendar*")) | |
2523 (eval form) | |
2524 (when (calendar-cursor-to-date) | |
2525 (let* ((date (calendar-cursor-to-date)) | |
2526 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
2527 (setq ans2 (format-time-string "%Y-%m-%d" time)))) | |
2528 (select-window sw))) | |
2529 | |
2530 (defun org-calendar-select () | |
2531 "Return to `org-read-date' with the date currently selected. | |
2532 This is used by `org-read-date' in a temporary keymap for the calendar buffer." | |
2533 (interactive) | |
2534 (when (calendar-cursor-to-date) | |
2535 (let* ((date (calendar-cursor-to-date)) | |
2536 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
2537 (setq ans1 (format-time-string "%Y-%m-%d" time))) | |
2538 (if (active-minibuffer-window) (exit-minibuffer)))) | |
2539 | |
2540 (defun org-check-deadlines (ndays) | |
2541 "Check if there are any deadlines due or past due. | |
2542 A deadline is considered due if it happens within `org-deadline-warning-days' | |
2543 days from todays date. If the deadline appears in an entry marked DONE, | |
2544 it is not shown. The prefix arg NDAYS can be used to test that many | |
2545 days. If the prefix are is a raw C-u prefix, all deadlines are shown." | |
2546 (interactive "P") | |
2547 (let* ((org-warn-days | |
2548 (cond | |
2549 ((equal ndays '(4)) 100000) | |
2550 (ndays (prefix-numeric-value ndays)) | |
2551 (t org-deadline-warning-days))) | |
2552 (case-fold-search nil) | |
2553 (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) | |
2554 (callback | |
2555 (lambda () | |
2556 (and (let ((d1 (time-to-days (current-time))) | |
2557 (d2 (time-to-days | |
2558 (org-time-string-to-time (match-string 1))))) | |
2559 (< (- d2 d1) org-warn-days)) | |
2560 (not (org-entry-is-done-p)))))) | |
2561 (message "%d deadlines past-due or due within %d days" | |
2562 (org-occur regexp callback) | |
2563 org-warn-days))) | |
2564 | |
2565 (defun org-evaluate-time-range (&optional to-buffer) | |
2566 "Evaluate a time range by computing the difference between start and end. | |
2567 Normally the result is just printed in the echo area, but with prefix arg | |
2568 TO-BUFFER, the result is inserted just after the date stamp into the buffer. | |
2569 If the time range is actually in a table, the result is inserted into the | |
2570 next column. | |
2571 For time difference computation, a year is assumed to be exactly 365 | |
2572 days in order to avoid rounding problems." | |
2573 (interactive "P") | |
2574 (save-excursion | |
2575 (unless (org-at-date-range-p) | |
2576 (goto-char (point-at-bol)) | |
2577 (re-search-forward org-tr-regexp (point-at-eol) t)) | |
2578 (if (not (org-at-date-range-p)) | |
2579 (error "Not at a time-stamp range, and none found in current line."))) | |
2580 (let* ((ts1 (match-string 1)) | |
2581 (ts2 (match-string 2)) | |
2582 (match-end (match-end 0)) | |
2583 (time1 (org-time-string-to-time ts1)) | |
2584 (time2 (org-time-string-to-time ts2)) | |
2585 (t1 (time-to-seconds time1)) | |
2586 (t2 (time-to-seconds time2)) | |
2587 (diff (abs (- t2 t1))) | |
2588 (negative (< (- t2 t1) 0)) | |
2589 (ys (floor (* 365 24 60 60))) | |
2590 (ds (* 24 60 60)) | |
2591 (hs (* 60 60)) | |
2592 (fy "%dy %dd %02d:%02d") | |
2593 (fd "%dd %02d:%02d") | |
2594 (fh "%02d:%02d") | |
2595 y d h m align) | |
2596 (setq y (floor (/ diff ys)) diff (mod diff ys) | |
2597 d (floor (/ diff ds)) diff (mod diff ds) | |
2598 h (floor (/ diff hs)) diff (mod diff hs) | |
2599 m (floor (/ diff 60))) | |
2600 (if to-buffer | |
2601 (progn | |
2602 (goto-char match-end) | |
2603 (when (and (org-at-table-p) (looking-at " *|")) | |
2604 (setq align t) | |
2605 (goto-char (match-end 0))) | |
2606 (if (looking-at | |
2607 "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") | |
2608 (replace-match "")) | |
2609 (if negative (insert " -")) | |
2610 (if (> y 0) (insert " " (format fy y d h m)) | |
2611 (if (> d 0) (insert " " (format fd d h m)) | |
2612 (insert " " (format fh h m)))) | |
2613 (if align (org-table-align)) | |
2614 (message "Time difference inserted")) | |
2615 (message (org-make-tdiff-string y d h m))))) | |
2616 | |
2617 (defun org-make-tdiff-string (y d h m) | |
2618 (let ((fmt "") | |
2619 (l nil)) | |
2620 (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ") | |
2621 l (push y l))) | |
2622 (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ") | |
2623 l (push d l))) | |
2624 (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ") | |
2625 l (push h l))) | |
2626 (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ") | |
2627 l (push m l))) | |
2628 (apply 'format fmt (nreverse l)))) | |
2629 | |
2630 (defun org-time-string-to-time (s) | |
2631 (apply 'encode-time (org-parse-time-string s))) | |
2632 | |
2633 (defun org-parse-time-string (s) | |
2634 "Parse the standard Org-mode time string. | |
2635 This should be a lot faster than the normal parse-time-string." | |
2636 (if (string-match org-ts-regexp1 s) | |
2637 (list 0 | |
2638 (string-to-number (or (match-string 8 s) "0")) | |
2639 (string-to-number (or (match-string 7 s) "0")) | |
2640 (string-to-number (match-string 4 s)) | |
2641 (string-to-number (match-string 3 s)) | |
2642 (string-to-number (match-string 2 s)) | |
2643 nil nil nil) | |
2644 (make-list 9 0))) | |
2645 | |
2646 (defun org-timestamp-up (&optional arg) | |
2647 "Increase the date item at the cursor by one. | |
2648 If the cursor is on the year, change the year. If it is on the month or | |
2649 the day, change that. | |
2650 With prefix ARG, change by that many units." | |
2651 (interactive "p") | |
2652 (org-timestamp-change (prefix-numeric-value arg))) | |
2653 | |
2654 (defun org-timestamp-down (&optional arg) | |
2655 "Decrease the date item at the cursor by one. | |
2656 If the cursor is on the year, change the year. If it is on the month or | |
2657 the day, change that. | |
2658 With prefix ARG, change by that many units." | |
2659 (interactive "p") | |
2660 (org-timestamp-change (- (prefix-numeric-value arg)))) | |
2661 | |
2662 (defun org-timestamp-up-day (&optional arg) | |
2663 "Increase the date in the time stamp by one day. | |
2664 With prefix ARG, change that many days." | |
2665 (interactive "p") | |
2666 (org-timestamp-change (prefix-numeric-value arg) 'day)) | |
2667 | |
2668 (defun org-timestamp-down-day (&optional arg) | |
2669 "Increase the date in the time stamp by one day. | |
2670 With prefix ARG, change that many days." | |
2671 (interactive "p") | |
2672 (org-timestamp-change (- (prefix-numeric-value arg)) 'day)) | |
2673 | |
2674 (defsubst org-pos-in-match-range (pos n) | |
2675 (and (match-beginning n) | |
2676 (<= (match-beginning n) pos) | |
2677 (>= (match-end n) pos))) | |
2678 | |
2679 (defun org-at-timestamp-p () | |
2680 "Determine if the the cursor is in or at a timestamp." | |
2681 (interactive) | |
2682 (let* ((tsr org-ts-regexp2) | |
2683 (pos (point)) | |
2684 (ans (or (looking-at tsr) | |
2685 (save-excursion | |
2686 (skip-chars-backward "^<\n\r\t") | |
2687 (if (> (point) 1) (backward-char 1)) | |
2688 (and (looking-at tsr) | |
2689 (> (- (match-end 0) pos) -1)))))) | |
2690 (and (boundp 'org-ts-what) | |
2691 (setq org-ts-what | |
2692 (cond | |
2693 ((org-pos-in-match-range pos 2) 'year) | |
2694 ((org-pos-in-match-range pos 3) 'month) | |
2695 ((org-pos-in-match-range pos 7) 'hour) | |
2696 ((org-pos-in-match-range pos 8) 'minute) | |
2697 ((or (org-pos-in-match-range pos 4) | |
2698 (org-pos-in-match-range pos 5)) 'day) | |
2699 (t 'day)))) | |
2700 ans)) | |
2701 | |
2702 (defun org-timestamp-change (n &optional what) | |
2703 "Change the date in the time stamp at point. | |
2704 The date will be changed by N times WHAT. WHAT can be `day', `month', | |
2705 `year', `minute', `second'. If WHAT is not given, the cursor position | |
2706 in the timestamp determines what will be changed." | |
2707 (let ((fmt (car org-time-stamp-formats)) | |
2708 org-ts-what | |
2709 (pos (point)) | |
2710 ts time time0) | |
2711 (if (not (org-at-timestamp-p)) | |
2712 (error "Not at a timestamp")) | |
2713 (setq org-ts-what (or what org-ts-what)) | |
2714 (setq fmt (if (<= (abs (- (cdr org-ts-lengths) | |
2715 (- (match-end 0) (match-beginning 0)))) | |
2716 1) | |
2717 (cdr org-time-stamp-formats) | |
2718 (car org-time-stamp-formats))) | |
2719 (setq ts (match-string 0)) | |
2720 (replace-match "") | |
2721 (setq time0 (org-parse-time-string ts)) | |
2722 (setq time | |
2723 (apply 'encode-time | |
2724 (append | |
2725 (list (or (car time0) 0)) | |
2726 (list (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))) | |
2727 (list (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))) | |
2728 (list (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))) | |
2729 (list (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))) | |
2730 (list (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))) | |
2731 (nthcdr 6 time0)))) | |
2732 (if (eq what 'calendar) | |
2733 (let ((cal-date | |
2734 (save-excursion | |
2735 (save-match-data | |
2736 (set-buffer "*Calendar*") | |
2737 (calendar-cursor-to-date))))) | |
2738 (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month | |
2739 (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day | |
2740 (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year | |
2741 (setcar time0 (or (car time0) 0)) | |
2742 (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) | |
2743 (setcar (nthcdr 2 time0) (or (nth 1 time0) 0)) | |
2744 (setq time (apply 'encode-time time0)))) | |
2745 (insert (setq org-last-changed-timestamp (format-time-string fmt time))) | |
2746 (goto-char pos) | |
2747 ;; Try to recenter the calendar window, if any | |
2748 (if (and org-calendar-follow-timestamp-change | |
2749 (get-buffer-window "*Calendar*" t) | |
2750 (memq org-ts-what '(day month year))) | |
2751 (org-recenter-calendar (time-to-days time))))) | |
2752 | |
2753 (defun org-recenter-calendar (date) | |
2754 "If the calendar is visible, recenter it to DATE." | |
2755 (let* ((win (selected-window)) | |
2756 (cwin (get-buffer-window "*Calendar*" t))) | |
2757 (when cwin | |
2758 (select-window cwin) | |
2759 (calendar-goto-date (if (listp date) date | |
2760 (calendar-gregorian-from-absolute date))) | |
2761 (select-window win)))) | |
2762 | |
2763 (defun org-goto-calendar (&optional arg) | |
2764 "Go to the Emacs calendar at the current date. | |
2765 If there is a time stamp in the current line, go to that date. | |
2766 A prefix ARG can be used force the current date." | |
2767 (interactive "P") | |
2768 (let ((tsr org-ts-regexp) diff) | |
2769 (if (or (org-at-timestamp-p) | |
2770 (save-excursion | |
2771 (beginning-of-line 1) | |
2772 (looking-at (concat ".*" tsr)))) | |
2773 (let ((d1 (time-to-days (current-time))) | |
2774 (d2 (time-to-days | |
2775 (org-time-string-to-time (match-string 1))))) | |
2776 (setq diff (- d2 d1)))) | |
2777 (calendar) | |
2778 (calendar-goto-today) | |
2779 (if (and diff (not arg)) (calendar-forward-day diff)))) | |
2780 | |
2781 (defun org-date-from-calendar () | |
2782 "Insert time stamp corresponding to cursor date in *Calendar* buffer. | |
2783 If there is already a time stamp at the cursor position, update it." | |
2784 (interactive) | |
2785 (org-timestamp-change 0 'calendar)) | |
2786 | |
2787 ;;; Agenda, and Diary Integration | |
2788 | |
2789 ;;; Define the mode | |
2790 | |
2791 (defvar org-agenda-mode-map (make-sparse-keymap) | |
2792 "Keymap for org-agenda-mode.") | |
2793 | |
2794 (defvar org-agenda-menu) | |
2795 (defvar org-agenda-follow-mode nil) | |
2796 (defvar org-agenda-buffer-name "*Org Agenda*") | |
2797 (defvar org-agenda-redo-command nil) | |
2798 | |
2799 ;;;###autoload | |
2800 (defun org-agenda-mode () | |
2801 "Mode for time-sorted view on action items in Org-mode files." | |
2802 (interactive) | |
2803 (kill-all-local-variables) | |
2804 (setq major-mode 'org-agenda-mode) | |
2805 (setq mode-name "Org-Agenda") | |
2806 (use-local-map org-agenda-mode-map) | |
2807 (easy-menu-add org-agenda-menu) | |
2808 (if org-startup-truncated (setq truncate-lines t)) | |
2809 (add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) | |
2810 (setq org-agenda-follow-mode nil) | |
2811 (easy-menu-change | |
2812 '("Agenda") "Agenda Files" | |
2813 (append | |
2814 (list | |
2815 ["Edit file list" (customize-variable 'org-agenda-files) t] | |
2816 "--") | |
2817 (mapcar 'org-file-menu-entry org-agenda-files))) | |
2818 (org-agenda-set-mode-name) | |
2819 (run-hooks 'org-agenda-mode-hook)) | |
2820 | |
2821 (define-key org-agenda-mode-map [(tab)] 'org-agenda-goto) | |
2822 (define-key org-agenda-mode-map [(return)] 'org-agenda-switch-to) | |
2823 (define-key org-agenda-mode-map " " 'org-agenda-show) | |
2824 (define-key org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) | |
2825 (define-key org-agenda-mode-map "o" 'delete-other-windows) | |
2826 (define-key org-agenda-mode-map "l" 'org-agenda-recenter) | |
2827 (define-key org-agenda-mode-map "t" 'org-agenda-todo) | |
2828 (define-key org-agenda-mode-map "." 'org-agenda-goto-today) | |
2829 (define-key org-agenda-mode-map "w" 'org-agenda-week-view) | |
2830 (define-key org-agenda-mode-map [(shift right)] 'org-agenda-date-later) | |
2831 (define-key org-agenda-mode-map [(shift left)] 'org-agenda-date-earlier) | |
2832 | |
2833 (define-key org-agenda-mode-map ">" 'org-agenda-date-today) | |
2834 (let ((l '(1 2 3 4 5 6 7 8 9 0))) | |
2835 (while l (define-key org-agenda-mode-map | |
2836 (int-to-string (pop l)) 'digit-argument))) | |
2837 | |
2838 (define-key org-agenda-mode-map "f" 'org-agenda-follow-mode) | |
2839 (define-key org-agenda-mode-map "d" 'org-agenda-toggle-diary) | |
2840 (define-key org-agenda-mode-map "r" 'org-agenda-redo) | |
2841 (define-key org-agenda-mode-map "q" 'org-agenda-quit) | |
2842 (define-key org-agenda-mode-map "x" 'org-agenda-exit) | |
2843 (define-key org-agenda-mode-map "P" 'org-agenda-show-priority) | |
2844 (define-key org-agenda-mode-map "p" 'org-agenda-priority) | |
2845 (define-key org-agenda-mode-map "," 'org-agenda-priority) | |
2846 (define-key org-agenda-mode-map "i" 'org-agenda-diary-entry) | |
2847 (define-key org-agenda-mode-map "+" 'org-agenda-priority-up) | |
2848 (define-key org-agenda-mode-map "-" 'org-agenda-priority-down) | |
2849 (define-key org-agenda-mode-map [(right)] 'org-agenda-later) | |
2850 (define-key org-agenda-mode-map [(left)] 'org-agenda-earlier) | |
2851 | |
2852 (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) | |
2853 "Local keymap for agenda entries from Org-mode.") | |
2854 | |
2855 (define-key org-agenda-keymap | |
2856 (if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) | |
2857 (define-key org-agenda-keymap | |
2858 (if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) | |
2859 | |
2860 (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" | |
2861 '("Agenda" | |
2862 ("Agenda Files") | |
2863 "--" | |
2864 ["Show" org-agenda-show t] | |
2865 ["Go To (other window)" org-agenda-goto t] | |
2866 ["Go To (one window)" org-agenda-switch-to t] | |
2867 ["Follow Mode" org-agenda-follow-mode | |
2868 :style toggle :selected org-agenda-follow-mode :active t] | |
2869 "--" | |
2870 ["Cycle TODO" org-agenda-todo t] | |
2871 ("Reschedule" | |
2872 ["Reschedule +1 day" org-agenda-date-later t] | |
2873 ["Reschedule -1 day" org-agenda-date-earlier t] | |
2874 "--" | |
2875 ["Reschedule to today" org-agenda-date-today t]) | |
2876 ("Priority" | |
2877 ["Set Priority" org-agenda-priority t] | |
2878 ["Increase Priority" org-agenda-priority-up t] | |
2879 ["Decrease Priority" org-agenda-priority-down t] | |
2880 ["Show Priority" org-agenda-show-priority t]) | |
2881 "--" | |
2882 ["Rebuild" org-agenda-redo t] | |
2883 ["Goto Today" org-agenda-goto-today t] | |
2884 ["Next Dates" org-agenda-later (local-variable-p 'starting-day)] | |
2885 ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)] | |
2886 "--" | |
2887 ["Week/Day View" org-agenda-week-view (local-variable-p 'starting-day)] | |
2888 ["Include Diary" org-agenda-toggle-diary | |
2889 :style toggle :selected org-agenda-include-diary :active t] | |
2890 "--" | |
2891 ["New Diary Entry" org-agenda-diary-entry t] | |
2892 "--" | |
2893 ["Quit" org-agenda-quit t] | |
2894 ["Exit and Release Buffers" org-agenda-exit t] | |
2895 )) | |
2896 | |
2897 (defvar org-agenda-markers nil | |
2898 "List of all currently active markers created by org-agenda") | |
2899 (defvar org-agenda-last-marker-time (time-to-seconds (current-time)) | |
2900 "Creation time of the last agenda marker.") | |
2901 | |
2902 (defun org-agenda-new-marker (pos) | |
2903 "Return a new agenda marker. | |
2904 Org-mode keeps a list of these markers and resets them when they are | |
2905 no longer in use." | |
2906 (let ((m (copy-marker pos))) | |
2907 (setq org-agenda-last-marker-time (time-to-seconds (current-time))) | |
2908 (push m org-agenda-markers) | |
2909 m)) | |
2910 | |
2911 (defun org-agenda-maybe-reset-markers (&optional force) | |
2912 "Reset markers created by org-agenda. But only if they are old enough." | |
2913 (if (or force | |
2914 (> (- (time-to-seconds (current-time)) | |
2915 org-agenda-last-marker-time) | |
2916 5)) | |
2917 (while org-agenda-markers | |
2918 (move-marker (pop org-agenda-markers) nil)))) | |
2919 | |
2920 (defvar org-agenda-new-buffers nil | |
2921 "Buffers created to visit agenda files.") | |
2922 | |
2923 (defun org-get-agenda-file-buffer (file) | |
2924 "Get a buffer visiting FILE. If the buffer needs to be created, add | |
2925 it to the list of buffers which might be released later." | |
2926 (let ((buf (find-buffer-visiting file))) | |
2927 (if buf | |
2928 buf ; just return it | |
2929 ;; Make a new buffer and remember it | |
2930 (setq buf (find-file-noselect file)) | |
2931 (if buf (push buf org-agenda-new-buffers)) | |
2932 buf))) | |
2933 | |
2934 (defun org-release-buffers (blist) | |
2935 "Release all buffers in list, asking the user for confirmation when needed. | |
2936 When a buffer is unmodified, it is just killed. When modified, it is saved | |
2937 \(if the user agrees) and then killed." | |
2938 (let (buf file) | |
2939 (while (setq buf (pop blist)) | |
2940 (setq file (buffer-file-name buf)) | |
2941 (when (and (buffer-modified-p buf) | |
2942 file | |
2943 (y-or-n-p (format "Save file %s? " file))) | |
2944 (save-excursion | |
2945 (set-buffer buf) (save-buffer))) | |
2946 (kill-buffer buf)))) | |
2947 | |
2948 (defun org-timeline (&optional include-all) | |
2949 "Show a time-sorted view of the entries in the current org file. | |
2950 Only entries with a time stamp of today or later will be listed. With | |
2951 one C-u prefix argument, also past entries will be listed. | |
2952 With two C-u prefixes, all unfinished TODO items will also be shown, | |
2953 under the current date. | |
2954 If the buffer contains an active region, only check the region for | |
2955 dates." | |
2956 (interactive "P") | |
2957 (require 'calendar) | |
2958 (org-agenda-maybe-reset-markers 'force) | |
2959 (let* ((dopast include-all) | |
2960 (dotodo (equal include-all '(16))) | |
2961 (entry (buffer-file-name)) | |
2962 (org-agenda-files (list (buffer-file-name))) | |
2963 (date (calendar-current-date)) | |
2964 (win (selected-window)) | |
2965 (pos1 (point)) | |
2966 (beg (if (org-region-active-p) (region-beginning) (point-min))) | |
2967 (end (if (org-region-active-p) (region-end) (point-max))) | |
2968 (day-numbers (org-get-all-dates beg end 'no-ranges | |
2969 t)) ; always include today | |
2970 (today (time-to-days (current-time))) | |
2971 (org-respect-restriction t) | |
2972 (past t) | |
2973 s e rtn d pos) | |
2974 (setq org-agenda-redo-command | |
2975 (list 'progn | |
2976 (list 'switch-to-buffer-other-window (current-buffer)) | |
2977 (list 'org-timeline include-all))) | |
2978 (if (not dopast) | |
2979 ;; Remove past dates from the list of dates. | |
2980 (setq day-numbers (delq nil (mapcar (lambda(x) | |
2981 (if (>= x today) x nil)) | |
2982 day-numbers)))) | |
2983 (switch-to-buffer-other-window | |
2984 (get-buffer-create org-agenda-buffer-name)) | |
2985 (setq buffer-read-only nil) | |
2986 (erase-buffer) | |
2987 (org-agenda-mode) (setq buffer-read-only nil) | |
2988 (while (setq d (pop day-numbers)) | |
2989 (if (and (>= d today) | |
2990 dopast | |
2991 past) | |
2992 (progn | |
2993 (setq past nil) | |
2994 (insert (make-string 79 ?-) "\n"))) | |
2995 (setq date (calendar-gregorian-from-absolute d)) | |
2996 (setq s (point)) | |
2997 (if dotodo | |
2998 (setq rtn (org-agenda-get-day-entries | |
2999 entry date :todo :timestamp)) | |
3000 (setq rtn (org-agenda-get-day-entries entry date :timestamp))) | |
3001 (if (or rtn (equal d today)) | |
3002 (progn | |
3003 (insert (calendar-day-name date) " " | |
3004 (number-to-string (extract-calendar-day date)) " " | |
3005 (calendar-month-name (extract-calendar-month date)) " " | |
3006 (number-to-string (extract-calendar-year date)) "\n") | |
3007 (put-text-property s (1- (point)) 'face | |
3008 'org-link-face) | |
3009 (if (equal d today) | |
3010 (put-text-property s (1- (point)) 'org-today t)) | |
3011 (insert (org-finalize-agenda-entries rtn) "\n") | |
3012 (put-text-property s (1- (point)) 'day d)))) | |
3013 (goto-char (point-min)) | |
3014 (setq buffer-read-only t) | |
3015 (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) | |
3016 (point-min))) | |
3017 (when (not org-select-timeline-window) | |
3018 (select-window win) | |
3019 (goto-char pos1)))) | |
3020 | |
3021 ;;;###autoload | |
3022 (defun org-agenda (&optional include-all start-day ndays) | |
3023 "Produce a weekly view from all files in variable `org-agenda-files'. | |
3024 The view will be for the current week, but from the overview buffer you | |
3025 will be able to go to other weeks. | |
3026 With one C-u prefix argument INCLUDE-ALL, all unfinished TODO items will | |
3027 also be shown, under the current date. | |
3028 START-DAY defaults to TODAY, or to the most recent match for the weekday | |
3029 given in `org-agenda-start-on-weekday'. | |
3030 NDAYS defaults to `org-agenda-ndays'." | |
3031 (interactive "P") | |
3032 (org-agenda-maybe-reset-markers 'force) | |
3033 (require 'calendar) | |
3034 (let* ((org-agenda-start-on-weekday | |
3035 (if (or (equal ndays 1) | |
3036 (and (null ndays) (equal 1 org-agenda-ndays))) | |
3037 nil org-agenda-start-on-weekday)) | |
3038 (files (copy-sequence org-agenda-files)) | |
3039 (win (selected-window)) | |
3040 (today (time-to-days (current-time))) | |
3041 (sd (or start-day today)) | |
3042 (start (if (or (null org-agenda-start-on-weekday) | |
3043 (< org-agenda-ndays 7)) | |
3044 sd | |
3045 (let* ((nt (calendar-day-of-week | |
3046 (calendar-gregorian-from-absolute sd))) | |
3047 (n1 org-agenda-start-on-weekday) | |
3048 (d (- nt n1))) | |
3049 (- sd (+ (if (< d 0) 7 0) d))))) | |
3050 (day-numbers (list start)) | |
3051 s e rtn rtnall file date d start-pos) | |
3052 (setq org-agenda-redo-command | |
3053 (list 'org-agenda include-all start-day ndays)) | |
3054 ;; Make the list of days | |
3055 (setq ndays (or ndays org-agenda-ndays)) | |
3056 (while (> ndays 1) | |
3057 (push (1+ (car day-numbers)) day-numbers) | |
3058 (setq ndays (1- ndays))) | |
3059 (setq day-numbers (nreverse day-numbers)) | |
3060 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) | |
3061 (progn | |
3062 (delete-other-windows) | |
3063 (switch-to-buffer-other-window | |
3064 (get-buffer-create org-agenda-buffer-name)))) | |
3065 (setq buffer-read-only nil) | |
3066 (erase-buffer) | |
3067 (org-agenda-mode) (setq buffer-read-only nil) | |
3068 (set (make-local-variable 'starting-day) (car day-numbers)) | |
3069 (set (make-local-variable 'include-all-loc) include-all) | |
3070 (when (and (or include-all org-agenda-include-all-todo) | |
3071 (member today day-numbers)) | |
3072 (setq files org-agenda-files | |
3073 rtnall nil) | |
3074 (while (setq file (pop files)) | |
3075 (catch 'nextfile | |
3076 (org-check-agenda-file file) | |
3077 (setq date (calendar-gregorian-from-absolute today) | |
3078 rtn (org-agenda-get-day-entries | |
3079 file date :todo)) | |
3080 (setq rtnall (append rtnall rtn)))) | |
3081 (if rtnall (insert (org-finalize-agenda-entries rtnall) "\n"))) | |
3082 (while (setq d (pop day-numbers)) | |
3083 (setq date (calendar-gregorian-from-absolute d) | |
3084 s (point)) | |
3085 (if (or (= d today) | |
3086 (and (not start-pos) (= d sd))) | |
3087 (setq start-pos (point))) | |
3088 (setq files org-agenda-files | |
3089 rtnall nil) | |
3090 (while (setq file (pop files)) | |
3091 (catch 'nextfile | |
3092 (org-check-agenda-file file) | |
3093 (setq rtn (org-agenda-get-day-entries file date)) | |
3094 (setq rtnall (append rtnall rtn)))) | |
3095 (if org-agenda-include-diary | |
3096 (progn | |
3097 (require 'calendar) | |
3098 (require 'diary-lib) | |
3099 (setq rtn (org-get-entries-from-diary date)) | |
3100 (setq rtnall (append rtnall rtn)))) | |
3101 (if (or rtnall org-agenda-show-all-dates) | |
3102 (progn | |
3103 (insert (format "%-9s %2d %-9s %4d\n" | |
3104 (calendar-day-name date) | |
3105 (extract-calendar-day date) | |
3106 (calendar-month-name (extract-calendar-month date)) | |
3107 (extract-calendar-year date))) | |
3108 (put-text-property s (1- (point)) 'face | |
3109 'org-link-face) | |
3110 (if rtnall (insert (org-finalize-agenda-entries rtnall) "\n")) | |
3111 (put-text-property s (1- (point)) 'day d)))) | |
3112 (goto-char (point-min)) | |
3113 (setq buffer-read-only t) | |
3114 (goto-char (or start-pos 1)) | |
3115 (if (not org-select-agenda-window) (select-window win)) | |
3116 (message ""))) | |
3117 | |
3118 (defun org-check-agenda-file (file) | |
3119 "Make sure FILE exists. If not, ask user what to do." | |
3120 ;; FIXME: this does not correctly change the menus | |
3121 ;; Could be fixed by explicitly going to the buffer, maybe. | |
3122 (when (not (file-exists-p file)) | |
3123 (message "non-existent file %s. [R]emove from agenda-files or [A]bort?" | |
3124 file) | |
3125 (let ((r (downcase (read-char-exclusive)))) | |
3126 (cond | |
3127 ((equal r ?r) | |
3128 (org-remove-file file) | |
3129 (throw 'nextfile t)) | |
3130 (t (error "Abort")))))) | |
3131 | |
3132 (defun org-agenda-quit (arg) | |
3133 "Exit agenda by removing the window or the buffer." | |
3134 (interactive "P") | |
3135 (let ((buf (current-buffer))) | |
3136 (if (not (one-window-p)) (delete-window)) | |
3137 (kill-buffer buf) | |
3138 (org-agenda-maybe-reset-markers 'force))) | |
3139 | |
3140 (defun org-agenda-exit (arg) | |
3141 "Exit agenda by removing the window or the buffer. | |
3142 Also kill all Org-mode buffers which have be loaded by `org-agenda'. | |
3143 Org-mode buffers visitied directly by the user will no be touched." | |
3144 (interactive "P") | |
3145 (org-release-buffers org-agenda-new-buffers) | |
3146 (setq org-agenda-new-buffers nil) | |
3147 (org-agenda-quit arg)) | |
3148 | |
3149 (defun org-agenda-redo (&optional arg) | |
3150 "Rebuild Agenda" | |
3151 (interactive "P") | |
3152 (eval org-agenda-redo-command)) | |
3153 | |
3154 (defun org-agenda-goto-today (arg) | |
3155 "Go to today." | |
3156 (interactive "P") | |
3157 (if (boundp 'starting-day) | |
3158 (let ((cmd (car org-agenda-redo-command)) | |
3159 (iall (nth 1 org-agenda-redo-command)) | |
3160 (nday (nth 3 org-agenda-redo-command))) | |
3161 (eval (list cmd iall nil nday))) | |
3162 (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) | |
3163 (point-min))))) | |
3164 | |
3165 (defun org-agenda-later (arg) | |
3166 "Go forward in time by `org-agenda-ndays' days. | |
3167 With prefix ARG, go forward that many times `org-agenda-ndays'." | |
3168 (interactive "p") | |
3169 (unless (boundp 'starting-day) | |
3170 (error "Not allowed")) | |
3171 (org-agenda (if (boundp 'include-all-loc) include-all-loc nil) | |
3172 (+ starting-day (* arg org-agenda-ndays)))) | |
3173 | |
3174 (defun org-agenda-earlier (arg) | |
3175 "Go back in time by `org-agenda-ndays' days. | |
3176 With prefix ARG, go back that many times `org-agenda-ndays'." | |
3177 (interactive "p") | |
3178 (unless (boundp 'starting-day) | |
3179 (error "Not allowed")) | |
3180 (org-agenda (if (boundp 'include-all-loc) include-all-loc nil) | |
3181 (- starting-day (* arg org-agenda-ndays)))) | |
3182 | |
3183 (defun org-agenda-day-view (arg) | |
3184 "Switch agenda to single day view." | |
3185 (interactive "P") | |
3186 (unless (boundp 'starting-day) | |
3187 (error "Not allowed")) | |
3188 (setq org-agenda-ndays 1) | |
3189 (org-agenda include-all-loc starting-day 1)) | |
3190 | |
3191 (defun org-agenda-week-view (arg) | |
3192 "Switch agenda to week view." | |
3193 (interactive "P") | |
3194 (unless (boundp 'starting-day) | |
3195 (error "Not allowed")) | |
3196 (setq org-agenda-ndays | |
3197 (if (equal org-agenda-ndays 1) 7 1)) | |
3198 (org-agenda include-all-loc | |
3199 (or (get-text-property (point) 'day) | |
3200 starting-day)) | |
3201 (org-agenda-set-mode-name) | |
3202 (message "Switched to %s view" | |
3203 (if (equal org-agenda-ndays 1) "day" "week"))) | |
3204 | |
3205 (defun org-agenda-follow-mode () | |
3206 "Toggle follow mode in an agenda buffer." | |
3207 (interactive) | |
3208 (setq org-agenda-follow-mode (not org-agenda-follow-mode)) | |
3209 (org-agenda-set-mode-name) | |
3210 (message "Follow mode is %s" | |
3211 (if org-agenda-follow-mode "on" "off"))) | |
3212 | |
3213 (defun org-agenda-toggle-diary () | |
3214 "Toggle follow mode in an agenda buffer." | |
3215 (interactive) | |
3216 (setq org-agenda-include-diary (not org-agenda-include-diary)) | |
3217 (org-agenda-redo) | |
3218 (org-agenda-set-mode-name) | |
3219 (message "Diary inclusion turned %s" | |
3220 (if org-agenda-include-diary "on" "off"))) | |
3221 | |
3222 (defun org-agenda-set-mode-name () | |
3223 "Set the mode name to indicate all the small mode seetings." | |
3224 (setq mode-name | |
3225 (concat "Org-Agenda" | |
3226 (if (equal org-agenda-ndays 1) " Day" "") | |
3227 (if (equal org-agenda-ndays 7) " Week" "") | |
3228 (if org-agenda-follow-mode " Follow" "") | |
3229 (if org-agenda-include-diary " Diary" ""))) | |
3230 (force-mode-line-update)) | |
3231 | |
3232 (defun org-agenda-post-command-hook () | |
3233 (if (and org-agenda-follow-mode | |
3234 (get-text-property (point) 'org-marker)) | |
3235 (org-agenda-show))) | |
3236 | |
3237 (defun org-get-entries-from-diary (date) | |
3238 "Get the (emacs calendar) diary entries for DATE." | |
3239 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") | |
3240 (diary-display-hook '(sort-diary-entries fancy-diary-display)) | |
3241 entries | |
3242 (disable-org-agenda t)) | |
3243 (save-excursion | |
3244 (save-window-excursion | |
3245 (list-diary-entries date 1))) | |
3246 (if (not (get-buffer fancy-diary-buffer)) | |
3247 (setq entries nil) | |
3248 (save-excursion | |
3249 (set-buffer fancy-diary-buffer) | |
3250 (setq buffer-read-only nil) | |
3251 (if (= (point-max) 1) | |
3252 ;; No entries | |
3253 (setq entries nil) | |
3254 ;; Omit the date | |
3255 (beginning-of-line 3) | |
3256 (delete-region (point-min) (point)) | |
3257 (while (and (re-search-forward "^" nil t) (not (eobp))) | |
3258 (replace-match " Diary: ")) | |
3259 (setq entries (buffer-substring (point-min) (- (point-max) 1)))) | |
3260 (set-buffer-modified-p nil) | |
3261 (kill-buffer fancy-diary-buffer))) | |
3262 (when entries | |
3263 (setq entries (org-split-string entries "\n")) | |
3264 (setq entries | |
3265 (mapcar | |
3266 (lambda (x) | |
3267 (if (string-match "\\<\\([012][0-9]\\):\\([0-6][0-9]\\)" x) | |
3268 (add-text-properties | |
3269 1 (length x) | |
3270 (list 'time-of-day | |
3271 (+ (* 100 (string-to-number | |
3272 (match-string 1 x))) | |
3273 (string-to-number (match-string 2 x)))) | |
3274 x)) | |
3275 x) | |
3276 entries))))) | |
3277 | |
3278 (defun org-add-file (&optional file) | |
3279 "Add current file to the list of files in variable `org-agenda-files'. | |
3280 These are the files which are being checked for agenda entries. | |
3281 Optional argument FILE means, use this file instead of the current. | |
3282 It is possible (but not recommended) to add this function to the | |
3283 `org-mode-hook'." | |
3284 (interactive) | |
3285 (catch 'exit | |
3286 (let* ((file (or file (buffer-file-name) | |
3287 (if (interactive-p) | |
3288 (error "Buffer is not visiting a file") | |
3289 (throw 'exit nil)))) | |
3290 (true-file (file-truename file)) | |
3291 (afile (abbreviate-file-name file)) | |
3292 (present (delq nil (mapcar | |
3293 (lambda (x) | |
3294 (equal true-file (file-truename x))) | |
3295 org-agenda-files)))) | |
3296 (if (not present) | |
3297 (progn | |
3298 (setq org-agenda-files | |
3299 (cons afile org-agenda-files)) | |
3300 ;; Make sure custom.el does not end up with Org-mode | |
3301 (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) | |
3302 (customize-save-variable 'org-agenda-files org-agenda-files)) | |
3303 (org-install-agenda-files-menu) | |
3304 (message "Added file: %s" afile)) | |
3305 (message "File was already in list: %s" afile))))) | |
3306 | |
3307 (defun org-remove-file (&optional file) | |
3308 "Remove current file from the list of files in variable `org-agenda-files'. | |
3309 These are the files which are being checked for agenda entries. | |
3310 Optional argument FILE means, use this file instead of the current." | |
3311 (interactive) | |
3312 (let* ((file (or file (buffer-file-name))) | |
3313 (true-file (file-truename file)) | |
3314 (afile (abbreviate-file-name file)) | |
3315 (files (delq nil (mapcar | |
3316 (lambda (x) | |
3317 (if (equal true-file | |
3318 (file-truename x)) | |
3319 nil x)) | |
3320 org-agenda-files)))) | |
3321 (if (not (= (length files) (length org-agenda-files))) | |
3322 (progn | |
3323 (setq org-agenda-files files) | |
3324 (customize-save-variable 'org-agenda-files org-agenda-files) | |
3325 (org-install-agenda-files-menu) | |
3326 (message "Removed file: %s" afile)) | |
3327 (message "File was not in list: %s" afile)))) | |
3328 | |
3329 (defun org-file-menu-entry (file) | |
3330 (vector file (list 'find-file file) t)) | |
3331 | |
3332 (defun org-get-all-dates (beg end &optional no-ranges force-today) | |
3333 "Return a list of all relevant day numbers from BEG to END buffer positions. | |
3334 If NO-RANGES is non-nil, include only the start and end dates of a range, | |
3335 not every single day in the range. If FORCE-TODAY is non-nil, make | |
3336 sure that TODAY is included in the list." | |
3337 (let (dates date day day1 day2 ts1 ts2) | |
3338 (if force-today | |
3339 (setq dates (list (time-to-days (current-time))))) | |
3340 (save-excursion | |
3341 (goto-char beg) | |
3342 (while (re-search-forward org-ts-regexp end t) | |
3343 (setq day (time-to-days (org-time-string-to-time | |
3344 (substring (match-string 1) 0 10)))) | |
3345 (or (memq day dates) (push day dates))) | |
3346 (unless no-ranges | |
3347 (goto-char beg) | |
3348 (while (re-search-forward org-tr-regexp end t) | |
3349 (setq ts1 (substring (match-string 1) 0 10) | |
3350 ts2 (substring (match-string 2) 0 10) | |
3351 day1 (time-to-days (org-time-string-to-time ts1)) | |
3352 day2 (time-to-days (org-time-string-to-time ts2))) | |
3353 (while (< (setq day1 (1+ day1)) day2) | |
3354 (or (memq day1 dates) (push day1 dates))))) | |
3355 (sort dates '<)))) | |
3356 | |
3357 ;;;###autoload | |
3358 (defun org-diary (&rest args) | |
3359 "Returns diary information from org-files. | |
3360 This function can be used in an \"sexp\" diary entry in the Emacs calendar. | |
3361 It accesses org files and extracts information from those files to be | |
3362 listed in the diary. The function accepts arguments specifying what | |
3363 items should be listed. The following arguments are allowed: | |
3364 | |
3365 :timestamp List the headlines of items containing a date stamp or | |
3366 date range matching the selected date. Deadlines will | |
3367 also be listed, on the expiration day. | |
3368 | |
3369 :deadline List any deadlines past due, or due within | |
3370 `org-deadline-warning-days'. The listing occurs only | |
3371 in the diary for *today*, not at any other date. If | |
3372 an entry is marked DONE, it is no longer listed. | |
3373 | |
3374 :scheduled List all items which are scheduled for the given date. | |
3375 The diary for *today* also contains items which were | |
3376 scheduled earlier and are not yet marked DONE. | |
3377 | |
3378 :todo List all TODO items from the org-file. This may be a | |
3379 long list - so this is not turned on by default. | |
3380 Like deadlines, these entires only show up in the | |
3381 diary for *today*, not at any other date. | |
3382 | |
3383 The call in the diary file should look like this: | |
3384 | |
3385 &%%(org-diary) ~/path/to/some/orgfile.org | |
3386 | |
3387 Use a separate line for each org file to check. Or, if you omit the file name, | |
3388 all files listed in `org-agenda-files' will be checked automatically: | |
3389 | |
3390 &%%(org-diary) | |
3391 | |
3392 If you don't give any arguments (as in the example above), the default | |
3393 arguments (:deadline :scheduled :timestamp) are used. So the example above may | |
3394 also be written as | |
3395 | |
3396 &%%(org-diary :deadline :timestamp :scheduled) | |
3397 | |
3398 The function expects the lisp variables `entry' and `date' to be provided | |
3399 by the caller, because this is how the calendar works. Don't use this | |
3400 function from a program - use `org-agenda-get-day-entries' instead." | |
3401 (org-agenda-maybe-reset-markers) | |
3402 (setq args (or args '(:deadline :scheduled :timestamp))) | |
3403 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) | |
3404 (list entry) | |
3405 org-agenda-files)) | |
3406 file rtn results) | |
3407 ;; If this is called during org-agenda, don't return any entries to | |
3408 ;; the calendar. Org Agenda will list these entries itself. | |
3409 (if (boundp 'disable-org-agenda) (setq files nil)) | |
3410 (while (setq file (pop files)) | |
3411 (setq rtn (apply 'org-agenda-get-day-entries file date args)) | |
3412 (setq results (append results rtn))) | |
3413 (concat (org-finalize-agenda-entries results) "\n"))) | |
3414 | |
3415 (defun org-agenda-get-day-entries (file date &rest args) | |
3416 "Does the work for `org-diary' and `org-agenda' | |
3417 FILE is the path to a file to be checked for entries. DATE is date like | |
3418 the one returned by `calendar-current-date'. ARGS are symbols indicating | |
3419 which kind of entries should be extracted. For details about these, see | |
3420 the documentation of `org-diary'." | |
3421 (setq args (or args '(:deadline :scheduled :timestamp))) | |
3422 (let* ((org-startup-with-deadline-check nil) | |
3423 (org-startup-folded nil) | |
3424 (buffer (if (file-exists-p file) | |
3425 ; (find-file-noselect file) | |
3426 (org-get-agenda-file-buffer file) | |
3427 (error "No such file %s" file))) | |
3428 (respect-narrow-p (boundp 'org-respect-restriction)) | |
3429 arg results rtn) | |
3430 (if (not buffer) | |
3431 ;; If file does not exist, make sure an error message ends up in diary | |
3432 (format "ORG-AGENDA-ERROR: No such org-file %s" file) | |
3433 (save-excursion | |
3434 (set-buffer buffer) | |
3435 (let ((case-fold-search nil)) | |
3436 (save-excursion | |
3437 (save-restriction | |
3438 (if respect-narrow-p | |
3439 (if (org-region-active-p) | |
3440 ;; Respect a region to restrict search | |
3441 (narrow-to-region (region-beginning) (region-end))) | |
3442 ;; If we work for the calendar or many files, | |
3443 ;; get rid of any restriction | |
3444 (widen)) | |
3445 (while (setq arg (pop args)) | |
3446 (cond | |
3447 ((and (eq arg :todo) | |
3448 (equal date (calendar-current-date))) | |
3449 (setq rtn (org-agenda-get-todos)) | |
3450 (setq results (append results rtn))) | |
3451 ((eq arg :timestamp) | |
3452 (setq rtn (org-agenda-get-blocks)) | |
3453 (setq results (append results rtn)) | |
3454 (setq rtn (org-agenda-get-timestamps)) | |
3455 (setq results (append results rtn))) | |
3456 ((eq arg :scheduled) | |
3457 (setq rtn (org-agenda-get-scheduled)) | |
3458 (setq results (append results rtn))) | |
3459 ((and (eq arg :deadline) | |
3460 (equal date (calendar-current-date))) | |
3461 (setq rtn (org-agenda-get-deadlines)) | |
3462 (setq results (append results rtn)))))))))) | |
3463 results)) | |
3464 | |
3465 (defun org-entry-is-done-p () | |
3466 "Is the current entry marked DONE?" | |
3467 (save-excursion | |
3468 (and (re-search-backward "[\r\n]\\*" nil t) | |
3469 (looking-at orb-nl-done-regexp)))) | |
3470 | |
3471 (defun org-at-date-range-p () | |
3472 "It the cursor inside a date range?" | |
3473 (interactive) | |
3474 (save-excursion | |
3475 (catch 'exit | |
3476 (let ((pos (point))) | |
3477 (skip-chars-backward "^<\r\n") | |
3478 (skip-chars-backward "<") | |
3479 (and (looking-at org-tr-regexp) | |
3480 (>= (match-end 0) pos) | |
3481 (throw 'exit t)) | |
3482 (skip-chars-backward "^<\r\n") | |
3483 (skip-chars-backward "<") | |
3484 (and (looking-at org-tr-regexp) | |
3485 (>= (match-end 0) pos) | |
3486 (throw 'exit t))) | |
3487 nil))) | |
3488 | |
3489 (defun org-agenda-get-todos () | |
3490 "Return the TODO information for agenda display." | |
3491 (let* ((props (list 'face nil | |
3492 'mouse-face 'highlight | |
3493 'keymap org-agenda-keymap | |
3494 'help-echo | |
3495 (format "mouse-2 or RET jump to org file %s" | |
3496 (abbreviate-file-name (buffer-file-name))))) | |
3497 (regexp (concat "[\n\r]\\*+ *\\(" org-not-done-regexp | |
3498 "[^\n\r]*\\)")) | |
3499 marker priority | |
3500 ee txt pl) | |
3501 (goto-char (point-min)) | |
3502 (while (re-search-forward regexp nil t) | |
3503 (goto-char (match-beginning 1)) | |
3504 (setq marker (org-agenda-new-marker (point)) | |
3505 txt (org-format-agenda-item "" (match-string 1)) | |
3506 priority | |
3507 (+ (org-get-priority txt) | |
3508 (if org-todo-kwd-priority-p | |
3509 (- org-todo-kwd-max-priority -2 | |
3510 (length | |
3511 (member (match-string 2) org-todo-keywords))) | |
3512 1))) | |
3513 (add-text-properties | |
3514 0 (length txt) (append (list 'org-marker marker 'priority priority) | |
3515 props) | |
3516 txt) | |
3517 (push txt ee) | |
3518 (goto-char (match-end 1))) | |
3519 (nreverse ee))) | |
3520 | |
3521 (defconst org-agenda-no-heading-message | |
3522 "No heading for this item in buffer or region") | |
3523 | |
3524 (defun org-agenda-get-timestamps () | |
3525 "Return the date stamp information for agenda display." | |
3526 (let* ((props (list 'face nil | |
3527 'mouse-face 'highlight | |
3528 'keymap org-agenda-keymap | |
3529 'help-echo | |
3530 (format "mouse-2 or RET jump to org file %s" | |
3531 (abbreviate-file-name (buffer-file-name))))) | |
3532 (regexp (regexp-quote | |
3533 (substring | |
3534 (format-time-string | |
3535 (car org-time-stamp-formats) | |
3536 (apply 'encode-time ; DATE bound by calendar | |
3537 (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) | |
3538 0 11))) | |
3539 marker deadlinep scheduledp tmp priority | |
3540 ee txt) | |
3541 (goto-char (point-min)) | |
3542 (while (re-search-forward regexp nil t) | |
3543 (if (not (save-match-data (org-at-date-range-p))) | |
3544 (progn | |
3545 (setq marker (org-agenda-new-marker (point)) | |
3546 tmp (buffer-substring (max (point-min) | |
3547 (- (match-beginning 0) | |
3548 org-ds-keyword-length)) | |
3549 (match-beginning 0)) | |
3550 deadlinep (string-match org-deadline-regexp tmp) | |
3551 scheduledp (string-match org-scheduled-regexp tmp)) | |
3552 (save-excursion | |
3553 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) | |
3554 (progn | |
3555 (goto-char (match-end 1)) | |
3556 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") | |
3557 (setq txt (org-format-agenda-item | |
3558 (format "%s%s" | |
3559 (if deadlinep "Deadline: " "") | |
3560 (if scheduledp "Scheduled: " "")) | |
3561 (match-string 1)))) | |
3562 (setq txt org-agenda-no-heading-message)) | |
3563 (setq priority (org-get-priority txt)) | |
3564 (add-text-properties | |
3565 0 (length txt) (append (list 'org-marker marker) props) | |
3566 txt) | |
3567 (if deadlinep | |
3568 (add-text-properties | |
3569 0 (length txt) | |
3570 (list 'face 'org-warning-face | |
3571 'priority (+ 100 priority)) | |
3572 txt) | |
3573 (if scheduledp | |
3574 (add-text-properties | |
3575 0 (length txt) | |
3576 (list 'face 'org-scheduled-today-face | |
3577 priority (+ 99 priority)) | |
3578 txt) | |
3579 (add-text-properties | |
3580 0 (length txt) | |
3581 (list 'priority priority) txt))) | |
3582 (push txt ee)) | |
3583 (outline-next-heading)))) | |
3584 (nreverse ee))) | |
3585 | |
3586 (defun org-agenda-get-deadlines () | |
3587 "Return the deadline information for agenda display." | |
3588 (let* ((wdays org-deadline-warning-days) | |
3589 (props (list 'face nil | |
3590 'mouse-face 'highlight | |
3591 'keymap org-agenda-keymap | |
3592 'help-echo | |
3593 (format "mouse-2 or RET jump to org file %s" | |
3594 (abbreviate-file-name (buffer-file-name))))) | |
3595 (regexp org-deadline-time-regexp) | |
3596 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar | |
3597 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar | |
3598 d2 diff pos | |
3599 ee txt head) | |
3600 (goto-char (point-min)) | |
3601 (while (re-search-forward regexp nil t) | |
3602 (setq d2 (time-to-days | |
3603 (org-time-string-to-time (match-string 1))) | |
3604 pos (point) | |
3605 diff (- d2 d1)) | |
3606 ;; When to show a deadline in the calendar: | |
3607 ;; If the expiration is within wdays warning time. | |
3608 ;; Past-due deadlines are only shown on the current date | |
3609 (if (and (< diff wdays) todayp (not (= diff 0))) | |
3610 (save-excursion | |
3611 (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) | |
3612 (progn | |
3613 (goto-char (match-end 0)) | |
3614 (setq head (buffer-substring-no-properties | |
3615 (point) | |
3616 (progn (skip-chars-forward "^\r\n") | |
3617 (point)))) | |
3618 (if (string-match org-looking-at-done-regexp head) | |
3619 (setq txt nil) | |
3620 (setq txt (org-format-agenda-item | |
3621 (format "In %3d d.: " diff) head)))) | |
3622 (setq txt org-agenda-no-heading-message)) | |
3623 (when txt | |
3624 (add-text-properties | |
3625 0 (length txt) | |
3626 (append | |
3627 (list 'org-marker (org-agenda-new-marker pos) | |
3628 'priority (+ (- 10 diff) (org-get-priority txt)) | |
3629 'face (cond ((<= diff 0) 'org-warning-face) | |
3630 ((<= diff 5) 'font-lock-function-name-face) | |
3631 (t nil))) | |
3632 props) | |
3633 txt) | |
3634 (push txt ee))))) | |
3635 ee)) | |
3636 | |
3637 (defun org-agenda-get-scheduled () | |
3638 "Return the scheduled information for agenda display." | |
3639 (let* ((props (list 'face 'org-scheduled-previously-face | |
3640 'mouse-face 'highlight | |
3641 'keymap org-agenda-keymap | |
3642 'help-echo | |
3643 (format "mouse-2 or RET jump to org file %s" | |
3644 (abbreviate-file-name (buffer-file-name))))) | |
3645 (regexp org-scheduled-time-regexp) | |
3646 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar | |
3647 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar | |
3648 d2 diff marker pos | |
3649 ee txt head) | |
3650 (goto-char (point-min)) | |
3651 (while (re-search-forward regexp nil t) | |
3652 (setq d2 (time-to-days | |
3653 (org-time-string-to-time (match-string 1))) | |
3654 pos (point) | |
3655 diff (- d2 d1)) | |
3656 ;; When to show a scheduled item in the calendar: | |
3657 ;; If it is on or past the date. | |
3658 (if (and (< diff 0) todayp) | |
3659 (save-excursion | |
3660 (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) | |
3661 (progn | |
3662 (goto-char (match-end 0)) | |
3663 (setq head (buffer-substring-no-properties | |
3664 (point) | |
3665 (progn (skip-chars-forward "^\r\n") (point)))) | |
3666 (if (string-match org-looking-at-done-regexp head) | |
3667 (setq txt nil) | |
3668 (setq txt (org-format-agenda-item | |
3669 (format "Sched.%2dx: " (- 1 diff)) head)))) | |
3670 (setq txt org-agenda-no-heading-message)) | |
3671 (when txt | |
3672 (setq marker (org-agenda-new-marker pos)) | |
3673 (add-text-properties | |
3674 0 (length txt) | |
3675 (append (list 'org-marker marker | |
3676 'priority (+ (- 5 diff) (org-get-priority txt))) | |
3677 props) txt) | |
3678 (push txt ee))))) | |
3679 ee)) | |
3680 | |
3681 (defun org-agenda-get-blocks () | |
3682 "Return the date-range information for agenda display." | |
3683 (let* ((props (list 'face nil | |
3684 'mouse-face 'highlight | |
3685 'keymap org-agenda-keymap | |
3686 'help-echo | |
3687 (format "mouse-2 or RET jump to org file %s" | |
3688 (abbreviate-file-name (buffer-file-name))))) | |
3689 (regexp org-tr-regexp) | |
3690 (d0 (calendar-absolute-from-gregorian date)) | |
3691 marker ee txt d1 d2 s1 s2) | |
3692 (goto-char (point-min)) | |
3693 (while (re-search-forward regexp nil t) | |
3694 (setq s1 (match-string 1) | |
3695 s2 (match-string 2) | |
3696 d1 (time-to-days (org-time-string-to-time s1)) | |
3697 d2 (time-to-days (org-time-string-to-time s2))) | |
3698 (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) | |
3699 ;; Only allow days between the limits, because the normal | |
3700 ;; date stamps will catch the limits. | |
3701 (save-excursion | |
3702 (setq marker (org-agenda-new-marker (point))) | |
3703 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) | |
3704 (progn | |
3705 (goto-char (match-end 1)) | |
3706 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") | |
3707 (setq txt (org-format-agenda-item | |
3708 (format "(%d/%d): " | |
3709 (1+ (- d0 d1)) (1+ (- d2 d1))) | |
3710 (match-string 1)))) | |
3711 (setq txt org-agenda-no-heading-message)) | |
3712 (add-text-properties | |
3713 0 (length txt) (append (list 'org-marker marker | |
3714 'priority (org-get-priority txt)) | |
3715 props) | |
3716 txt) | |
3717 (push txt ee))) | |
3718 (outline-next-heading)) | |
3719 ;; Sort the entries by expiration date. | |
3720 (nreverse ee))) | |
3721 | |
3722 | |
3723 (defun org-format-agenda-item (prefix txt) | |
3724 "Format TXT to be inserted into the agenda buffer. | |
3725 In particular, this indents the lins and adds a category." | |
3726 (let ((cat (or org-category | |
3727 (file-name-sans-extension | |
3728 (file-name-nondirectory (buffer-file-name))))) | |
3729 time rtn) | |
3730 (if (symbolp cat) (setq cat (symbol-name cat))) | |
3731 (setq rtn (format " %-10s %s%s" (concat cat ":") prefix txt)) | |
3732 (add-text-properties | |
3733 0 2 (list 'category (downcase cat) | |
3734 'prefix-length (- (length rtn) (length txt)) | |
3735 'time-of-day (org-get-time-of-day rtn)) | |
3736 rtn) | |
3737 rtn)) | |
3738 | |
3739 ;; FIXME: Should this be restricted to beginning of string? | |
3740 (defun org-get-time-of-day (s) | |
3741 "Check string S for a time of day." | |
3742 (save-match-data | |
3743 (when (and | |
3744 (string-match | |
3745 "\\<\\([012][0-9]\\)\\(:\\([0-6][0-9]\\)\\)?\\([AaPp][Mm]\\)?\\>" s) | |
3746 (or (match-beginning 2) (match-beginning 4))) | |
3747 (+ (* 100 (+ (string-to-number (match-string 1 s)) | |
3748 (if (and (match-beginning 4) | |
3749 (equal (downcase (match-string 4 s)) "pm")) | |
3750 12 0))) | |
3751 (if (match-beginning 3) | |
3752 (string-to-number (match-string 3 s)) | |
3753 0))))) | |
3754 | |
3755 (defun org-finalize-agenda-entries (list) | |
3756 "Sort and concatenate the agenda items." | |
3757 (mapconcat 'identity (sort list 'org-entries-lessp) "\n")) | |
3758 | |
3759 (defsubst org-cmp-priority (a b) | |
3760 "Compare the priorities of string a and b." | |
3761 (let ((pa (or (get-text-property 1 'priority a) 0)) | |
3762 (pb (or (get-text-property 1 'priority b) 0))) | |
3763 (cond ((> pa pb) +1) | |
3764 ((< pa pb) -1) | |
3765 (t nil)))) | |
3766 | |
3767 (defsubst org-cmp-category (a b) | |
3768 "Compare the string values of categories of strings a and b." | |
3769 (let ((ca (or (get-text-property 1 'category a) "")) | |
3770 (cb (or (get-text-property 1 'category b) ""))) | |
3771 (cond ((string-lessp ca cb) -1) | |
3772 ((string-lessp cb ca) +1) | |
3773 (t nil)))) | |
3774 | |
3775 (defsubst org-cmp-time (a b) | |
3776 "Compare the time-of-day values of strings a and b." | |
3777 (let* ((def (if org-sort-agenda-notime-is-late 2401 -1)) | |
3778 (ta (or (get-text-property 1 'time-of-day a) def)) | |
3779 (tb (or (get-text-property 1 'time-of-day b) def))) | |
3780 (cond ((< ta tb) -1) | |
3781 ((< tb ta) +1) | |
3782 (t nil)))) | |
3783 | |
3784 (defun org-entries-lessp (a b) | |
3785 "Predicate for sorting agenda entries." | |
3786 (let* ((time-up (org-cmp-time a b)) | |
3787 (time-down (if time-up (- time-up) nil)) | |
3788 (priority-up (org-cmp-priority a b)) | |
3789 (priority-down (if priority-up (- priority-up) nil)) | |
3790 (category-up (org-cmp-category a b)) | |
3791 (category-down (if category-up (- category-up) nil)) | |
3792 (category-keep (if category-up +1 nil))) ; FIXME +1 or -1? | |
3793 (cdr (assoc | |
3794 (eval (cons 'or org-agenda-sorting-strategy)) | |
3795 '((-1 . t) (1 . nil) (nil . nil)))))) | |
3796 | |
3797 (defun org-agenda-show-priority () | |
3798 "Show the priority of the current item. | |
3799 This priority is composed of the main priority given with the [#A] cookies, | |
3800 and by additional input from the age of a schedules or deadline entry." | |
3801 (interactive) | |
3802 (let* ((pri (get-text-property (point-at-bol) 'priority))) | |
3803 (message "Priority is %d" (if pri pri -1000)))) | |
3804 | |
3805 | |
3806 (defun org-agenda-goto () | |
3807 "Go to the Org-mode file which contains the item at point." | |
3808 (interactive) | |
3809 (let* ((marker (or (get-text-property (point) 'org-marker) | |
3810 (org-agenda-error))) | |
3811 (buffer (marker-buffer marker)) | |
3812 (pos (marker-position marker))) | |
3813 (switch-to-buffer-other-window buffer) | |
3814 (widen) | |
3815 (goto-char pos) | |
3816 (org-show-hidden-entry) | |
3817 (save-excursion | |
3818 (and (outline-next-heading) | |
3819 (org-flag-heading nil))))) ; show the next heading | |
3820 | |
3821 (defun org-agenda-switch-to () | |
3822 "Go to the Org-mode file which contains the item at point." | |
3823 (interactive) | |
3824 (let* ((marker (or (get-text-property (point) 'org-marker) | |
3825 (org-agenda-error))) | |
3826 (buffer (marker-buffer marker)) | |
3827 (pos (marker-position marker))) | |
3828 (switch-to-buffer buffer) | |
3829 (delete-other-windows) | |
3830 (widen) | |
3831 (goto-char pos) | |
3832 (org-show-hidden-entry) | |
3833 (save-excursion | |
3834 (and (outline-next-heading) | |
3835 (org-flag-heading nil))))) ; show the next heading | |
3836 | |
3837 (defun org-agenda-goto-mouse (ev) | |
3838 "Go to the Org-mode file which contains the deadline at the mouse click." | |
3839 (interactive "e") | |
3840 (mouse-set-point ev) | |
3841 (org-agenda-goto)) | |
3842 | |
3843 (defun org-agenda-show () | |
3844 "Display the Org-mode file which contains the item at point." | |
3845 (interactive) | |
3846 (let ((win (selected-window))) | |
3847 (org-agenda-goto) | |
3848 (select-window win))) | |
3849 | |
3850 (defun org-agenda-recenter (arg) | |
3851 "Display the Org-mode file which contains the item at point and recenter." | |
3852 (interactive "P") | |
3853 (let ((win (selected-window))) | |
3854 (org-agenda-goto) | |
3855 (recenter arg) | |
3856 (select-window win))) | |
3857 | |
3858 (defun org-agenda-show-mouse (ev) | |
3859 "Display the Org-mode file which contains the deadline at the mouse click." | |
3860 (interactive "e") | |
3861 (mouse-set-point ev) | |
3862 (org-agenda-show)) | |
3863 | |
3864 (defun org-agenda-error () | |
3865 (error "Command not allowed in this line.")) | |
3866 | |
3867 (defun org-agenda-todo () | |
3868 "Cycle TODO state of line at point, also in Org-mode file." | |
3869 (interactive) | |
3870 (let* ((props (text-properties-at (point))) | |
3871 (col (current-column)) | |
3872 (marker (or (get-text-property (point) 'org-marker) | |
3873 (org-agenda-error))) | |
3874 (pl (get-text-property (point-at-bol) 'prefix-length)) | |
3875 (buffer (marker-buffer marker)) | |
3876 (pos (marker-position marker)) | |
3877 (buffer-read-only nil) | |
3878 newhead) | |
3879 (save-excursion | |
3880 (set-buffer buffer) | |
3881 (widen) | |
3882 (goto-char pos) | |
3883 (org-show-hidden-entry) | |
3884 (save-excursion | |
3885 (and (outline-next-heading) | |
3886 (org-flag-heading nil))) ; show the next heading | |
3887 (org-todo) | |
3888 (setq newhead (org-get-heading))) | |
3889 (beginning-of-line 1) | |
3890 (move-to-column pl) | |
3891 (if (looking-at ".*") | |
3892 (progn | |
3893 (replace-match newhead t t) | |
3894 (move-to-column col) | |
3895 (add-text-properties (point-at-bol) (point-at-eol) props) | |
3896 (beginning-of-line 1)) | |
3897 (error "Line update did not work")))) | |
3898 | |
3899 (defun org-agenda-priority-up () | |
3900 "Increase the priority of line at point, also in Org-mode file." | |
3901 (interactive) | |
3902 (org-agenda-priority 'up)) | |
3903 | |
3904 (defun org-agenda-priority-down () | |
3905 "Decrease the priority of line at point, also in Org-mode file." | |
3906 (interactive) | |
3907 (org-agenda-priority 'down)) | |
3908 | |
3909 (defun org-agenda-priority (&optional force-direction) | |
3910 "Set the priority of line at point, also in Org-mode file." | |
3911 (interactive) | |
3912 (let* ((props (text-properties-at (point))) | |
3913 (col (current-column)) | |
3914 (marker (or (get-text-property (point) 'org-marker) | |
3915 (org-agenda-error))) | |
3916 (pl (get-text-property (point-at-bol) 'prefix-length)) | |
3917 (buffer (marker-buffer marker)) | |
3918 (pos (marker-position marker)) | |
3919 (buffer-read-only nil) | |
3920 newhead) | |
3921 (save-excursion | |
3922 (set-buffer buffer) | |
3923 (widen) | |
3924 (goto-char pos) | |
3925 (org-show-hidden-entry) | |
3926 (save-excursion | |
3927 (and (outline-next-heading) | |
3928 (org-flag-heading nil))) ; show the next heading | |
3929 (funcall 'org-priority force-direction) | |
3930 (setq newhead (org-get-heading))) | |
3931 (beginning-of-line 1) | |
3932 (move-to-column pl) | |
3933 (if (looking-at ".*") | |
3934 (progn | |
3935 (replace-match (concat newhead) t t) | |
3936 (move-to-column col) | |
3937 (add-text-properties (point-at-bol) (point-at-eol) props) | |
3938 (beginning-of-line 1)) | |
3939 (error "Line update did not work")))) | |
3940 | |
3941 (defun org-agenda-date-later (arg &optional what) | |
3942 "Change the date of this item to one day later." | |
3943 (interactive "p") | |
3944 (let* ((marker (or (get-text-property (point) 'org-marker) | |
3945 (org-agenda-error))) | |
3946 (buffer (marker-buffer marker)) | |
3947 (pos (marker-position marker))) | |
3948 (save-excursion | |
3949 (set-buffer buffer) | |
3950 (widen) | |
3951 (goto-char pos) | |
3952 (if (not (org-at-timestamp-p)) | |
3953 (error "Cannot find time stamp")) | |
3954 (org-timestamp-change arg (or what 'day)) | |
3955 (message "Time stamp changed to %s" org-last-changed-timestamp)))) | |
3956 | |
3957 (defun org-agenda-date-earlier (arg &optional what) | |
3958 "Change the date of this item to one day earlier." | |
3959 (interactive "p") | |
3960 (org-agenda-date-later (- arg) what)) | |
3961 | |
3962 (defun org-agenda-date-today (arg) | |
3963 "Change the date of this item to one day later." | |
3964 (interactive "p") | |
3965 (let* ((marker (or (get-text-property (point) 'org-marker) | |
3966 (org-agenda-error))) | |
3967 (buffer (marker-buffer marker)) | |
3968 (pos (marker-position marker))) | |
3969 (save-excursion | |
3970 (set-buffer buffer) | |
3971 (widen) | |
3972 (goto-char pos) | |
3973 (if (not (org-at-timestamp-p)) | |
3974 (error "Cannot find time stamp")) | |
3975 (org-time-stamp nil) | |
3976 (message "Time stamp changed to %s" org-last-changed-timestamp)))) | |
3977 | |
3978 (defun org-get-heading () | |
3979 "Return the heading of the current entry, without the stars." | |
3980 (save-excursion | |
3981 (if (and (re-search-backward "[\r\n]\\*" nil t) | |
3982 (looking-at "[\r\n]\\*+[ \t]+\\(.*\\)")) | |
3983 (match-string 1) | |
3984 ""))) | |
3985 | |
3986 (defun org-agenda-diary-entry (arg) | |
3987 "Make a diary entry, like the `i' command from the calendar. | |
3988 All the standard commands work: block, weekly etc" | |
3989 (interactive "P") | |
3990 (require 'diary-lib) | |
3991 (let* ((char (progn | |
3992 (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") | |
3993 (read-char-exclusive))) | |
3994 (cmd (cdr (assoc char | |
3995 '((?d . insert-diary-entry) | |
3996 (?w . insert-weekly-diary-entry) | |
3997 (?m . insert-monthly-diary-entry) | |
3998 (?y . insert-yearly-diary-entry) | |
3999 (?a . insert-anniversary-diary-entry) | |
4000 (?b . insert-block-diary-entry) | |
4001 (?c . insert-cyclic-diary-entry))))) | |
4002 (oldf (symbol-function 'calendar-cursor-to-date)) | |
4003 (point (point)) | |
4004 (mark (or (mark t) (point)))) | |
4005 (unless cmd | |
4006 (error "No command associated with <%c>" char)) | |
4007 (unless (and (get-text-property point 'day) | |
4008 (or (not (equal ?b char)) | |
4009 (get-text-property mark 'day))) | |
4010 (error "Don't know which date to use for diary entry")) | |
4011 ;; We implememnt this by hacking the `calendar-cursor-to-date' function | |
4012 ;; and the `calendar-mark-ring' variable. Saves a lot of code. | |
4013 (let ((calendar-mark-ring | |
4014 (list (calendar-gregorian-from-absolute | |
4015 (or (get-text-property mark 'day) | |
4016 (get-text-property point 'day)))))) | |
4017 (unwind-protect | |
4018 (progn | |
4019 (fset 'calendar-cursor-to-date | |
4020 (lambda (&optional error) | |
4021 (calendar-gregorian-from-absolute | |
4022 (get-text-property point 'day)))) | |
4023 (call-interactively cmd)) | |
4024 (fset 'calendar-cursor-to-date oldf))))) | |
4025 | |
4026 ;;; Link Stuff | |
4027 | |
4028 (defun org-find-file-at-mouse (ev) | |
4029 "Open file link or URL at mouse." | |
4030 (interactive "e") | |
4031 (mouse-set-point ev) | |
4032 (org-open-at-point 'in-emacs)) | |
4033 | |
4034 (defun org-open-at-mouse (ev) | |
4035 "Open file link or URL at mouse." | |
4036 (interactive "e") | |
4037 (mouse-set-point ev) | |
4038 (org-open-at-point)) | |
4039 | |
4040 (defun org-open-at-point (&optional in-emacs) | |
4041 "Open link at or after point. | |
4042 If there is no link at point, this function will search forward up to | |
4043 the end of the current subtree. | |
4044 Normally, files will be opened by an appropriate application. If the | |
4045 optional argument IN-EMACS is non-nil, Emacs will visit the file." | |
4046 (interactive "P") | |
4047 (if (org-at-timestamp-p) | |
4048 (org-agenda nil (time-to-days (org-time-string-to-time | |
4049 (substring (match-string 1) 0 10))) | |
4050 1) | |
4051 (let (type path line (pos (point))) | |
4052 (save-excursion | |
4053 (skip-chars-backward | |
4054 (if org-allow-space-in-links "^\t\n\r" "^ \t\n\r")) | |
4055 (if (re-search-forward | |
4056 org-link-regexp | |
4057 (save-excursion | |
4058 (condition-case nil | |
4059 (progn (outline-end-of-subtree) (max pos (point))) | |
4060 (error (end-of-line 1) (point)))) | |
4061 t) | |
4062 (setq type (match-string 1) | |
4063 path (match-string 2))) | |
4064 (unless path | |
4065 (error "No link found.")) | |
4066 ;; Remove any trailing spaces in path | |
4067 (if (string-match " +\\'" path) | |
4068 (setq path (replace-match "" t t path))) | |
4069 | |
4070 (cond | |
4071 | |
4072 ((string= type "file") | |
4073 (if (string-match ":\\([0-9]+\\)\\'" path) | |
4074 (setq line (string-to-number (match-string 1 path)) | |
4075 path (substring path 0 (match-beginning 0)))) | |
4076 (org-open-file path in-emacs line)) | |
4077 | |
4078 ((string= type "news") | |
4079 (org-follow-gnus-link path)) | |
4080 | |
4081 ((string= type "bbdb") | |
4082 (org-follow-bbdb-link path)) | |
4083 | |
4084 ((string= type "gnus") | |
4085 (let (group article) | |
4086 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
4087 (error "Error in Gnus link")) | |
4088 (setq group (match-string 1 path) | |
4089 article (match-string 3 path)) | |
4090 (org-follow-gnus-link group article))) | |
4091 | |
4092 ((string= type "vm") | |
4093 (let (folder article) | |
4094 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
4095 (error "Error in VM link")) | |
4096 (setq folder (match-string 1 path) | |
4097 article (match-string 3 path)) | |
4098 ;; in-emacs is the prefix arg, will be interpreted as read-only | |
4099 (org-follow-vm-link folder article in-emacs))) | |
4100 | |
4101 ((string= type "wl") | |
4102 (let (folder article) | |
4103 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
4104 (error "Error in Wanderlust link")) | |
4105 (setq folder (match-string 1 path) | |
4106 article (match-string 3 path)) | |
4107 (org-follow-wl-link folder article))) | |
4108 | |
4109 ((string= type "rmail") | |
4110 (let (folder article) | |
4111 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
4112 (error "Error in RMAIL link")) | |
4113 (setq folder (match-string 1 path) | |
4114 article (match-string 3 path)) | |
4115 (org-follow-rmail-link folder article))) | |
4116 | |
4117 ((string= type "shell") | |
4118 (let ((cmd path)) | |
4119 (if (or (not org-confirm-shell-links) | |
4120 (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd))) | |
4121 (shell-command cmd) | |
4122 (error "Abort")))) | |
4123 | |
4124 (t | |
4125 (browse-url-at-point))))))) | |
4126 | |
4127 (defun org-follow-bbdb-link (name) | |
4128 "Follow a BBDB link to NAME." | |
4129 (require 'bbdb) | |
4130 ;; First try an exact match | |
4131 (bbdb-name (concat "\\`" name "\\'") nil) | |
4132 (if (= 0 (buffer-size (get-buffer "*BBDB*"))) | |
4133 ;; No exact match - try partial match | |
4134 (bbdb-name name nil))) | |
4135 | |
4136 (defun org-follow-gnus-link (&optional group article) | |
4137 "Follow a Gnus link to GROUP and ARTICLE." | |
4138 (require 'gnus) | |
4139 (funcall (cdr (assq 'gnus org-link-frame-setup))) | |
4140 (if group (gnus-fetch-group group)) | |
4141 (if article | |
4142 (or (gnus-summary-goto-article article nil 'force) | |
4143 (if (fboundp 'gnus-summary-insert-cached-articles) | |
4144 (progn | |
4145 (gnus-summary-insert-cached-articles) | |
4146 (gnus-summary-goto-article article nil 'force)) | |
4147 (message "Message could not be found."))))) | |
4148 ;; (if article (gnus-summary-goto-article article nil 'force))) | |
4149 | |
4150 (defun org-follow-vm-link (&optional folder article readonly) | |
4151 "Follow a VM link to FOLDER and ARTICLE." | |
4152 (require 'vm) | |
4153 (if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder) | |
4154 ;; ange-ftp or efs or tramp access | |
4155 (let ((user (or (match-string 1 folder) (user-login-name))) | |
4156 (host (match-string 2 folder)) | |
4157 (file (match-string 3 folder))) | |
4158 (cond | |
4159 ((featurep 'tramp) | |
4160 ;; use tramp to access the file | |
4161 (if org-xemacs-p | |
4162 (setq folder (format "[%s@%s]%s" user host file)) | |
4163 (setq folder (format "/%s@%s:%s" user host file)))) | |
4164 (t | |
4165 ;; use ange-ftp or efs | |
4166 (require (if org-xemacs-p 'efs 'ange-ftp)) | |
4167 (setq folder (format "/%s@%s:%s" user host file)))))) | |
4168 (when folder | |
4169 (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly) | |
4170 (sit-for 0.1) | |
4171 (when article | |
4172 (vm-select-folder-buffer) | |
4173 (widen) | |
4174 (let ((case-fold-search t)) | |
4175 (goto-char (point-min)) | |
4176 (if (not (re-search-forward | |
4177 (concat "^" "message-id: *" (regexp-quote article)))) | |
4178 (error "Could not find the specified message in this folder")) | |
4179 (vm-isearch-update) | |
4180 (vm-isearch-narrow) | |
4181 (vm-beginning-of-message) | |
4182 (vm-summarize))))) | |
4183 | |
4184 (defun org-follow-wl-link (folder article) | |
4185 "Follow a Wanderlust link to FOLDER and ARTICLE." | |
4186 (wl-summary-goto-folder-subr folder 'no-sync t nil t) | |
4187 (if article (wl-summary-jump-to-msg-by-message-id article)) | |
4188 (wl-summary-redisplay)) | |
4189 | |
4190 (defun org-follow-rmail-link (folder article) | |
4191 "Follow an RMAIL link to FOLDER and ARTICLE." | |
4192 (let (message-number) | |
4193 (save-excursion | |
4194 (save-window-excursion | |
4195 (rmail (if (string= folder "RMAIL") rmail-file-name folder)) | |
4196 (setq message-number | |
4197 (save-restriction | |
4198 (widen) | |
4199 (goto-char (point-max)) | |
4200 (if (re-search-backward | |
4201 (concat "^Message-ID:\\s-+" (regexp-quote | |
4202 (or article ""))) | |
4203 nil t) | |
4204 (rmail-what-message)))))) | |
4205 (if message-number | |
4206 (progn | |
4207 (rmail (if (string= folder "RMAIL") rmail-file-name folder)) | |
4208 (rmail-show-message message-number) | |
4209 message-number) | |
4210 (error "Message not found")))) | |
4211 | |
4212 (defun org-open-file (path &optional in-emacs line) | |
4213 "Open the file at PATH. | |
4214 First, this expands any special file name abbreviations. Then the | |
4215 configuration variable `org-file-apps' is checked if it contains an | |
4216 entry for this file type, and if yes, the corresponding command is launched. | |
4217 If no application is found, Emacs simply visits the file. | |
4218 With optional argument IN-EMACS, Emacs will visit the file. | |
4219 If the file does not exist, an error is thrown." | |
4220 (let* ((file (convert-standard-filename (org-expand-file-name path))) | |
4221 (dfile (downcase file)) | |
4222 ext cmd apps) | |
4223 (if (and (not (file-exists-p file)) | |
4224 (not org-open-non-existing-files)) | |
4225 (error "No such file: %s" file)) | |
4226 (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) | |
4227 (setq ext (match-string 1 dfile)) | |
4228 (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) | |
4229 (setq ext (match-string 1 dfile)))) | |
4230 (setq apps (append org-file-apps (org-default-apps))) | |
4231 (if in-emacs | |
4232 (setq cmd 'emacs) | |
4233 (setq cmd (or (cdr (assoc ext apps)) | |
4234 (cdr (assoc t apps))))) | |
4235 (cond | |
4236 ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) | |
4237 (setq cmd (format cmd file)) | |
4238 (save-window-excursion | |
4239 (shell-command (concat cmd " & &")))) | |
4240 ((or (stringp cmd) | |
4241 (eq cmd 'emacs)) | |
4242 (funcall (cdr (assq 'file org-link-frame-setup)) file) | |
4243 (if line (goto-line line))) | |
4244 ((consp cmd) | |
4245 (eval cmd)) | |
4246 (t (funcall (cdr (assq 'file org-link-frame-setup)) file))))) | |
4247 | |
4248 (defun org-default-apps () | |
4249 "Return the default applications for this operating system." | |
4250 (cond | |
4251 ((eq system-type 'darwin) | |
4252 org-file-apps-defaults-macosx) | |
4253 ((eq system-type 'windows-nt) | |
4254 org-file-apps-defaults-windowsnt) | |
4255 ((eq system-type 'linux) | |
4256 org-file-apps-defaults-linux) | |
4257 (t org-file-apps-defaults-linux))) | |
4258 | |
4259 (defun org-expand-file-name (path) | |
4260 "Replace special path abbreviations and expand the file name." | |
4261 (expand-file-name path)) | |
4262 | |
4263 | |
4264 (defvar org-insert-link-history nil | |
4265 "Minibuffer history for links inserted with `org-insert-link'.") | |
4266 | |
4267 (defvar org-stored-links nil | |
4268 "Contains the links stored with `org-store-link'.") | |
4269 | |
4270 ;;;###autoload | |
4271 (defun org-store-link (arg) | |
4272 "\\<org-mode-map>Store an org-link to the current location. | |
4273 This link can later be inserted into an org-buffer with | |
4274 \\[org-insert-link]. | |
4275 For some link types, a prefix arg is interpreted: | |
4276 For links to usenet articles, arg negates `org-usenet-links-prefer-google'. | |
4277 For file links, arg negates `org-line-numbers-in-file-links'." | |
4278 (interactive "P") | |
4279 (let (link cpltxt) | |
4280 (cond | |
4281 | |
4282 ((eq major-mode 'bbdb-mode) | |
4283 (setq link (concat "bbdb:" | |
4284 (bbdb-record-name (bbdb-current-record))))) | |
4285 | |
4286 ((eq major-mode 'calendar-mode) | |
4287 (let ((cd (calendar-cursor-to-date))) | |
4288 (setq link | |
4289 (format-time-string | |
4290 (car org-time-stamp-formats) | |
4291 (apply 'encode-time | |
4292 (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) | |
4293 nil nil nil)))))) | |
4294 | |
4295 ((or (eq major-mode 'vm-summary-mode) | |
4296 (eq major-mode 'vm-presentation-mode)) | |
4297 (and (eq major-mode 'vm-presentation-mode) (vm-summarize)) | |
4298 (vm-follow-summary-cursor) | |
4299 (save-excursion | |
4300 (vm-select-folder-buffer) | |
4301 (let* ((message (car vm-message-pointer)) | |
4302 (folder (buffer-file-name)) | |
4303 (subject (vm-su-subject message)) | |
4304 (author (vm-su-full-name message)) | |
4305 (address (vm-su-from message)) | |
4306 (message-id (vm-su-message-id message))) | |
4307 (setq folder (abbreviate-file-name folder)) | |
4308 (if (string-match (concat "^" (regexp-quote vm-folder-directory)) | |
4309 folder) | |
4310 (setq folder (replace-match "" t t folder))) | |
4311 (setq cpltxt (concat author " on: " subject)) | |
4312 (setq link (concat cpltxt "\n " "vm:" folder | |
4313 "#" message-id))))) | |
4314 | |
4315 ((eq major-mode 'wl-summary-mode) | |
4316 (let* ((msgnum (wl-summary-message-number)) | |
4317 (message-id (elmo-message-field wl-summary-buffer-elmo-folder | |
4318 msgnum 'message-id)) | |
4319 (wl-message-entity (elmo-msgdb-overview-get-entity | |
4320 msgnum (wl-summary-buffer-msgdb))) | |
4321 (author (wl-summary-line-from)) ; FIXME: how to get author name? | |
4322 (subject "???")) ; FIXME: How to get subject of email? | |
4323 (setq cpltxt (concat author " on: " subject)) | |
4324 (setq link (concat cpltxt "\n " "wl:" wl-summary-buffer-folder-name | |
4325 "#" message-id)))) | |
4326 | |
4327 ((eq major-mode 'rmail-mode) | |
4328 (save-excursion | |
4329 (save-restriction | |
4330 (rmail-narrow-to-non-pruned-header) | |
4331 (let ((folder (buffer-file-name)) | |
4332 (message-id (mail-fetch-field "message-id")) | |
4333 (author (mail-fetch-field "from")) | |
4334 (subject (mail-fetch-field "subject"))) | |
4335 (setq cpltxt (concat author " on: " subject)) | |
4336 (setq link (concat cpltxt "\n " "rmail:" folder | |
4337 "#" message-id)))))) | |
4338 | |
4339 ((eq major-mode 'gnus-group-mode) | |
4340 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus | |
4341 (gnus-group-group-name)) ; version | |
4342 ((fboundp 'gnus-group-name) | |
4343 (gnus-group-name)) | |
4344 (t "???")))) | |
4345 (if (org-xor arg org-usenet-links-prefer-google) | |
4346 (setq link (format "http://groups.google.com/groups?group=%s" | |
4347 group)) | |
4348 (setq link (concat "gnus:" group))))) | |
4349 | |
4350 ((or (eq major-mode 'gnus-summary-mode) | |
4351 (eq major-mode 'gnus-article-mode)) | |
4352 (gnus-article-show-summary) | |
4353 (gnus-summary-beginning-of-article) | |
4354 (let* ((group (car gnus-article-current)) | |
4355 (article (cdr gnus-article-current)) | |
4356 (header (gnus-summary-article-header article)) | |
4357 (author (mail-header-from header)) | |
4358 (message-id (mail-header-id header)) | |
4359 (date (mail-header-date header)) | |
4360 (subject (gnus-summary-subject-string))) | |
4361 (setq cpltxt (concat author " on: " subject)) | |
4362 (if (org-xor arg org-usenet-links-prefer-google) | |
4363 (setq link | |
4364 (concat | |
4365 cpltxt "\n " | |
4366 (format "http://groups.google.com/groups?as_umsgid=%s" | |
4367 (org-fixup-message-id-for-http message-id)))) | |
4368 (setq link (concat cpltxt "\n" "gnus:" group | |
4369 "#" (number-to-string article)))))) | |
4370 | |
4371 ((eq major-mode 'w3-mode) | |
4372 (setq link (url-view-url t))) | |
4373 ((eq major-mode 'w3m-mode) | |
4374 (setq link w3m-current-url)) | |
4375 | |
4376 ((buffer-file-name) | |
4377 ;; Just link to this file here. | |
4378 (setq link (concat "file:" | |
4379 (abbreviate-file-name (buffer-file-name)))) | |
4380 ;; Add the line number? | |
4381 (if (org-xor org-line-numbers-in-file-links arg) | |
4382 (setq link | |
4383 (concat link | |
4384 ":" (int-to-string | |
4385 (+ (if (bolp) 1 0) (count-lines | |
4386 (point-min) (point)))))))) | |
4387 ((interactive-p) | |
4388 (error "Cannot link to a buffer which is not visiting a file")) | |
4389 (t (setq link nil))) | |
4390 | |
4391 (if (and (interactive-p) link) | |
4392 (progn | |
4393 (setq org-stored-links | |
4394 (cons (cons (or cpltxt link) link) org-stored-links)) | |
4395 (message "Stored: %s" (or cpltxt link))) | |
4396 link))) | |
4397 | |
4398 (defun org-xor (a b) | |
4399 "Exclusive or." | |
4400 (or (and a (not b)) | |
4401 (and b (not a)))) | |
4402 | |
4403 (defun org-get-header (header) | |
4404 "Find a header field in the current buffer." | |
4405 (save-excursion | |
4406 (goto-char (point-min)) | |
4407 (let ((case-fold-search t) s) | |
4408 (cond | |
4409 ((eq header 'from) | |
4410 (if (re-search-forward "^From:\\s-+\\(.*\\)" nil t) | |
4411 (setq s (match-string 1))) | |
4412 (while (string-match "\"" s) | |
4413 (setq s (replace-match "" t t s))) | |
4414 (if (string-match "[<(].*" s) | |
4415 (setq s (replace-match "" t t s)))) | |
4416 ((eq header 'message-id) | |
4417 (if (re-search-forward "^message-id:\\s-+\\(.*\\)" nil t) | |
4418 (setq s (match-string 1)))) | |
4419 ((eq header 'subject) | |
4420 (if (re-search-forward "^subject:\\s-+\\(.*\\)" nil t) | |
4421 (setq s (match-string 1))))) | |
4422 (if (string-match "\\`[ \t\]+" s) (setq s (replace-match "" t t s))) | |
4423 (if (string-match "[ \t\]+\\'" s) (setq s (replace-match "" t t s))) | |
4424 s))) | |
4425 | |
4426 | |
4427 (defun org-fixup-message-id-for-http (s) | |
4428 "Replace special characters in a message id, so that it can be used | |
4429 in an http query." | |
4430 (while (string-match "<" s) | |
4431 (setq s (replace-match "%3C" t t s))) | |
4432 (while (string-match ">" s) | |
4433 (setq s (replace-match "%3E" t t s))) | |
4434 (while (string-match "@" s) | |
4435 (setq s (replace-match "%40" t t s))) | |
4436 s) | |
4437 | |
4438 (defun org-insert-link (&optional complete-file) | |
4439 "Insert a link. At the prompt, enter the link. | |
4440 | |
4441 Completion can be used to select a link previously stored with | |
4442 `org-store-link'. When the empty string is entered (i.e. if you just | |
4443 press RET at the prompt), the link defaults to the most recently | |
4444 stored link. | |
4445 | |
4446 With a C-u prefix, prompts for a file to link to. The file name can be | |
4447 selected using completion. The path to the file will be relative to | |
4448 the current directory if the file is in the current directory or a | |
4449 subdirectory. Otherwise, the link will be the absolute path as | |
4450 completed in the minibuffer (i.e. normally ~/path/to/file). | |
4451 | |
4452 With two C-u prefixes, enforce an absolute path even if the file | |
4453 is in the current directory or below." | |
4454 (interactive "P") | |
4455 (let ((link (if complete-file | |
4456 (read-file-name "File: ") | |
4457 (completing-read | |
4458 "Link: " org-stored-links nil nil nil | |
4459 org-insert-link-history | |
4460 (or (car (car org-stored-links)))))) | |
4461 linktxt matched) | |
4462 (if (or (not link) (equal link "")) | |
4463 (error "No links available")) | |
4464 (if complete-file | |
4465 (let ((pwd (file-name-as-directory (expand-file-name ".")))) | |
4466 (cond | |
4467 ((equal complete-file '(16)) | |
4468 (insert "file:" (abbreviate-file-name (expand-file-name link)))) | |
4469 ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") | |
4470 (expand-file-name link)) | |
4471 (insert "file:" (match-string 1 (expand-file-name link)))) | |
4472 (t (insert "file:" link)))) | |
4473 (setq linktxt (cdr (assoc link org-stored-links))) | |
4474 (if (not org-keep-stored-link-after-insertion) | |
4475 (setq org-stored-links (delq (assoc link org-stored-links) | |
4476 org-stored-links))) | |
4477 (let ((lines (org-split-string (or linktxt link) "\n"))) | |
4478 (insert (car lines)) | |
4479 (setq matched (string-match org-link-regexp (car lines))) | |
4480 (setq lines (cdr lines)) | |
4481 (while lines | |
4482 (insert "\n") | |
4483 (if (save-excursion | |
4484 (beginning-of-line 0) | |
4485 (looking-at "[ \t]+\\S-")) | |
4486 (indent-relative)) | |
4487 (setq matched (or matched | |
4488 (string-match org-link-regexp (car lines)))) | |
4489 (insert (car lines)) | |
4490 (setq lines (cdr lines)))) | |
4491 (unless matched | |
4492 (error "Add link type: http(s),ftp,mailto,file,news,bbdb,vm,wl,rmail,gnus, or shell"))))) | |
4493 | |
4494 ;;; Hooks for remember.el | |
4495 ;;;###autoload | |
4496 (defun org-remember-annotation () | |
4497 "Return a link to the current location as an annotation for remember.el. | |
4498 If you are using Org-mode files as target for data storage with | |
4499 remember.el, then the annotations should include a link compatible with the | |
4500 conventions in Org-mode. This function returns such a link." | |
4501 (org-store-link nil)) | |
4502 | |
4503 (defconst org-remember-help | |
4504 "Select a destination location for the note. | |
4505 UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store | |
4506 RET at beg-of-buf -> Append to file as level 2 headline | |
4507 RET on headline -> Store as sublevel entry to current headline | |
4508 <left>/<right> -> before/after current headline, same headings level") | |
4509 | |
4510 ;; FIXME: Document C-u C-c C-c | |
4511 ;;;###autoload | |
4512 (defun org-remember-handler () | |
4513 "Store stuff from remember.el into an org file. | |
4514 First prompts for an org file. If the user just presses return, the value | |
4515 of `org-default-notes-file' is used. | |
4516 Then the command offers the headings tree of the selected file in order to | |
4517 file the text at a specific location. | |
4518 You can either immediately press RET to get the note appended to the | |
4519 file. Or you can use vertical cursor motion and visibility cycling (TAB) to | |
4520 find a better place. Then press RET or <left> or <right> in insert the note. | |
4521 | |
4522 Key Cursor position Note gets inserted | |
4523 ----------------------------------------------------------------------------- | |
4524 RET buffer-start as level 2 heading at end of file | |
4525 RET on headline as sublevel of the heading at cursor | |
4526 RET no heading at cursor position, level taken from context. | |
4527 Or use prefix arg to specify level manually. | |
4528 <left> on headline as same level, before current heading | |
4529 <right> on headline as same level, after current heading | |
4530 | |
4531 So the fastest way to store the note is to press RET RET to append it to | |
4532 the default file. This way your current train of thought is not | |
4533 interrupted, in accordance with the principles of remember.el. But with | |
4534 little extra effort, you can push it directly to the correct location. | |
4535 | |
4536 Before being stored away, the function ensures that the text has a | |
4537 headline, i.e. a first line that starts with a \"*\". If not, a headline | |
4538 is constructed from the current date and some additional data. | |
4539 | |
4540 If the variable `org-adapt-indentation' is non-nil, the entire text is | |
4541 also indented so that it starts in the same column as the headline | |
4542 \(i.e. after the stars). | |
4543 | |
4544 See also the variable `org-reverse-note-order'." | |
4545 (catch 'quit | |
4546 (let* ((txt (buffer-substring (point-min) (point-max))) | |
4547 (fastp current-prefix-arg) | |
4548 (file (if fastp org-default-notes-file (org-get-org-file))) | |
4549 (visiting (find-buffer-visiting file)) | |
4550 (org-startup-with-deadline-check nil) | |
4551 (org-startup-folded nil) | |
4552 spos level indent reversed) | |
4553 ;; Modify text so that it becomes a nice subtree which can be inserted | |
4554 ;; into an org tree. | |
4555 (let* ((lines (split-string txt "\n")) | |
4556 (first (car lines)) | |
4557 (lines (cdr lines))) | |
4558 (if (string-match "^\\*+" first) | |
4559 ;; Is already a headline | |
4560 (setq indent (make-string (- (match-end 0) (match-beginning 0) | |
4561 -1) ?\ )) | |
4562 ;; We need to add a headline: Use time and first buffer line | |
4563 (setq lines (cons first lines) | |
4564 first (concat "* " (current-time-string) | |
4565 " (" (remember-buffer-desc) ")") | |
4566 indent " ")) | |
4567 (if org-adapt-indentation | |
4568 (setq lines (mapcar (lambda (x) (concat indent x)) lines))) | |
4569 (setq txt (concat first "\n" | |
4570 (mapconcat 'identity lines "\n")))) | |
4571 ;; Find the file | |
4572 (if (not visiting) | |
4573 (find-file-noselect file)) | |
4574 (save-excursion | |
4575 (set-buffer (get-file-buffer file)) | |
4576 (setq reversed (org-notes-order-reversed-p)) | |
4577 (save-restriction | |
4578 (save-excursion | |
4579 (widen) | |
4580 ;; Ask the User for a location | |
4581 (setq spos (if fastp 1 (org-get-location | |
4582 (current-buffer) | |
4583 org-remember-help))) | |
4584 (if (not spos) (throw 'quit nil)) ; return nil to show we did | |
4585 ; not handle this note | |
4586 (goto-char spos) | |
4587 (cond ((bobp) | |
4588 ;; Put it at the start or end, as level 2 | |
4589 (save-restriction | |
4590 (widen) | |
4591 (goto-char (if reversed (point-min) (point-max))) | |
4592 (if (not (bolp)) (newline)) | |
4593 (org-paste-subtree (or current-prefix-arg 2) txt))) | |
4594 ((and (org-on-heading-p nil) (not current-prefix-arg)) | |
4595 ;; Put it below this entry, at the beg/end of the subtree | |
4596 (org-back-to-heading) | |
4597 (setq level (outline-level)) | |
4598 (if reversed | |
4599 (outline-end-of-heading) | |
4600 (outline-end-of-subtree)) | |
4601 (if (not (bolp)) (newline)) | |
4602 (beginning-of-line 1) | |
4603 (org-paste-subtree (1+ level) txt)) | |
4604 (t | |
4605 ;; Put it right there, with automatic level determined by | |
4606 ;; org-paste-subtree or from prefix arg | |
4607 (org-paste-subtree current-prefix-arg txt))) | |
4608 (when remember-save-after-remembering | |
4609 (save-buffer) | |
4610 (if (not visiting) (kill-buffer (current-buffer))))))))) | |
4611 t) ;; return t to indicate that we took care of this note. | |
4612 | |
4613 (defun org-get-org-file () | |
4614 "Read a filename, with default directory `org-directory'." | |
4615 (let ((default (or org-default-notes-file remember-data-file))) | |
4616 (read-file-name (format "File name [%s]: " default) | |
4617 (file-name-as-directory org-directory) | |
4618 default))) | |
4619 | |
4620 (defun org-notes-order-reversed-p () | |
4621 "Check if the current file should receive notes in reversed order." | |
4622 (cond | |
4623 ((not org-reverse-note-order) nil) | |
4624 ((eq t org-reverse-note-order) t) | |
4625 ((not (listp org-reverse-note-order)) nil) | |
4626 (t (catch 'exit | |
4627 (let ((all org-reverse-note-order) | |
4628 entry) | |
4629 (while (setq entry (pop all)) | |
4630 (if (string-match (car entry) (buffer-file-name)) | |
4631 (throw 'exit (cdr entry)))) | |
4632 nil))))) | |
4633 | |
4634 ;;; Tables | |
4635 | |
4636 ;; Watch out: Here we are talking about two different kind of tables. | |
4637 ;; Most of the code is for the tables created with the Org-mode table editor. | |
4638 ;; Sometimes, we talk about tables created and edited with the table.el | |
4639 ;; Emacs package. We call the former org-type tables, and the latter | |
4640 ;; table.el-type tables. | |
4641 | |
4642 ;; We use a before-change function to check if a table might need | |
4643 ;; an update. | |
4644 (defvar org-table-may-need-update t | |
4645 "Indicates of a table might need an update. | |
4646 This variable is set by `org-before-change-function'. `org-table-align' | |
4647 sets it back to nil.") | |
4648 | |
4649 (defun org-before-change-function (beg end) | |
4650 "Every change indicates that a table might need an update." | |
4651 (setq org-table-may-need-update t)) | |
4652 | |
4653 (defconst org-table-line-regexp "^[ \t]*|" | |
4654 "Detects an org-type table line.") | |
4655 (defconst org-table-dataline-regexp "^[ \t]*|[^-]" | |
4656 "Detects an org-type table line.") | |
4657 (defconst org-table-hline-regexp "^[ \t]*|-" | |
4658 "Detects an org-type table hline.") | |
4659 (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" | |
4660 "Detects a table-type table hline.") | |
4661 (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" | |
4662 "Detects an org-type or table-type table") | |
4663 (defconst org-table-border-regexp "^[ \t]*[^| \t]" | |
4664 "Searching from within a table (any type) this finds the first line | |
4665 outside the table.") | |
4666 (defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" | |
4667 "Searching from within a table (any type) this finds the first line | |
4668 outside the table.") | |
4669 | |
4670 (defun org-table-create-with-table.el () | |
4671 "Use the table.el package to insert a new table. | |
4672 If there is already a table at point, convert between Org-mode tables | |
4673 and table.el tables." | |
4674 (interactive) | |
4675 (require 'table) | |
4676 (cond | |
4677 ((org-at-table.el-p) | |
4678 (if (y-or-n-p "Convert table to Org-mode table? ") | |
4679 (org-table-convert))) | |
4680 ((org-at-table-p) | |
4681 (if (y-or-n-p "Convert table to table.el table? ") | |
4682 (org-table-convert))) | |
4683 (t (call-interactively 'table-insert)))) | |
4684 | |
4685 (defun org-table-create (&optional size) | |
4686 "Query for a size and insert a table skeleton. | |
4687 SIZE is a string Columns x Rows like for example \"3x2\"." | |
4688 (interactive "P") | |
4689 (unless size | |
4690 (setq size (read-string | |
4691 (concat "Table size Columns x Rows [e.g. " | |
4692 org-table-default-size "]: ") | |
4693 "" nil org-table-default-size))) | |
4694 | |
4695 (let* ((pos (point)) | |
4696 (indent (make-string (current-column) ?\ )) | |
4697 (split (org-split-string size " *x *")) | |
4698 (rows (string-to-number (nth 1 split))) | |
4699 (columns (string-to-number (car split))) | |
4700 (line (concat (apply 'concat indent "|" (make-list columns " |")) | |
4701 "\n"))) | |
4702 (if (string-match "^[ \t]*$" (buffer-substring-no-properties | |
4703 (point-at-bol) (point))) | |
4704 (beginning-of-line 1) | |
4705 (newline)) | |
4706 (mapcar (lambda (x) (insert line)) (make-list rows t)) | |
4707 (goto-char pos) | |
4708 (if (> rows 1) | |
4709 ;; Insert a hline after the first row. | |
4710 (progn | |
4711 (end-of-line 1) | |
4712 (insert "\n|-") | |
4713 (goto-char pos))) | |
4714 (org-table-align))) | |
4715 | |
4716 (defun org-table-convert-region (beg0 end0 nspace) | |
4717 "Convert region to a table. | |
4718 The region goes from BEG0 to END0, but these borders will be moved | |
4719 slightly, to make sure a beginning of line in the first line is included. | |
4720 When NSPACE is non-nil, it indicates the minimum number of spaces that | |
4721 separate columns (default: just one space)" | |
4722 (let* ((beg (min beg0 end0)) | |
4723 (end (max beg0 end0)) | |
4724 (tabsep t) | |
4725 re) | |
4726 (goto-char beg) | |
4727 (beginning-of-line 1) | |
4728 (setq beg (move-marker (make-marker) (point))) | |
4729 (goto-char end) | |
4730 (if (bolp) (backward-char 1) (end-of-line 1)) | |
4731 (setq end (move-marker (make-marker) (point))) | |
4732 ;; Lets see if this is tab-separated material. If every nonempty line | |
4733 ;; contains a tab, we will assume that it is tab-separated material | |
4734 (if nspace | |
4735 (setq tabsep nil) | |
4736 (goto-char beg) | |
4737 (and (re-search-forward "^[^\n\t]+$" end t) (setq tabsep nil))) | |
4738 (if nspace (setq tabsep nil)) | |
4739 (if tabsep | |
4740 (setq re "^\\|\t") | |
4741 (setq re (format "^ *\\| *\t *\\| \\{%d,\\}" | |
4742 (max 1 (prefix-numeric-value nspace))))) | |
4743 (goto-char beg) | |
4744 (while (re-search-forward re end t) | |
4745 (replace-match "|" t t)) | |
4746 (goto-char beg) | |
4747 (insert " ") | |
4748 (org-table-align))) | |
4749 | |
4750 (defun org-table-import (file arg) | |
4751 "Import FILE as a table. | |
4752 The file is assumed to be tab-separated. Such files can be produced by most | |
4753 spreadsheet and database applications. If no tabs (at least one per line) | |
4754 are found, lines will be split on whitespace into fields." | |
4755 (interactive "f\nP") | |
4756 (or (bolp) (newline)) | |
4757 (let ((beg (point)) | |
4758 (pm (point-max))) | |
4759 (insert-file-contents file) | |
4760 (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg))) | |
4761 | |
4762 (defun org-table-export () | |
4763 "Export table as a tab-separated file. | |
4764 Such a file can be imported into a spreadsheet program like Excel." | |
4765 (interactive) | |
4766 (let* ((beg (org-table-begin)) | |
4767 (end (org-table-end)) | |
4768 (table (buffer-substring beg end)) | |
4769 (file (read-file-name "Export table to: ")) | |
4770 buf) | |
4771 (unless (or (not (file-exists-p file)) | |
4772 (y-or-n-p (format "Overwrite file %s? " file))) | |
4773 (error "Abort")) | |
4774 (save-excursion | |
4775 (find-file file) | |
4776 (setq buf (current-buffer)) | |
4777 (erase-buffer) | |
4778 (fundamental-mode) | |
4779 (insert table) | |
4780 (goto-char (point-min)) | |
4781 (while (re-search-forward "^[ \t]*|[ \t]*" nil t) | |
4782 (replace-match "" t t) | |
4783 (end-of-line 1)) | |
4784 (goto-char (point-min)) | |
4785 (while (re-search-forward "[ \t]*|[ \t]*$" nil t) | |
4786 (replace-match "" t t) | |
4787 (goto-char (min (1+ (point)) (point-max)))) | |
4788 (goto-char (point-min)) | |
4789 (while (re-search-forward "^-[-+]*$" nil t) | |
4790 (replace-match "") | |
4791 (if (looking-at "\n") | |
4792 (delete-char 1))) | |
4793 (goto-char (point-min)) | |
4794 (while (re-search-forward "[ \t]*|[ \t]*" nil t) | |
4795 (replace-match "\t" t t)) | |
4796 (save-buffer)) | |
4797 (kill-buffer buf))) | |
4798 | |
4799 (defun org-table-align (&optional arg) | |
4800 "Align the table at point by aligning all vertical bars." | |
4801 (interactive "P") | |
4802 (let* ( | |
4803 ;; Limits of table | |
4804 (beg (org-table-begin)) | |
4805 (end (org-table-end)) | |
4806 ;; Current cursor position | |
4807 (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) | |
4808 (colpos (org-table-current-column)) | |
4809 (winstart (window-start)) | |
4810 text lines (new "") lengths l typenums ty fields maxfields i | |
4811 column | |
4812 (indent "") cnt frac | |
4813 rfmt hfmt | |
4814 (spaces (if (org-in-invisibility-spec-p '(org-table)) | |
4815 org-table-spaces-around-invisible-separators | |
4816 org-table-spaces-around-separators)) | |
4817 (sp1 (car spaces)) | |
4818 (sp2 (cdr spaces)) | |
4819 (rfmt1 (concat | |
4820 (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) | |
4821 (hfmt1 (concat | |
4822 (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) | |
4823 emptystrings) | |
4824 (untabify beg end) | |
4825 ;; (message "Aligning table...") | |
4826 ;; Get the rows | |
4827 (setq lines (org-split-string | |
4828 (buffer-substring-no-properties beg end) "\n")) | |
4829 ;; Store the indentation of the first line | |
4830 (if (string-match "^ *" (car lines)) | |
4831 (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) | |
4832 ;; Mark the hlines | |
4833 (setq lines (mapcar (lambda (l) (if (string-match "^ *|-" l) nil l)) | |
4834 lines)) | |
4835 ;; Get the data fields | |
4836 (setq fields (mapcar | |
4837 (lambda (l) | |
4838 (org-split-string l " *| *")) | |
4839 (delq nil (copy-sequence lines)))) | |
4840 ;; How many fields in the longest line? | |
4841 (condition-case nil | |
4842 (setq maxfields (apply 'max (mapcar 'length fields))) | |
4843 (error | |
4844 (kill-region beg end) | |
4845 (org-table-create org-table-default-size) | |
4846 (error "Empty table - created default table"))) | |
4847 ;; A list of empty string to fill any short rows on output | |
4848 (setq emptystrings (make-list maxfields "")) | |
4849 ;; Get the maximum length of a field and the most common datatype | |
4850 ;; for each column | |
4851 (setq i -1) | |
4852 (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns | |
4853 (setq column (mapcar (lambda (x) (or (nth i x) "")) fields)) | |
4854 ;; maximum length | |
4855 (push (apply 'max 1 (mapcar 'length column)) lengths) | |
4856 ;; compute the fraction stepwise, ignoring empty fields | |
4857 (setq cnt 0 frac 0.0) | |
4858 (mapcar | |
4859 (lambda (x) | |
4860 (if (equal x "") | |
4861 nil | |
4862 (setq frac ( / (+ (* frac cnt) | |
4863 (if (string-match org-table-number-regexp x) 1 0)) | |
4864 (setq cnt (1+ cnt)))))) | |
4865 column) | |
4866 (push (>= frac org-table-number-fraction) typenums)) | |
4867 (setq lengths (nreverse lengths) | |
4868 typenums (nreverse typenums)) | |
4869 ;; Compute the formats needed for output of the table | |
4870 (setq rfmt (concat indent "|") hfmt (concat indent "|")) | |
4871 (while (setq l (pop lengths)) | |
4872 (setq ty (if (pop typenums) "" "-")) ; number types flushright | |
4873 (setq rfmt (concat rfmt (format rfmt1 ty l)) | |
4874 hfmt (concat hfmt (format hfmt1 (make-string l ?-))))) | |
4875 (setq rfmt (concat rfmt "\n") | |
4876 hfmt (concat (substring hfmt 0 -1) "|\n")) | |
4877 ;; Produce the new table | |
4878 (while lines | |
4879 (setq l (pop lines)) | |
4880 (if l | |
4881 (setq new (concat new (apply 'format rfmt | |
4882 (append (pop fields) emptystrings)))) | |
4883 (setq new (concat new hfmt)))) | |
4884 ;; Replace the old one | |
4885 (delete-region beg end) | |
4886 (move-marker end nil) | |
4887 (insert new) | |
4888 ;; Try to move to the old location (approximately) | |
4889 (goto-line linepos) | |
4890 (set-window-start (selected-window) winstart 'noforce) | |
4891 (org-table-goto-column colpos) | |
4892 (setq org-table-may-need-update nil) | |
4893 ;; (message "Aligning table...done") | |
4894 (if (org-in-invisibility-spec-p '(org-table)) | |
4895 (org-table-add-invisible-to-vertical-lines)) | |
4896 )) | |
4897 | |
4898 (defun org-table-begin (&optional table-type) | |
4899 "Find the beginning of the table and return its position. | |
4900 With argument TABLE-TYPE, go to the beginning of a table.el-type table." | |
4901 (save-excursion | |
4902 (if (not (re-search-backward | |
4903 (if table-type org-table-any-border-regexp | |
4904 org-table-border-regexp) | |
4905 nil t)) | |
4906 (error "Can't find beginning of table") | |
4907 (goto-char (match-beginning 0)) | |
4908 (beginning-of-line 2) | |
4909 (point)))) | |
4910 | |
4911 (defun org-table-end (&optional table-type) | |
4912 "Find the end of the table and return its position. | |
4913 With argument TABLE-TYPE, go to the end of a table.el-type table." | |
4914 (save-excursion | |
4915 (if (not (re-search-forward | |
4916 (if table-type org-table-any-border-regexp | |
4917 org-table-border-regexp) | |
4918 nil t)) | |
4919 (goto-char (point-max)) | |
4920 (goto-char (match-beginning 0))) | |
4921 (point-marker))) | |
4922 | |
4923 (defun org-table-next-field (&optional arg) | |
4924 "Go to the next field in the current table. | |
4925 Before doing so, re-align the table if necessary." | |
4926 (interactive "P") | |
4927 (if (and org-table-automatic-realign | |
4928 org-table-may-need-update) | |
4929 (org-table-align)) | |
4930 (if (org-at-table-hline-p) | |
4931 (end-of-line 1)) | |
4932 (condition-case nil | |
4933 (progn | |
4934 (re-search-forward "|" (org-table-end)) | |
4935 (if (looking-at "[ \t]*$") | |
4936 (re-search-forward "|" (org-table-end))) | |
4937 (if (looking-at "-") | |
4938 (progn | |
4939 (beginning-of-line 0) | |
4940 (org-table-insert-row 'below)) | |
4941 (if (looking-at " ") (forward-char 1)))) | |
4942 (error | |
4943 (org-table-insert-row 'below)))) | |
4944 | |
4945 (defun org-table-previous-field (&optional arg) | |
4946 "Go to the previous field in the table. | |
4947 Before doing so, re-align the table if necessary." | |
4948 (interactive "P") | |
4949 (if (and org-table-automatic-realign | |
4950 org-table-may-need-update) | |
4951 (org-table-align)) | |
4952 (if (org-at-table-hline-p) | |
4953 (end-of-line 1)) | |
4954 (re-search-backward "|" (org-table-begin)) | |
4955 (re-search-backward "|" (org-table-begin)) | |
4956 (while (looking-at "|\\(-\\|[ \t]*$\\)") | |
4957 (re-search-backward "|" (org-table-begin))) | |
4958 (if (looking-at "| ?") | |
4959 (goto-char (match-end 0)))) | |
4960 | |
4961 (defun org-table-next-row (&optional arg) | |
4962 "Go to the next row (same column) in the current table. | |
4963 Before doing so, re-align the table if necessary." | |
4964 (interactive "P") | |
4965 (if (or (looking-at "[ \t]*$") | |
4966 (save-excursion (skip-chars-backward " \t") (bolp))) | |
4967 (newline) | |
4968 (if (and org-table-automatic-realign | |
4969 org-table-may-need-update) | |
4970 (org-table-align)) | |
4971 (let ((col (org-table-current-column))) | |
4972 (beginning-of-line 2) | |
4973 (if (or (not (org-at-table-p)) | |
4974 (org-at-table-hline-p)) | |
4975 (progn | |
4976 (beginning-of-line 0) | |
4977 (org-table-insert-row 'below))) | |
4978 (org-table-goto-column col) | |
4979 (skip-chars-backward "^|\n\r") | |
4980 (if (looking-at " ") (forward-char 1))))) | |
4981 | |
4982 (defun org-table-copy-from-above (n) | |
4983 "Copy into the current column the nearest non-empty field from above. | |
4984 With prefix argument N, take the Nth non-empty field." | |
4985 (interactive "p") | |
4986 (let ((colpos (org-table-current-column)) | |
4987 (beg (org-table-begin)) | |
4988 txt) | |
4989 (org-table-check-inside-data-field) | |
4990 (if (save-excursion | |
4991 (setq txt | |
4992 (catch 'exit | |
4993 (while (progn (beginning-of-line 1) | |
4994 (re-search-backward org-table-dataline-regexp | |
4995 beg t)) | |
4996 (org-table-goto-column colpos t) | |
4997 (if (and (looking-at | |
4998 "|[ \t]*\\([^| \t][^|]*[^| \t]\\)[ \t]*|") | |
4999 (= (setq n (1- n)) 0)) | |
5000 (throw 'exit (match-string 1))))))) | |
5001 (progn | |
5002 (insert txt) | |
5003 (org-table-align)) | |
5004 (error "No non-empty field found")))) | |
5005 | |
5006 (defun org-table-check-inside-data-field () | |
5007 "Is point inside a table data field? | |
5008 I.e. not on a hline or before the first or after the last column?" | |
5009 (if (or (not (org-at-table-p)) | |
5010 (= (org-table-current-column) 0) | |
5011 (org-at-table-hline-p) | |
5012 (looking-at "[ \t]*$")) | |
5013 (error "Not in table data field"))) | |
5014 | |
5015 (defun org-table-blank-field () | |
5016 "Blank the current table field." | |
5017 (interactive) | |
5018 (org-table-check-inside-data-field) | |
5019 (skip-chars-backward "^|") | |
5020 (backward-char 1) | |
5021 (if (looking-at "|[^|]+") | |
5022 (let* ((pos (match-beginning 0)) | |
5023 (match (match-string 0)) | |
5024 (len (length match))) | |
5025 (replace-match (concat "|" (make-string (1- len) ?\ ))) | |
5026 (goto-char (+ 2 pos)) | |
5027 (substring match 1)))) | |
5028 | |
5029 (defun org-table-get-field (&optional n replace) | |
5030 "Return the value of the field in column N of current row. | |
5031 N defaults to current field. | |
5032 If REPLACE is a string, replace field with this value. The return value | |
5033 is always the old value." | |
5034 (and n (org-table-goto-column n)) | |
5035 (skip-chars-backward "^|") | |
5036 (backward-char 1) | |
5037 (if (looking-at "|[^|\r\n]*") | |
5038 (let* ((pos (match-beginning 0)) | |
5039 (len (length (match-string 0))) | |
5040 (val (buffer-substring (1+ pos) (match-end 0)))) | |
5041 (if replace | |
5042 (replace-match (concat "|" replace))) | |
5043 (goto-char (+ 2 pos)) | |
5044 val))) | |
5045 | |
5046 (defun org-table-current-column () | |
5047 "Find out which column we are in. | |
5048 When called interactively, column is also displayed in echo area." | |
5049 (interactive) | |
5050 (if (interactive-p) (org-table-check-inside-data-field)) | |
5051 (save-excursion | |
5052 (let ((cnt 0) (pos (point))) | |
5053 (beginning-of-line 1) | |
5054 (while (search-forward "|" pos t) | |
5055 (setq cnt (1+ cnt))) | |
5056 (if (interactive-p) (message "This is table column %d" cnt)) | |
5057 cnt))) | |
5058 | |
5059 (defun org-table-goto-column (n &optional on-delim force) | |
5060 "Move the cursor to the Nth column in the current table line. | |
5061 With optional argument ON-DELIM, stop with point before the left delimiter | |
5062 of the field. | |
5063 If there are less than N fields, just go to after the last delimiter. | |
5064 However, when FORCE is non-nil, create new columns if necessary." | |
5065 (let ((pos (point-at-eol))) | |
5066 (beginning-of-line 1) | |
5067 (when (> n 0) | |
5068 (while (and (> (setq n (1- n)) -1) | |
5069 (or (search-forward "|" pos t) | |
5070 (and force | |
5071 (progn (end-of-line 1) | |
5072 (skip-chars-backward "^|") | |
5073 (insert " |") | |
5074 (bachward-char 2) t))))) | |
5075 (when (and force (not (looking-at ".*|"))) | |
5076 (save-excursion (end-of-line 1) (insert "|"))) | |
5077 (if on-delim | |
5078 (backward-char 1) | |
5079 (if (looking-at " ") (forward-char 1)))))) | |
5080 | |
5081 (defun org-at-table-p (&optional table-type) | |
5082 "Return t if the cursor is inside an org-type table." | |
5083 (if org-enable-table-editor | |
5084 (save-excursion | |
5085 (beginning-of-line 1) | |
5086 (looking-at (if table-type org-table-any-line-regexp | |
5087 org-table-line-regexp))) | |
5088 nil)) | |
5089 | |
5090 (defun org-table-recognize-table.el () | |
5091 "If there is a table.el table nearby, recognize it and move into it." | |
5092 (if org-table-tab-recognizes-table.el | |
5093 (if (org-at-table.el-p) | |
5094 (progn | |
5095 (beginning-of-line 1) | |
5096 (if (looking-at org-table-dataline-regexp) | |
5097 nil | |
5098 (if (looking-at org-table1-hline-regexp) | |
5099 (progn | |
5100 (beginning-of-line 2) | |
5101 (if (looking-at org-table-any-border-regexp) | |
5102 (beginning-of-line -1))))) | |
5103 (if (re-search-forward "|" (org-table-end t) t) | |
5104 (progn | |
5105 (require 'table) | |
5106 (if (table--at-cell-p (point)) | |
5107 t | |
5108 (message "recognizing table.el table...") | |
5109 (table-recognize-table) | |
5110 (message "recognizing table.el table...done"))) | |
5111 (error "This should not happen...")) | |
5112 t) | |
5113 nil) | |
5114 nil)) | |
5115 | |
5116 (defun org-at-table.el-p () | |
5117 "Return t if the cursor is inside a table.el-type table." | |
5118 (save-excursion | |
5119 (if (org-at-table-p 'any) | |
5120 (progn | |
5121 (goto-char (org-table-begin 'any)) | |
5122 (looking-at org-table1-hline-regexp)) | |
5123 nil))) | |
5124 | |
5125 (defun org-at-table-hline-p () | |
5126 "Return t if the cursor is inside a hline in a table." | |
5127 (if org-enable-table-editor | |
5128 (save-excursion | |
5129 (beginning-of-line 1) | |
5130 (looking-at org-table-hline-regexp)) | |
5131 nil)) | |
5132 | |
5133 (defun org-table-insert-column (&optional arg) | |
5134 "Insert a new column into the table." | |
5135 (interactive "P") | |
5136 (if (not (org-at-table-p)) | |
5137 (error "Not at a table")) | |
5138 (org-table-find-dataline) | |
5139 (let* ((col (max 1 (org-table-current-column))) | |
5140 (beg (org-table-begin)) | |
5141 (end (org-table-end)) | |
5142 ;; Current cursor position | |
5143 (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) | |
5144 (colpos col)) | |
5145 (goto-char beg) | |
5146 (while (< (point) end) | |
5147 (if (org-at-table-hline-p) | |
5148 nil | |
5149 (org-table-goto-column col t) | |
5150 (insert "| ")) | |
5151 (beginning-of-line 2)) | |
5152 (move-marker end nil) | |
5153 (goto-line linepos) | |
5154 (org-table-goto-column colpos)) | |
5155 (org-table-align)) | |
5156 | |
5157 (defun org-table-find-dataline () | |
5158 "Find a dataline in the current table, which is needed for column commands." | |
5159 (if (and (org-at-table-p) | |
5160 (not (org-at-table-hline-p))) | |
5161 t | |
5162 (let ((col (current-column)) | |
5163 (end (org-table-end))) | |
5164 (move-to-column col) | |
5165 (while (and (< (point) end) | |
5166 (or (not (= (current-column) col)) | |
5167 (org-at-table-hline-p))) | |
5168 (beginning-of-line 2) | |
5169 (move-to-column col)) | |
5170 (if (and (org-at-table-p) | |
5171 (not (org-at-table-hline-p))) | |
5172 t | |
5173 (error | |
5174 "Please position cursor in a data line for column operations"))))) | |
5175 | |
5176 (defun org-table-delete-column (&optional arg) | |
5177 "Insert a new column into the table." | |
5178 (interactive "P") | |
5179 (if (not (org-at-table-p)) | |
5180 (error "Not at a table")) | |
5181 (org-table-find-dataline) | |
5182 (org-table-check-inside-data-field) | |
5183 (let* ((col (org-table-current-column)) | |
5184 (beg (org-table-begin)) | |
5185 (end (org-table-end)) | |
5186 ;; Current cursor position | |
5187 (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) | |
5188 (colpos col)) | |
5189 (goto-char beg) | |
5190 (while (< (point) end) | |
5191 (if (org-at-table-hline-p) | |
5192 nil | |
5193 (org-table-goto-column col t) | |
5194 (and (looking-at "|[^|\n]+|") | |
5195 (replace-match "|"))) | |
5196 (beginning-of-line 2)) | |
5197 (move-marker end nil) | |
5198 (goto-line linepos) | |
5199 (org-table-goto-column colpos)) | |
5200 (org-table-align)) | |
5201 | |
5202 (defun org-table-move-column (&optional left) | |
5203 "Move the current column to the right. With arg LEFT, move to the left." | |
5204 (interactive "P") | |
5205 (if (not (org-at-table-p)) | |
5206 (error "Not at a table")) | |
5207 (org-table-find-dataline) | |
5208 (org-table-check-inside-data-field) | |
5209 (let* ((col (org-table-current-column)) | |
5210 (col1 (if left (1- col) col)) | |
5211 (beg (org-table-begin)) | |
5212 (end (org-table-end)) | |
5213 ;; Current cursor position | |
5214 (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) | |
5215 (colpos (if left (1- col) (1+ col)))) | |
5216 (if (and left (= col 1)) | |
5217 (error "Cannot move column further left")) | |
5218 (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) | |
5219 (error "Cannot move column further right")) | |
5220 (goto-char beg) | |
5221 (while (< (point) end) | |
5222 (if (org-at-table-hline-p) | |
5223 nil | |
5224 (org-table-goto-column col1 t) | |
5225 (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") | |
5226 (replace-match "|\\2|\\1|"))) | |
5227 (beginning-of-line 2)) | |
5228 (move-marker end nil) | |
5229 (goto-line linepos) | |
5230 (org-table-goto-column colpos)) | |
5231 (org-table-align)) | |
5232 | |
5233 (defun org-table-move-row (&optional up) | |
5234 "Move the current table line down. With arg UP, move it up." | |
5235 (interactive "P") | |
5236 (let ((col (current-column)) | |
5237 (pos (point)) | |
5238 (tonew (if up 0 2)) | |
5239 txt) | |
5240 (beginning-of-line tonew) | |
5241 (if (not (org-at-table-p)) | |
5242 (progn | |
5243 (goto-char pos) | |
5244 (error "Cannot move row further."))) | |
5245 (goto-char pos) | |
5246 (beginning-of-line 1) | |
5247 (setq pos (point)) | |
5248 (setq txt (buffer-substring (point) (1+ (point-at-eol)))) | |
5249 (delete-region (point) (1+ (point-at-eol))) | |
5250 (beginning-of-line tonew) | |
5251 (insert txt) | |
5252 (beginning-of-line 0) | |
5253 (move-to-column col))) | |
5254 | |
5255 (defun org-table-insert-row (&optional arg) | |
5256 "Insert a new row above the current line into the table. | |
5257 With prefix ARG, insert below the current line." | |
5258 (interactive "P") | |
5259 (if (not (org-at-table-p)) | |
5260 (error "Not at a table")) | |
5261 (let ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) | |
5262 (if (string-match "^[ \t]*|-" line) | |
5263 (setq line (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) line)) | |
5264 (setq line (mapcar (lambda (x) (if (equal x ?|) ?| ?\ )) line))) | |
5265 (beginning-of-line (if arg 2 1)) | |
5266 (apply 'insert line) | |
5267 (insert "\n") | |
5268 (beginning-of-line 0) | |
5269 (re-search-forward "| ?" (point-at-eol) t) | |
5270 (org-table-align))) | |
5271 | |
5272 (defun org-table-insert-hline (&optional arg) | |
5273 "Insert a horizontal-line below the current line into the table. | |
5274 With prefix ARG, insert above the current line." | |
5275 (interactive "P") | |
5276 (if (not (org-at-table-p)) | |
5277 (error "Not at a table")) | |
5278 (let ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol))) | |
5279 (col (current-column)) | |
5280 start) | |
5281 (if (string-match "^[ \t]*|-" line) | |
5282 (setq line | |
5283 (mapcar (lambda (x) (if (member x '(?| ?+)) | |
5284 (prog1 (if start ?+ ?|) (setq start t)) | |
5285 (if start ?- ?\ ))) | |
5286 line)) | |
5287 (setq line | |
5288 (mapcar (lambda (x) (if (equal x ?|) | |
5289 (prog1 (if start ?+ ?|) (setq start t)) | |
5290 (if start ?- ?\ ))) | |
5291 line))) | |
5292 (beginning-of-line (if arg 1 2)) | |
5293 (apply 'insert line) | |
5294 (if (equal (char-before (point)) ?+) | |
5295 (progn (backward-delete-char 1) (insert "|"))) | |
5296 (insert "\n") | |
5297 (beginning-of-line 0) | |
5298 (move-to-column col))) | |
5299 | |
5300 (defun org-table-kill-row (&optional arg) | |
5301 "Delete the current row or horizontal line from the table." | |
5302 (interactive "P") | |
5303 (if (not (org-at-table-p)) | |
5304 (error "Not at a table")) | |
5305 (let ((col (current-column))) | |
5306 (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) | |
5307 (if (not (org-at-table-p)) (beginning-of-line 0)) | |
5308 (move-to-column col))) | |
5309 | |
5310 | |
5311 (defun org-table-cut-region (&optional arg) | |
5312 "Copy region in table to the clipboard and blank all relevant fields." | |
5313 (interactive "P") | |
5314 (org-table-copy-region 'cut)) | |
5315 | |
5316 (defvar org-table-clip nil | |
5317 "Clipboard for table regions") | |
5318 | |
5319 (defun org-table-copy-region (&optional cut) | |
5320 "Copy rectangular region in table to clipboard. | |
5321 A special clibbooard is used which can only be accessed | |
5322 with `org-table-paste-rectangle'" | |
5323 (interactive "P") | |
5324 (unless (org-region-active-p) (error "No active region")) | |
5325 (let* ((beg (region-beginning)) | |
5326 (end (region-end)) | |
5327 l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 | |
5328 region cols | |
5329 (rpl (if cut " " nil))) | |
5330 (goto-char beg) | |
5331 (org-table-check-inside-data-field) | |
5332 (setq l01 (count-lines (point-min) (point)) | |
5333 c01 (org-table-current-column)) | |
5334 (goto-char end) | |
5335 (org-table-check-inside-data-field) | |
5336 (setq l02 (count-lines (point-min) (point)) | |
5337 c02 (org-table-current-column)) | |
5338 (setq l1 (min l01 l02) l2 (max l01 l02) | |
5339 c1 (min c01 c02) c2 (max c01 c02)) | |
5340 (catch 'exit | |
5341 (while t | |
5342 (catch 'nextline | |
5343 (if (> l1 l2) (throw 'exit t)) | |
5344 (goto-line l1) | |
5345 (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1)))) | |
5346 (setq cols nil ic1 c1 ic2 c2) | |
5347 (while (< ic1 (1+ ic2)) | |
5348 (push (org-table-get-field ic1 rpl) cols) | |
5349 (setq ic1 (1+ ic1))) | |
5350 (push (nreverse cols) region) | |
5351 (setq l1 (1+ l1))))) | |
5352 (setq org-table-clip (nreverse region)) | |
5353 (if cut (org-table-align)))) | |
5354 | |
5355 (defun org-table-paste-rectangle (&optional arg) | |
5356 "Paste a rectangluar region into a table. | |
5357 The upper right corner ends up in the current field. All involved fields | |
5358 will be overwritten. If the rectangle does not fit into the present table, | |
5359 the table is enlarged as needed. The process ignores horizontal separator | |
5360 lines." | |
5361 (interactive "P") | |
5362 (unless (and org-table-clip (listp org-table-clip)) | |
5363 (error "First cut/copy a region to paste!")) | |
5364 (org-table-check-inside-data-field) | |
5365 (let* ((clip org-table-clip) | |
5366 (line (count-lines (point-min) (point))) | |
5367 (col (org-table-current-column)) | |
5368 (l line) | |
5369 (org-enable-table-editor t) | |
5370 (org-table-automatic-realign nil) | |
5371 c cols field) | |
5372 (while (setq cols (pop clip)) | |
5373 (while (org-at-table-hline-p) (beginning-of-line 2)) | |
5374 (if (not (org-at-table-p)) | |
5375 (progn (end-of-line 0) (org-table-next-field))) | |
5376 (setq c col) | |
5377 (while (setq field (pop cols)) | |
5378 (org-table-goto-column c nil 'force) | |
5379 (org-table-get-field nil field) | |
5380 (setq c (1+ c))) | |
5381 (beginning-of-line 2)) | |
5382 (goto-line line) | |
5383 (org-table-goto-column col) | |
5384 (org-table-align))) | |
5385 | |
5386 (defun org-table-convert () | |
5387 "Convert from org-mode table to table.el and back. | |
5388 Obviously, this only works within limits. When an Org-mode table is | |
5389 converted to table.el, all horizontal separator lines get lost, because | |
5390 table.el uses these as cell boundaries and has no notion of horizontal lines. | |
5391 A table.el table can be converted to an Org-mode table only if it does not | |
5392 do row or column spanning. Multiline cells will become multiple cells. | |
5393 Beware, Org-mode does not test if the table can be successfully converted - it | |
5394 blindly applies a recipe that works for simple tables." | |
5395 (interactive) | |
5396 (require 'table) | |
5397 (if (org-at-table.el-p) | |
5398 ;; convert to Org-mode table | |
5399 (let ((beg (move-marker (make-marker) (org-table-begin t))) | |
5400 (end (move-marker (make-marker) (org-table-end t)))) | |
5401 (table-unrecognize-region beg end) | |
5402 (goto-char beg) | |
5403 (while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t) | |
5404 (replace-match "")) | |
5405 (goto-char beg)) | |
5406 (if (org-at-table-p) | |
5407 ;; convert to table.el table | |
5408 (let ((beg (move-marker (make-marker) (org-table-begin))) | |
5409 (end (move-marker (make-marker) (org-table-end)))) | |
5410 ;; first, get rid of all horizontal lines | |
5411 (goto-char beg) | |
5412 (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t) | |
5413 (replace-match "")) | |
5414 ;; insert a hline before first | |
5415 (goto-char beg) | |
5416 (org-table-insert-hline 'above) | |
5417 ;; insert a hline after each line | |
5418 (while (progn (beginning-of-line 2) (< (point) end)) | |
5419 (org-table-insert-hline)) | |
5420 (goto-char beg) | |
5421 (setq end (move-marker end (org-table-end))) | |
5422 ;; replace "+" at beginning and ending of hlines | |
5423 (while (re-search-forward "^\\([ \t]*\\)|-" end t) | |
5424 (replace-match "\\1+-")) | |
5425 (goto-char beg) | |
5426 (while (re-search-forward "-|[ \t]*$" end t) | |
5427 (replace-match "-+")) | |
5428 (goto-char beg))))) | |
5429 | |
5430 (defun org-table-wrap-region (arg) | |
5431 "Wrap several fields in a column like a paragraph. | |
5432 This is useful if you'd like to spread the contents of a field over several | |
5433 lines, in order to keep the table compact. | |
5434 | |
5435 If there is an active region, and both point and mark are in the same column, | |
5436 the text in the column is wrapped to minimum width for the given number of | |
5437 lines. Generally, this makes the table more compact. A prefix ARG may be | |
5438 used to change the number of desired lines. For example, `C-2 C-c C-q' | |
5439 formats the selected text to two lines. If the region was longer than 2 | |
5440 lines, the remaining lines remain empty. A negative prefix argument reduces | |
5441 the current number of lines by that amount. The wrapped text is pasted back | |
5442 into the table. If you formatted it to more lines than it was before, fields | |
5443 further down in the table get overwritten - so you might need to make space in | |
5444 the table first. | |
5445 | |
5446 If there is no region, the current field is split at the cursor position and | |
5447 the text fragment to the right of the cursor is prepended to the field one | |
5448 line down. | |
5449 | |
5450 If there is no region, but you specify a prefix ARG, the current field gets | |
5451 blank, and the content is appended to the field above." | |
5452 (interactive "P") | |
5453 (org-table-check-inside-data-field) | |
5454 (if (org-region-active-p) | |
5455 ;; There is a region: fill as a paragraph | |
5456 (let ((beg (region-beginning)) | |
5457 nlines) | |
5458 (org-table-cut-region) | |
5459 (if (> (length (car org-table-clip)) 1) | |
5460 (error "Region must be limited to single columm")) | |
5461 (setq nlines (if arg | |
5462 (if (< arg 1) | |
5463 (+ (length org-table-clip) arg) | |
5464 arg) | |
5465 (length org-table-clip))) | |
5466 (setq org-table-clip | |
5467 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") | |
5468 nil nlines))) | |
5469 (goto-char beg) | |
5470 (org-table-paste-rectangle)) | |
5471 ;; No region, split the current field at point | |
5472 (if arg | |
5473 ;; combine with field above | |
5474 (let ((s (org-table-blank-field)) | |
5475 (col (org-table-current-column))) | |
5476 (beginning-of-line 0) | |
5477 (while (org-at-table-hline-p) (beginning-of-line 0)) | |
5478 (org-table-goto-column col) | |
5479 (skip-chars-forward "^|") | |
5480 (skip-chars-backward " ") | |
5481 (insert " " (org-trim s)) | |
5482 (org-table-align)) | |
5483 ;; split field | |
5484 (when (looking-at "\\([^|]+\\)+|") | |
5485 (let ((s (match-string 1))) | |
5486 (replace-match " |") | |
5487 (goto-char (match-beginning 0)) | |
5488 (org-table-next-row) | |
5489 (insert (org-trim s) " ") | |
5490 (org-table-align)))))) | |
5491 | |
5492 (defun org-trim (s) | |
5493 "Remove whitespace at beginning and end of string." | |
5494 (if (string-match "^[ \t]+" s) (setq s (replace-match "" t t s))) | |
5495 (if (string-match "[ \t]+$" s) (setq s (replace-match "" t t s)))) | |
5496 | |
5497 (defun org-wrap (string &optional width lines) | |
5498 "Wrap string to either a number of lines, or a with in characters. | |
5499 If WIDTH is non-nil, the string is wrapped to that width, however many lines | |
5500 that costs. If there is a work longer than WIDTH, the text is actually | |
5501 wrapped to the length of that word. | |
5502 IF WIDTH is nil and LINES is non-nil, the string is forced into at mot that | |
5503 many lines, whatever width that takes. | |
5504 The return value is a list of lines, without newlines at the end." | |
5505 (let* ((words (org-split-string string "[ \t\n]+")) | |
5506 (maxword (apply 'max (mapcar 'length words))) | |
5507 (black (apply '+ (mapcar 'length words))) | |
5508 (total (+ black (length words))) | |
5509 w ll) | |
5510 (cond (width | |
5511 (org-do-wrap words (max maxword width))) | |
5512 (lines | |
5513 (setq w maxword) | |
5514 (setq ll (org-do-wrap words maxword)) | |
5515 (if (<= (length ll) lines) | |
5516 ll | |
5517 (setq ll words) | |
5518 (while (> (length ll) lines) | |
5519 (setq w (1+ w)) | |
5520 (setq ll (org-do-wrap words w))) | |
5521 ll)) | |
5522 (t (error "Cannot wrap this"))))) | |
5523 | |
5524 | |
5525 (defun org-do-wrap (words width) | |
5526 "Creates lines of maximum width WIDTH (in characters) from word list WORDS." | |
5527 (let (lines line) | |
5528 (while words | |
5529 (setq line (pop words)) | |
5530 (while (and words (< (+ (length line) (length (car words))) width)) | |
5531 (setq line (concat line " " (pop words)))) | |
5532 (setq lines (push line lines))) | |
5533 (nreverse lines))) | |
5534 | |
5535 ;; FIXME: I think I can make this more efficient | |
5536 (defun org-split-string (string &optional separators) | |
5537 "Splits STRING into substrings at SEPARATORS. | |
5538 No empty strings are returned if there are matches at the beginning | |
5539 and end of string." | |
5540 (let ((rexp (or separators "[ \f\t\n\r\v]+")) | |
5541 (start 0) | |
5542 notfirst | |
5543 (list nil)) | |
5544 (while (and (string-match rexp string | |
5545 (if (and notfirst | |
5546 (= start (match-beginning 0)) | |
5547 (< start (length string))) | |
5548 (1+ start) start)) | |
5549 (< (match-beginning 0) (length string))) | |
5550 (setq notfirst t) | |
5551 (or (eq (match-beginning 0) 0) | |
5552 (and (eq (match-beginning 0) (match-end 0)) | |
5553 (eq (match-beginning 0) start)) | |
5554 (setq list | |
5555 (cons (substring string start (match-beginning 0)) | |
5556 list))) | |
5557 (setq start (match-end 0))) | |
5558 (or (eq start (length string)) | |
5559 (setq list | |
5560 (cons (substring string start) | |
5561 list))) | |
5562 (nreverse list))) | |
5563 | |
5564 (defun org-table-add-invisible-to-vertical-lines () | |
5565 "Add an `invisible' property to vertical lines of current table." | |
5566 (interactive) | |
5567 (let* ((beg (org-table-begin)) | |
5568 (end (org-table-end)) | |
5569 (end1)) | |
5570 (save-excursion | |
5571 (goto-char beg) | |
5572 (while (< (point) end) | |
5573 (setq end1 (point-at-eol)) | |
5574 (if (looking-at org-table-dataline-regexp) | |
5575 (while (re-search-forward "|" end1 t) | |
5576 (add-text-properties (1- (point)) (point) | |
5577 '(invisible org-table))) | |
5578 (while (re-search-forward "[+|]" end1 t) | |
5579 (add-text-properties (1- (point)) (point) | |
5580 '(invisible org-table)))) | |
5581 (beginning-of-line 2))))) | |
5582 | |
5583 (defun org-table-toggle-vline-visibility (&optional arg) | |
5584 "Toggle the visibility of table vertical lines. | |
5585 The effect is immediate and on all tables in the file. | |
5586 With prefix ARG, make lines invisible when ARG if positive, make lines | |
5587 visible when ARG is not positive" | |
5588 (interactive "P") | |
5589 (let ((action (cond | |
5590 ((and arg (> (prefix-numeric-value arg) 0)) 'on) | |
5591 ((and arg (< (prefix-numeric-value arg) 1)) 'off) | |
5592 (t (if (org-in-invisibility-spec-p '(org-table)) | |
5593 'off | |
5594 'on))))) | |
5595 (if (eq action 'off) | |
5596 (progn | |
5597 (org-remove-from-invisibility-spec '(org-table)) | |
5598 (org-table-map-tables 'org-table-align) | |
5599 (message "Vertical table lines visible") | |
5600 (if (org-at-table-p) | |
5601 (org-table-align))) | |
5602 (org-add-to-invisibility-spec '(org-table)) | |
5603 (org-table-map-tables 'org-table-align) | |
5604 (message "Vertical table lines invisible")) | |
5605 (redraw-frame (selected-frame)))) | |
5606 | |
5607 (defun org-table-map-tables (function) | |
5608 "Apply FUNCTION to the start of all tables in the buffer." | |
5609 (save-excursion | |
5610 (save-restriction | |
5611 (widen) | |
5612 (goto-char (point-min)) | |
5613 (while (re-search-forward org-table-any-line-regexp nil t) | |
5614 (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) | |
5615 (beginning-of-line 1) | |
5616 (if (looking-at org-table-line-regexp) | |
5617 (save-excursion (funcall function))) | |
5618 (re-search-forward org-table-any-border-regexp nil 1))))) | |
5619 | |
5620 (defun org-table-sum () | |
5621 "Sum numbers in region of current table column. | |
5622 The result will be displayed in the echo area, and will be available | |
5623 as kill to be inserted with \\[yank]. | |
5624 | |
5625 If there is an active region, it is interpreted as a rectangle and all | |
5626 numbers in that rectangle will be summed. If there is no active | |
5627 region and point is located in a table column, sum all numbers in that | |
5628 column. | |
5629 | |
5630 If at least on number looks like a time HH:MM or HH:MM:SS, all other | |
5631 numbers are assumed to be times as well (in decimal hours) and the | |
5632 numbers are added as such." | |
5633 (interactive) | |
5634 (save-excursion | |
5635 (let (beg end col (timecnt 0) diff h m s) | |
5636 (if (org-region-active-p) | |
5637 (setq beg (region-beginning) end (region-end)) | |
5638 (setq col (org-table-current-column)) | |
5639 (goto-char (org-table-begin)) | |
5640 (unless (re-search-forward "^[ \t]*|[^-]" nil t) | |
5641 (error "No table data")) | |
5642 (org-table-goto-column col) | |
5643 (skip-chars-backward "^|") | |
5644 (setq beg (point)) | |
5645 (goto-char (org-table-end)) | |
5646 (unless (re-search-backward "^[ \t]*|[^-]" nil t) | |
5647 (error "No table data")) | |
5648 (org-table-goto-column col) | |
5649 (skip-chars-forward "^|") | |
5650 (setq end (point))) | |
5651 (let* ((l1 (progn (goto-char beg) | |
5652 (+ (if (bolp) 1 0) (count-lines (point-min) (point))))) | |
5653 (l2 (progn (goto-char end) | |
5654 (+ (if (bolp) 1 0) (count-lines (point-min) (point))))) | |
5655 (items (if (= l1 l2) | |
5656 (split-string (buffer-substring beg end)) | |
5657 (split-string | |
5658 (mapconcat 'identity (extract-rectangle beg end) " ")))) | |
5659 (numbers (delq nil (mapcar 'org-table-get-number-for-summing | |
5660 items))) | |
5661 (res (apply '+ numbers)) | |
5662 (sres (if (= timecnt 0) | |
5663 (format "%g" res) | |
5664 (setq diff (* 3600 res) | |
5665 h (floor (/ diff 3600)) diff (mod diff 3600) | |
5666 m (floor (/ diff 60)) diff (mod diff 60) | |
5667 s diff) | |
5668 (format "%d:%02d:%02d" h m s)))) | |
5669 (kill-new sres) | |
5670 (message (substitute-command-keys | |
5671 (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" | |
5672 (length numbers) sres))))))) | |
5673 | |
5674 (defun org-table-get-number-for-summing (s) | |
5675 (let (n) | |
5676 (if (string-match "^ *|? *" s) | |
5677 (setq s (replace-match "" nil nil s))) | |
5678 (if (string-match " *|? *$" s) | |
5679 (setq s (replace-match "" nil nil s))) | |
5680 (setq n (string-to-number s)) | |
5681 (cond | |
5682 ((and (string-match "0" s) | |
5683 (string-match "\\`[-+ \t0.edED]+\\'" s)) 0) | |
5684 ((string-match "\\`[ \t]+\\'" s) nil) | |
5685 ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s) | |
5686 (let ((h (string-to-number (or (match-string 1 s) "0"))) | |
5687 (m (string-to-number (or (match-string 2 s) "0"))) | |
5688 (s (string-to-number (or (match-string 4 s) "0")))) | |
5689 (if (boundp 'timecnt) (setq timecnt (1+ timecnt))) | |
5690 (* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) | |
5691 ((equal n 0) nil) | |
5692 (t n)))) | |
5693 | |
5694 (defvar org-table-current-formula nil) | |
5695 (defvar org-table-formula-history nil) | |
5696 (defun org-table-get-formula (current) | |
5697 (if (and current (not (equal "" org-table-current-formula))) | |
5698 org-table-current-formula | |
5699 (setq org-table-current-formula | |
5700 (read-string | |
5701 "Formula [last]: " "" 'org-table-formula-history | |
5702 org-table-current-formula)))) | |
5703 | |
5704 (defun org-this-word () | |
5705 ;; Get the current word | |
5706 (save-excursion | |
5707 (let ((beg (progn (skip-chars-backward "^ \t\n") (point))) | |
5708 (end (progn (skip-chars-forward "^ \t\n") (point)))) | |
5709 (buffer-substring-no-properties beg end)))) | |
5710 | |
5711 (defun org-table-eval-formula (&optional ndown) | |
5712 "Replace the table field value at the cursor by the result of a calculation. | |
5713 | |
5714 This function makes use of Dave Gillespie's calc package, arguably the most | |
5715 exciting program ever written for GNU Emacs. So you need to have calc | |
5716 installed in order to use this function. | |
5717 | |
5718 In a table, this command replaces the value in the current field with the | |
5719 result of a formula. While nowhere near the computation options of a | |
5720 spreadsheet program, this is still very useful. Note that there is no | |
5721 automatic updating of a calculated field, nor will the field remember the | |
5722 formula. The command needs to be applied again after changing input | |
5723 fields. | |
5724 | |
5725 When called, the command first prompts for a formula, which is read in the | |
5726 minibuffer. Previously entered formulae are available through the history | |
5727 list, and the last used formula is the default, reachable by simply | |
5728 pressing RET. | |
5729 | |
5730 The formula can be any algebraic expression understood by the calc package. | |
5731 Before evaluation, variable substitution takes place: \"$\" is replaced by | |
5732 the field the cursor is currently in, and $1..$n reference the fields in | |
5733 the current row. Values from a *different* row can *not* be referenced | |
5734 here, so the command supports only horizontal computing. The formula can | |
5735 contain an optional printf format specifier after a semicolon, to reformat | |
5736 the result. | |
5737 | |
5738 A few examples for formulae: | |
5739 $1+$2 Sum of first and second field | |
5740 $1+$2;%f.2 Same, and format result to two digits after dec.point | |
5741 exp($2)+exp($1) Math functions can be used | |
5742 $;%f.1 Reformat current cell to 1 digit after dec.point | |
5743 ($3-32)*5/9 degrees F -> C conversion | |
5744 | |
5745 When called with a raw C-u prefix, the formula is applied to the current | |
5746 field, and to the same same column in all following rows, until reaching a | |
5747 horizontal line or the end of the table. When the command is called with a | |
5748 numeric prefix argument (like M-3 or C-7 or C-u 24), the formula is applied | |
5749 to the current row, and to the following n-1 rows (but not beyond a | |
5750 separator line)." | |
5751 (interactive "P") | |
5752 (setq ndown (if (equal ndown '(4)) 10000 (prefix-numeric-value ndown))) | |
5753 (require 'calc) | |
5754 (org-table-check-inside-data-field) | |
5755 (let* (fields | |
5756 (org-table-automatic-realign nil) | |
5757 (down (> ndown 1)) | |
5758 (formula (org-table-get-formula nil)) | |
5759 (n0 (org-table-current-column)) | |
5760 n form fmt x ev) | |
5761 (if (string-match ";" formula) | |
5762 (let ((tmp (org-split-string formula ";"))) | |
5763 (setq formula (car tmp) fmt (nth 1 tmp)))) | |
5764 (while (> ndown 0) | |
5765 (setq fields (org-split-string | |
5766 (concat " " (buffer-substring | |
5767 (point-at-bol) (point-at-eol))) "|")) | |
5768 (setq ndown (1- ndown)) | |
5769 (setq form (copy-sequence formula)) | |
5770 (while (string-match "\\$\\([0-9]+\\)?" form) | |
5771 (setq n (if (match-beginning 1) | |
5772 (string-to-int (match-string 1 form)) | |
5773 n0) | |
5774 x (nth n fields)) | |
5775 (unless x (error "Illegal field specifier \"%s\"" | |
5776 (match-string 0 form))) | |
5777 (if (equal (string-to-number x) 0) (setq x "0")) | |
5778 (setq form (replace-match x t t form))) | |
5779 (setq ev (calc-eval (list form) 'num)) | |
5780 (if (listp ev) | |
5781 (error "Illegal expression: %s (%s at %d)" form (nth 1 ev) (car ev))) | |
5782 (org-table-blank-field) | |
5783 (if fmt | |
5784 (insert (format fmt (string-to-number ev))) | |
5785 (insert ev)) | |
5786 (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) | |
5787 (call-interactively 'org-return) | |
5788 (setq ndown 0))) | |
5789 (org-table-align))) | |
5790 | |
5791 ;;; Exporting | |
5792 | |
5793 (defconst org-level-max 20) | |
5794 | |
5795 (defun org-export-find-first-heading-line (list) | |
5796 "Remove all lines from LIST which are before the first headline." | |
5797 (let ((orig-list list) | |
5798 (re (concat "^" outline-regexp))) | |
5799 (while (and list | |
5800 (not (string-match re (car list)))) | |
5801 (pop list)) | |
5802 (or list orig-list))) | |
5803 | |
5804 (defun org-skip-comments (lines) | |
5805 "Skip lines starting with \"#\" and subtrees starting with COMMENT." | |
5806 (let ((re1 (concat "^\\(\\*+\\)[ \t]+" org-comment-string)) | |
5807 (re2 "^\\(\\*+\\)[ \t\n\r]") | |
5808 rtn line level) | |
5809 (while (setq line (pop lines)) | |
5810 (cond | |
5811 ((and (string-match re1 line) | |
5812 (setq level (- (match-end 1) (match-beginning 1)))) | |
5813 ;; Beginning of a COMMENT subtree. Skip it. | |
5814 (while (and (setq line (pop lines)) | |
5815 (or (not (string-match re2 line)) | |
5816 (> (- (match-end 1) (match-beginning 1)) level)))) | |
5817 (setq lines (cons line lines))) | |
5818 ((string-match "^#" line) | |
5819 ;; an ordinary comment line | |
5820 ) | |
5821 (t (setq rtn (cons line rtn))))) | |
5822 (nreverse rtn))) | |
5823 | |
5824 ;; ASCII | |
5825 | |
5826 (defconst org-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) | |
5827 "Characters for underlining headings in ASCII export.") | |
5828 | |
5829 (defconst org-html-entities | |
5830 '(("nbsp") | |
5831 ("iexcl") | |
5832 ("cent") | |
5833 ("pound") | |
5834 ("curren") | |
5835 ("yen") | |
5836 ("brvbar") | |
5837 ("sect") | |
5838 ("uml") | |
5839 ("copy") | |
5840 ("ordf") | |
5841 ("laquo") | |
5842 ("not") | |
5843 ("shy") | |
5844 ("reg") | |
5845 ("macr") | |
5846 ("deg") | |
5847 ("plusmn") | |
5848 ("sup2") | |
5849 ("sup3") | |
5850 ("acute") | |
5851 ("micro") | |
5852 ("para") | |
5853 ("middot") | |
5854 ("odot"."o") | |
5855 ("star"."*") | |
5856 ("cedil") | |
5857 ("sup1") | |
5858 ("ordm") | |
5859 ("raquo") | |
5860 ("frac14") | |
5861 ("frac12") | |
5862 ("frac34") | |
5863 ("iquest") | |
5864 ("Agrave") | |
5865 ("Aacute") | |
5866 ("Acirc") | |
5867 ("Atilde") | |
5868 ("Auml") | |
5869 ("Aring") ("AA"."Å") | |
5870 ("AElig") | |
5871 ("Ccedil") | |
5872 ("Egrave") | |
5873 ("Eacute") | |
5874 ("Ecirc") | |
5875 ("Euml") | |
5876 ("Igrave") | |
5877 ("Iacute") | |
5878 ("Icirc") | |
5879 ("Iuml") | |
5880 ("ETH") | |
5881 ("Ntilde") | |
5882 ("Ograve") | |
5883 ("Oacute") | |
5884 ("Ocirc") | |
5885 ("Otilde") | |
5886 ("Ouml") | |
5887 ("times") | |
5888 ("Oslash") | |
5889 ("Ugrave") | |
5890 ("Uacute") | |
5891 ("Ucirc") | |
5892 ("Uuml") | |
5893 ("Yacute") | |
5894 ("THORN") | |
5895 ("szlig") | |
5896 ("agrave") | |
5897 ("aacute") | |
5898 ("acirc") | |
5899 ("atilde") | |
5900 ("auml") | |
5901 ("aring") | |
5902 ("aelig") | |
5903 ("ccedil") | |
5904 ("egrave") | |
5905 ("eacute") | |
5906 ("ecirc") | |
5907 ("euml") | |
5908 ("igrave") | |
5909 ("iacute") | |
5910 ("icirc") | |
5911 ("iuml") | |
5912 ("eth") | |
5913 ("ntilde") | |
5914 ("ograve") | |
5915 ("oacute") | |
5916 ("ocirc") | |
5917 ("otilde") | |
5918 ("ouml") | |
5919 ("divide") | |
5920 ("oslash") | |
5921 ("ugrave") | |
5922 ("uacute") | |
5923 ("ucirc") | |
5924 ("uuml") | |
5925 ("yacute") | |
5926 ("thorn") | |
5927 ("yuml") | |
5928 ("fnof") | |
5929 ("Alpha") | |
5930 ("Beta") | |
5931 ("Gamma") | |
5932 ("Delta") | |
5933 ("Epsilon") | |
5934 ("Zeta") | |
5935 ("Eta") | |
5936 ("Theta") | |
5937 ("Iota") | |
5938 ("Kappa") | |
5939 ("Lambda") | |
5940 ("Mu") | |
5941 ("Nu") | |
5942 ("Xi") | |
5943 ("Omicron") | |
5944 ("Pi") | |
5945 ("Rho") | |
5946 ("Sigma") | |
5947 ("Tau") | |
5948 ("Upsilon") | |
5949 ("Phi") | |
5950 ("Chi") | |
5951 ("Psi") | |
5952 ("Omega") | |
5953 ("alpha") | |
5954 ("beta") | |
5955 ("gamma") | |
5956 ("delta") | |
5957 ("epsilon") | |
5958 ("varepsilon"."ε") | |
5959 ("zeta") | |
5960 ("eta") | |
5961 ("theta") | |
5962 ("iota") | |
5963 ("kappa") | |
5964 ("lambda") | |
5965 ("mu") | |
5966 ("nu") | |
5967 ("xi") | |
5968 ("omicron") | |
5969 ("pi") | |
5970 ("rho") | |
5971 ("sigmaf") ("varsigma"."ς") | |
5972 ("sigma") | |
5973 ("tau") | |
5974 ("upsilon") | |
5975 ("phi") | |
5976 ("chi") | |
5977 ("psi") | |
5978 ("omega") | |
5979 ("thetasym") ("vartheta"."ϑ") | |
5980 ("upsih") | |
5981 ("piv") | |
5982 ("bull") ("bullet"."•") | |
5983 ("hellip") ("dots"."…") | |
5984 ("prime") | |
5985 ("Prime") | |
5986 ("oline") | |
5987 ("frasl") | |
5988 ("weierp") | |
5989 ("image") | |
5990 ("real") | |
5991 ("trade") | |
5992 ("alefsym") | |
5993 ("larr") ("leftarrow"."←") ("gets"."←") | |
5994 ("uarr") ("uparrow"."↑") | |
5995 ("rarr") ("to"."→") ("rightarrow"."→") | |
5996 ("darr")("downarrow"."↓") | |
5997 ("harr") ("leftrightarrow"."↔") | |
5998 ("crarr") ("hookleftarrow"."↵") ; has round hook, not quite CR | |
5999 ("lArr") ("Leftarrow"."⇐") | |
6000 ("uArr") ("Uparrow"."⇑") | |
6001 ("rArr") ("Rightarrow"."⇒") | |
6002 ("dArr") ("Downarrow"."⇓") | |
6003 ("hArr") ("Leftrightarrow"."⇔") | |
6004 ("forall") | |
6005 ("part") ("partial"."∂") | |
6006 ("exist") ("exists"."∃") | |
6007 ("empty") ("emptyset"."∅") | |
6008 ("nabla") | |
6009 ("isin") ("in"."∈") | |
6010 ("notin") | |
6011 ("ni") | |
6012 ("prod") | |
6013 ("sum") | |
6014 ("minus") | |
6015 ("lowast") ("ast"."∗") | |
6016 ("radic") | |
6017 ("prop") ("proptp"."∝") | |
6018 ("infin") ("infty"."∞") | |
6019 ("ang") ("angle"."∠") | |
6020 ("and") ("vee"."∧") | |
6021 ("or") ("wedge"."∨") | |
6022 ("cap") | |
6023 ("cup") | |
6024 ("int") | |
6025 ("there4") | |
6026 ("sim") | |
6027 ("cong") ("simeq"."≅") | |
6028 ("asymp")("approx"."≈") | |
6029 ("ne") ("neq"."≠") | |
6030 ("equiv") | |
6031 ("le") | |
6032 ("ge") | |
6033 ("sub") ("subset"."⊂") | |
6034 ("sup") ("supset"."⊃") | |
6035 ("nsub") | |
6036 ("sube") | |
6037 ("supe") | |
6038 ("oplus") | |
6039 ("otimes") | |
6040 ("perp") | |
6041 ("sdot") ("cdot"."⋅") | |
6042 ("lceil") | |
6043 ("rceil") | |
6044 ("lfloor") | |
6045 ("rfloor") | |
6046 ("lang") | |
6047 ("rang") | |
6048 ("loz") ("Diamond"."◊") | |
6049 ("spades") ("spadesuit"."♠") | |
6050 ("clubs") ("clubsuit"."♣") | |
6051 ("hearts") ("diamondsuit"."♥") | |
6052 ("diams") ("diamondsuit"."♦") | |
6053 ("quot") | |
6054 ("amp") | |
6055 ("lt") | |
6056 ("gt") | |
6057 ("OElig") | |
6058 ("oelig") | |
6059 ("Scaron") | |
6060 ("scaron") | |
6061 ("Yuml") | |
6062 ("circ") | |
6063 ("tilde") | |
6064 ("ensp") | |
6065 ("emsp") | |
6066 ("thinsp") | |
6067 ("zwnj") | |
6068 ("zwj") | |
6069 ("lrm") | |
6070 ("rlm") | |
6071 ("ndash") | |
6072 ("mdash") | |
6073 ("lsquo") | |
6074 ("rsquo") | |
6075 ("sbquo") | |
6076 ("ldquo") | |
6077 ("rdquo") | |
6078 ("bdquo") | |
6079 ("dagger") | |
6080 ("Dagger") | |
6081 ("permil") | |
6082 ("lsaquo") | |
6083 ("rsaquo") | |
6084 ("euro") | |
6085 | |
6086 ("arccos"."arccos") | |
6087 ("arcsin"."arcsin") | |
6088 ("arctan"."arctan") | |
6089 ("arg"."arg") | |
6090 ("cos"."cos") | |
6091 ("cosh"."cosh") | |
6092 ("cot"."cot") | |
6093 ("coth"."coth") | |
6094 ("csc"."csc") | |
6095 ("deg"."deg") | |
6096 ("det"."det") | |
6097 ("dim"."dim") | |
6098 ("exp"."exp") | |
6099 ("gcd"."gcd") | |
6100 ("hom"."hom") | |
6101 ("inf"."inf") | |
6102 ("ker"."ker") | |
6103 ("lg"."lg") | |
6104 ("lim"."lim") | |
6105 ("liminf"."liminf") | |
6106 ("limsup"."limsup") | |
6107 ("ln"."ln") | |
6108 ("log"."log") | |
6109 ("max"."max") | |
6110 ("min"."min") | |
6111 ("Pr"."Pr") | |
6112 ("sec"."sec") | |
6113 ("sin"."sin") | |
6114 ("sinh"."sinh") | |
6115 ("sup"."sup") | |
6116 ("tan"."tan") | |
6117 ("tanh"."tanh") | |
6118 ) | |
6119 "Entities for TeX->HTML translation. | |
6120 Entries can be like (\"ent\"), in which case \"\\ent\" will be translated to | |
6121 \"&ent;\". An entry can also be a dotted pair like (\"ent\".\"&other;\"). | |
6122 In that case, \"\\ent\" will be translated to \"&other;\". | |
6123 The list contains HTML entities for Latin-1, Greek and other symbols. | |
6124 It is supplemented by a number of commonly used TeX macros with appropriate | |
6125 translations.") | |
6126 | |
6127 (defun org-export-as-ascii (arg) | |
6128 "Export the outline as a pretty ASCII file. | |
6129 If there is an active region, export only the region. | |
6130 The prefix ARG specifies how many levels of the outline should become | |
6131 underlined headlines. The default is 3." | |
6132 (interactive "P") | |
6133 (setq-default org-todo-line-regexp org-todo-line-regexp) | |
6134 (let* ((region | |
6135 (buffer-substring | |
6136 (if (org-region-active-p) (region-beginning) (point-min)) | |
6137 (if (org-region-active-p) (region-end) (point-max)))) | |
6138 (lines (org-export-find-first-heading-line | |
6139 (org-skip-comments (org-split-string region "[\r\n]")))) | |
6140 (org-startup-with-deadline-check nil) | |
6141 (level 0) line txt | |
6142 (umax nil) | |
6143 (case-fold-search nil) | |
6144 (filename (concat (file-name-sans-extension (buffer-file-name)) | |
6145 ".txt")) | |
6146 (buffer (find-file-noselect filename)) | |
6147 (levels-open (make-vector org-level-max nil)) | |
6148 (date (format-time-string "%Y/%m/%d" (current-time))) | |
6149 (time (format-time-string "%X" (current-time))) | |
6150 (author user-full-name) | |
6151 (title (buffer-name)) | |
6152 (options nil) | |
6153 (email user-mail-address) | |
6154 (language org-export-default-language) | |
6155 (text nil) | |
6156 (last-level 1) | |
6157 (todo nil) | |
6158 (lang-words nil)) | |
6159 | |
6160 (org-init-section-numbers) | |
6161 | |
6162 (find-file-noselect filename) | |
6163 | |
6164 ;; Search for the export key lines | |
6165 (org-parse-key-lines) | |
6166 | |
6167 (setq lang-words (or (assoc language org-export-language-setup) | |
6168 (assoc "en" org-export-language-setup))) | |
6169 (if org-export-ascii-show-new-buffer | |
6170 (switch-to-buffer-other-window buffer) | |
6171 (set-buffer buffer)) | |
6172 (erase-buffer) | |
6173 (fundamental-mode) | |
6174 (if options (org-parse-export-options options)) | |
6175 (setq umax (if arg (prefix-numeric-value arg) | |
6176 org-export-headline-levels)) | |
6177 | |
6178 ;; File header | |
6179 (if title (org-insert-centered title ?=)) | |
6180 (insert "\n") | |
6181 (if (or author email) | |
6182 (insert (concat (nth 1 lang-words) ": " (or author "") | |
6183 (if email (concat " <" email ">") "") | |
6184 "\n"))) | |
6185 (if (and date time) | |
6186 (insert (concat (nth 2 lang-words) ": " date " " time "\n"))) | |
6187 (if text (insert (concat (org-html-expand-for-ascii text) "\n\n"))) | |
6188 | |
6189 (insert "\n\n") | |
6190 | |
6191 (if org-export-with-toc | |
6192 (progn | |
6193 (insert (nth 3 lang-words) "\n" | |
6194 (make-string (length (nth 3 lang-words)) ?=) "\n") | |
6195 (mapcar '(lambda (line) | |
6196 (if (string-match org-todo-line-regexp | |
6197 line) | |
6198 ;; This is a headline | |
6199 (progn | |
6200 (setq level (- (match-end 1) (match-beginning 1)) | |
6201 txt (match-string 3 line) | |
6202 todo | |
6203 (or (and (match-beginning 2) | |
6204 (not (equal (match-string 2 line) | |
6205 org-done-string))) | |
6206 ; TODO, not DONE | |
6207 (and (= level umax) | |
6208 (org-search-todo-below | |
6209 line lines level)))) | |
6210 (setq txt (org-html-expand-for-ascii txt)) | |
6211 | |
6212 (if org-export-with-section-numbers | |
6213 (setq txt (concat (org-section-number level) | |
6214 " " txt))) | |
6215 (if (<= level umax) | |
6216 (progn | |
6217 (insert | |
6218 (make-string (* (1- level) 4) ?\ ) | |
6219 (format (if todo "%s (*)\n" "%s\n") txt)) | |
6220 (setq last-level level)) | |
6221 )))) | |
6222 lines))) | |
6223 | |
6224 (org-init-section-numbers) | |
6225 (while (setq line (pop lines)) | |
6226 ;; Remove the quoted HTML tags. | |
6227 (setq line (org-html-expand-for-ascii line)) | |
6228 (cond | |
6229 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) | |
6230 ;; a Headline | |
6231 (setq level (- (match-end 1) (match-beginning 1)) | |
6232 txt (match-string 2 line)) | |
6233 (org-ascii-level-start level txt umax)) | |
6234 (t (insert line "\n")))) | |
6235 (normal-mode) | |
6236 (save-buffer) | |
6237 (goto-char (point-min)))) | |
6238 | |
6239 (defun org-search-todo-below (line lines level) | |
6240 "Search the subtree below LINE for any TODO entries." | |
6241 (let ((rest (cdr (memq line lines))) | |
6242 (re org-todo-line-regexp) | |
6243 line lv todo) | |
6244 (catch 'exit | |
6245 (while (setq line (pop rest)) | |
6246 (if (string-match re line) | |
6247 (progn | |
6248 (setq lv (- (match-end 1) (match-beginning 1)) | |
6249 todo (and (match-beginning 2) | |
6250 (not (equal (match-string 2 line) | |
6251 org-done-string)))) | |
6252 ; TODO, not DONE | |
6253 (if (<= lv level) (throw 'exit nil)) | |
6254 (if todo (throw 'exit t)))))))) | |
6255 | |
6256 ;; FIXME: Try to handle <b> and <i> as faces via text properties. | |
6257 ;; FIXME: Can I implement *bold*,/italic/ and _underline_ for AXCII export? | |
6258 (defun org-html-expand-for-ascii (line) | |
6259 "Handle quoted HTML for ASCII export." | |
6260 (if org-export-html-expand | |
6261 (while (string-match "@<[^<>\n]*>" line) | |
6262 ;; We just remove the tags for now. | |
6263 (setq line (replace-match "" nil nil line)))) | |
6264 line) | |
6265 | |
6266 (defun org-insert-centered (s &optional underline) | |
6267 "Insert the string S centered and underline it with character UNDERLINE." | |
6268 (let ((ind (max (/ (- 80 (length s)) 2) 0))) | |
6269 (insert (make-string ind ?\ ) s "\n") | |
6270 (if underline | |
6271 (insert (make-string ind ?\ ) | |
6272 (make-string (length s) underline) | |
6273 "\n")))) | |
6274 | |
6275 (defun org-ascii-level-start (level title umax) | |
6276 "Insert a new level in ASCII export." | |
6277 (let (char) | |
6278 (if (> level umax) | |
6279 (insert (make-string (* 2 (- level umax 1)) ?\ ) "* " title "\n") | |
6280 (if (or (not (equal (char-before) ?\n)) | |
6281 (not (equal (char-before (1- (point))) ?\n))) | |
6282 (insert "\n")) | |
6283 (setq char (nth (- umax level) (reverse org-ascii-underline))) | |
6284 (if org-export-with-section-numbers | |
6285 (setq title (concat (org-section-number level) " " title))) | |
6286 (insert title "\n" (make-string (length title) char) "\n")))) | |
6287 | |
6288 ;; HTML | |
6289 | |
6290 (defun org-get-current-options () | |
6291 "Return a string with current options as keyword options. | |
6292 Does include HTML export options as well as TODO and CATEGORY stuff." | |
6293 (format | |
6294 "#+TITLE: %s | |
6295 #+AUTHOR: %s | |
6296 #+EMAIL: %s | |
6297 #+LANGUAGE: %s | |
6298 #+TEXT: Some descriptive text to be emitted. Several lines OK. | |
6299 #+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s *:%s TeX:%s | |
6300 #+CATEGORY: %s | |
6301 #+SEQ_TODO: %s | |
6302 #+TYP_TODO: %s | |
6303 " | |
6304 (buffer-name) (user-full-name) user-mail-address org-export-default-language | |
6305 org-export-headline-levels | |
6306 org-export-with-section-numbers | |
6307 org-export-with-toc | |
6308 org-export-preserve-breaks | |
6309 org-export-html-expand | |
6310 org-export-with-fixed-width | |
6311 org-export-with-tables | |
6312 org-export-with-sub-superscripts | |
6313 org-export-with-emphasize | |
6314 org-export-with-TeX-macros | |
6315 (file-name-nondirectory (buffer-file-name)) | |
6316 (if (equal org-todo-interpretation 'sequence) | |
6317 (mapconcat 'identity org-todo-keywords " ") | |
6318 "TODO FEEDBACK VERIFY DONE") | |
6319 (if (equal org-todo-interpretation 'type) | |
6320 (mapconcat 'identity org-todo-keywords " ") | |
6321 "Me Jason Marie DONE"))) | |
6322 | |
6323 (defun org-insert-export-options-template () | |
6324 "Insert into the buffer a template with information for exporting." | |
6325 (interactive) | |
6326 (if (not (bolp)) (newline)) | |
6327 (let ((s (org-get-current-options))) | |
6328 (and (string-match "#\\+CATEGORY" s) | |
6329 (setq s (substring s 0 (match-beginning 0)))) | |
6330 (insert s))) | |
6331 | |
6332 (defun org-toggle-fixed-width-section (arg) | |
6333 "Toggle the fixed-width indicator at the beginning of lines in the region. | |
6334 If there is no active region, only acts on the current line. | |
6335 If the first non-white character in the first line of the region is a | |
6336 vertical bar \"|\", then the command removes the bar from all lines in | |
6337 the region. If the first character is not a bar, the command adds a | |
6338 bar to all lines, in the column given by the beginning of the region. | |
6339 | |
6340 If there is a numerical prefix ARG, create ARG new lines starting with \"|\"." | |
6341 (interactive "P") | |
6342 (let* ((cc 0) | |
6343 (regionp (org-region-active-p)) | |
6344 (beg (if regionp (region-beginning) (point))) | |
6345 (end (if regionp (region-end))) | |
6346 (nlines (or arg (if (and beg end) (count-lines beg end) 1))) | |
6347 (re "[ \t]*\\(:\\)") | |
6348 off) | |
6349 (save-excursion | |
6350 (goto-char beg) | |
6351 (setq cc (current-column)) | |
6352 (beginning-of-line 1) | |
6353 (setq off (looking-at re)) | |
6354 (while (> nlines 0) | |
6355 (setq nlines (1- nlines)) | |
6356 (beginning-of-line 1) | |
6357 (cond | |
6358 (arg | |
6359 (move-to-column cc t) | |
6360 (insert ":\n") | |
6361 (forward-line -1)) | |
6362 ((and off (looking-at re)) | |
6363 (replace-match "" t t nil 1)) | |
6364 ((not off) (move-to-column cc t) (insert ":"))) | |
6365 (forward-line 1))))) | |
6366 | |
6367 (defun org-export-as-html-and-open (arg) | |
6368 "Export the outline as HTML and immediately open it with a browser. | |
6369 If there is an active region, export only the region. | |
6370 The prefix ARG specifies how many levels of the outline should become | |
6371 headlines. The default is 3. Lower levels will become bulleted lists." | |
6372 (interactive "P") | |
6373 (org-export-as-html arg 'hidden) | |
6374 (org-open-file (buffer-file-name))) | |
6375 | |
6376 (defun org-export-as-html-batch () | |
6377 "Call org-export-as-html, may be used in batch processing as | |
6378 emacs --batch | |
6379 --load=$HOME/lib/emacs/org.el | |
6380 --eval \"(setq org-export-headline-levels 2)\" | |
6381 --visit=MyFile --funcall org-export-as-html-batch" | |
6382 (org-export-as-html org-export-headline-levels 'hidden)) | |
6383 | |
6384 (defun org-export-as-html (arg &optional hidden) | |
6385 "Export the outline as a pretty HTML file. | |
6386 If there is an active region, export only the region. | |
6387 The prefix ARG specifies how many levels of the outline should become | |
6388 headlines. The default is 3. Lower levels will become bulleted lists." | |
6389 (interactive "P") | |
6390 (setq-default org-todo-line-regexp org-todo-line-regexp) | |
6391 (setq-default org-deadline-line-regexp org-deadline-line-regexp) | |
6392 (setq-default org-done-string org-done-string) | |
6393 (let* ((region-p (org-region-active-p)) | |
6394 (region | |
6395 (buffer-substring | |
6396 (if region-p (region-beginning) (point-min)) | |
6397 (if region-p (region-end) (point-max)))) | |
6398 (all_lines | |
6399 (org-skip-comments (org-split-string region "[\r\n]"))) | |
6400 (lines (org-export-find-first-heading-line all_lines)) | |
6401 (level 0) (line "") (origline "") txt todo | |
6402 (last-level 1) | |
6403 (umax nil) | |
6404 (filename (concat (file-name-sans-extension (buffer-file-name)) | |
6405 ".html")) | |
6406 (buffer (find-file-noselect filename)) | |
6407 (levels-open (make-vector org-level-max nil)) | |
6408 (date (format-time-string "%Y/%m/%d" (current-time))) | |
6409 (time (format-time-string "%X" (current-time))) | |
6410 (author user-full-name) | |
6411 (title (buffer-name)) | |
6412 (options nil) | |
6413 (email user-mail-address) | |
6414 (language org-export-default-language) | |
6415 (text nil) | |
6416 (lang-words nil) | |
6417 (head-count 0) cnt | |
6418 table-open type | |
6419 table-buffer table-orig-buffer | |
6420 ) | |
6421 (message "Exporting...") | |
6422 | |
6423 (org-init-section-numbers) | |
6424 | |
6425 ;; Search for the export key lines | |
6426 (org-parse-key-lines) | |
6427 (setq lang-words (or (assoc language org-export-language-setup) | |
6428 (assoc "en" org-export-language-setup))) | |
6429 | |
6430 ;; Switch to the output buffer | |
6431 (if (or hidden (not org-export-html-show-new-buffer)) | |
6432 (set-buffer buffer) | |
6433 (switch-to-buffer-other-window buffer)) | |
6434 (erase-buffer) | |
6435 (fundamental-mode) | |
6436 (let ((case-fold-search nil)) | |
6437 (if options (org-parse-export-options options)) | |
6438 (setq umax (if arg (prefix-numeric-value arg) | |
6439 org-export-headline-levels)) | |
6440 | |
6441 ;; File header | |
6442 (insert (format | |
6443 "<html lang=\"%s\"><head> | |
6444 <title>%s</title> | |
6445 <meta http-equiv=\"Content-Type\" content=\"text/html\"> | |
6446 <meta name=generator content=\"Org-mode\"> | |
6447 <meta name=generated content=\"%s %s\"> | |
6448 <meta name=author content=\"%s\"> | |
6449 </head><body> | |
6450 " | |
6451 language (org-html-expand title) date time author)) | |
6452 (if title (insert (concat "<H1 align=\"center\">" | |
6453 (org-html-expand title) "</H1>\n"))) | |
6454 (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) | |
6455 (if email (insert (concat "<a href=\"mailto:" email "\"><" | |
6456 email "></a>\n"))) | |
6457 (if (or author email) (insert "<br>\n")) | |
6458 (if (and date time) (insert (concat (nth 2 lang-words) ": " | |
6459 date " " time "<br>\n"))) | |
6460 (if text (insert (concat "<p>\n" (org-html-expand text)))) | |
6461 (if org-export-with-toc | |
6462 (progn | |
6463 (insert (format "<H2>%s</H2>\n" (nth 3 lang-words))) | |
6464 (insert "<ul>\n") | |
6465 (mapcar '(lambda (line) | |
6466 (if (string-match org-todo-line-regexp line) | |
6467 ;; This is a headline | |
6468 (progn | |
6469 (setq level (- (match-end 1) (match-beginning 1)) | |
6470 txt (save-match-data | |
6471 (org-html-expand | |
6472 (match-string 3 line))) | |
6473 todo | |
6474 (or (and (match-beginning 2) | |
6475 (not (equal (match-string 2 line) | |
6476 org-done-string))) | |
6477 ; TODO, not DONE | |
6478 (and (= level umax) | |
6479 (org-search-todo-below | |
6480 line lines level)))) | |
6481 (if org-export-with-section-numbers | |
6482 (setq txt (concat (org-section-number level) | |
6483 " " txt))) | |
6484 (if (<= level umax) | |
6485 (progn | |
6486 (setq head-count (+ head-count 1)) | |
6487 (if (> level last-level) | |
6488 (progn | |
6489 (setq cnt (- level last-level)) | |
6490 (while (>= (setq cnt (1- cnt)) 0) | |
6491 (insert "<ul>")) | |
6492 (insert "\n"))) | |
6493 (if (< level last-level) | |
6494 (progn | |
6495 (setq cnt (- last-level level)) | |
6496 (while (>= (setq cnt (1- cnt)) 0) | |
6497 (insert "</ul>")) | |
6498 (insert "\n"))) | |
6499 (insert | |
6500 (format | |
6501 (if todo | |
6502 "<li><a href=\"#sec-%d\"><span style='color:red'>%s</span></a></li>\n" | |
6503 "<li><a href=\"#sec-%d\">%s</a></li>\n") | |
6504 head-count txt)) | |
6505 (setq last-level level)) | |
6506 )))) | |
6507 lines) | |
6508 (while (> last-level 0) | |
6509 (setq last-level (1- last-level)) | |
6510 (insert "</ul>\n")) | |
6511 )) | |
6512 (setq head-count 0) | |
6513 (org-init-section-numbers) | |
6514 | |
6515 (while (setq line (pop lines) origline line) | |
6516 ;; replace "<" and ">" by "<" and ">" | |
6517 ;; handle @<..> HTML tags (replace "@>..<" by "<..>") | |
6518 (setq line (org-html-expand line)) | |
6519 | |
6520 ;; Verbatim lines | |
6521 (if (and org-export-with-fixed-width | |
6522 (string-match "^[ \t]*:\\(.*\\)" line)) | |
6523 (progn | |
6524 (let ((l (match-string 1 line))) | |
6525 (while (string-match " " l) | |
6526 (setq l (replace-match " " t t l))) | |
6527 (insert "\n<span style='font-family:Courier'>" | |
6528 l "</span>" | |
6529 (if (and lines | |
6530 (not (string-match "^[ \t]+\\(:.*\\)" | |
6531 (car lines)))) | |
6532 "<br>\n" "\n")))) | |
6533 | |
6534 (when (string-match org-link-regexp line) | |
6535 (setq type (match-string 1 line)) | |
6536 (cond | |
6537 ((member type '("http" "https" "ftp" "mailto" "news")) | |
6538 ;; standard URL | |
6539 (setq line (replace-match | |
6540 "<a href=\"\\1:\\2\"><\\1:\\2></a>" | |
6541 nil nil line))) | |
6542 ((string= type "file") | |
6543 ;; FILE link | |
6544 | |
6545 (let* ((filename (match-string 2 line)) | |
6546 (file-is-image-p | |
6547 (save-match-data | |
6548 (string-match (org-image-file-name-regexp) filename)))) | |
6549 (setq line (replace-match | |
6550 (if (and org-export-html-inline-images | |
6551 file-is-image-p) | |
6552 "<img src=\"\\2\"/>" | |
6553 "<a href=\"\\2\">\\1:\\2</a>") | |
6554 nil nil line)))) | |
6555 | |
6556 ((member type '("bbdb" "vm" "wl" "rmail" "gnus" "shell")) | |
6557 (setq line (replace-match | |
6558 "<i><\\1:\\2></i>" nil nil line))))) | |
6559 | |
6560 ;; TODO items | |
6561 (if (and (string-match org-todo-line-regexp line) | |
6562 (match-beginning 2)) | |
6563 (if (equal (match-string 2 line) org-done-string) | |
6564 (setq line (replace-match | |
6565 "<span style='color:green'>\\2</span>" | |
6566 nil nil line 2)) | |
6567 (setq line (replace-match "<span style='color:red'>\\2</span>" | |
6568 nil nil line 2)))) | |
6569 | |
6570 ;; DEADLINES | |
6571 (if (string-match org-deadline-line-regexp line) | |
6572 (progn | |
6573 (if (save-match-data | |
6574 (string-match "<a href" | |
6575 (substring line 0 (match-beginning 0)))) | |
6576 nil ; Don't do the replacement - it is inside a link | |
6577 (setq line (replace-match "<span style='color:red'>\\&</span>" | |
6578 nil nil line 1))))) | |
6579 | |
6580 (cond | |
6581 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) | |
6582 ;; This is a headline | |
6583 (setq level (- (match-end 1) (match-beginning 1)) | |
6584 txt (match-string 2 line)) | |
6585 (if (<= level umax) (setq head-count (+ head-count 1))) | |
6586 (org-html-level-start level txt umax | |
6587 (and org-export-with-toc (<= level umax)) | |
6588 head-count)) | |
6589 | |
6590 ((and org-export-with-tables | |
6591 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) | |
6592 (if (not table-open) | |
6593 ;; New table starts | |
6594 (setq table-open t table-buffer nil table-orig-buffer nil)) | |
6595 ;; Accumulate lines | |
6596 (setq table-buffer (cons line table-buffer) | |
6597 table-orig-buffer (cons origline table-orig-buffer)) | |
6598 (when (or (not lines) | |
6599 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" | |
6600 (car lines)))) | |
6601 (setq table-open nil | |
6602 table-buffer (nreverse table-buffer) | |
6603 table-orig-buffer (nreverse table-orig-buffer)) | |
6604 (insert (org-format-table-html table-buffer table-orig-buffer)))) | |
6605 (t | |
6606 ;; Normal lines | |
6607 ;; Lines starting with "-", and empty lines make new paragraph. | |
6608 (if (string-match "^ *-\\|^[ \t]*$" line) (insert "<p>")) | |
6609 (insert line (if org-export-preserve-breaks "<br>\n" "\n")))) | |
6610 )) | |
6611 (if org-export-html-with-timestamp | |
6612 (insert org-export-html-html-helper-timestamp)) | |
6613 (insert "</body>\n</html>\n") | |
6614 (normal-mode) | |
6615 (save-buffer) | |
6616 (goto-char (point-min))))) | |
6617 | |
6618 (defun org-format-table-html (lines olines) | |
6619 "Find out which HTML converter to use and return the HTML code." | |
6620 (if (string-match "^[ \t]*|" (car lines)) | |
6621 ;; A normal org table | |
6622 (org-format-org-table-html lines) | |
6623 ;; Table made by table.el - test for spanning | |
6624 (let* ((hlines (delq nil (mapcar | |
6625 (lambda (x) | |
6626 (if (string-match "^[ \t]*\\+-" x) x | |
6627 nil)) | |
6628 lines))) | |
6629 (first (car hlines)) | |
6630 (ll (and (string-match "\\S-+" first) | |
6631 (match-string 0 first))) | |
6632 (re (concat "^[ \t]*" (regexp-quote ll))) | |
6633 (spanning (delq nil (mapcar (lambda (x) (not (string-match re x))) | |
6634 hlines)))) | |
6635 (if (and (not spanning) | |
6636 (not org-export-prefer-native-exporter-for-tables)) | |
6637 ;; We can use my own converter with HTML conversions | |
6638 (org-format-table-table-html lines) | |
6639 ;; Need to use the code generator in table.el, with the original text. | |
6640 (org-format-table-table-html-using-table-generate-source olines))))) | |
6641 | |
6642 (defun org-format-org-table-html (lines) | |
6643 "Format a table into html." | |
6644 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) | |
6645 (setq lines (nreverse lines)) | |
6646 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) | |
6647 (setq lines (nreverse lines)) | |
6648 (let ((head (and org-export-highlight-first-table-line | |
6649 (delq nil (mapcar | |
6650 (lambda (x) (string-match "^[ \t]*|-" x)) | |
6651 lines)))) | |
6652 lastline line fields html empty) | |
6653 (setq html (concat org-export-html-table-tag "\n")) | |
6654 (while (setq lastline line | |
6655 line (pop lines)) | |
6656 (setq empty " ") | |
6657 (catch 'next-line | |
6658 (if (string-match "^[ \t]*|-" line) | |
6659 (if lastline | |
6660 ;; A hline: simulate an empty table row instead. | |
6661 (setq line (org-fake-empty-table-line lastline) | |
6662 head nil | |
6663 empty "") | |
6664 ;; Ignore this line | |
6665 (throw 'next-line t))) | |
6666 ;; Break the line into fields | |
6667 (setq fields (org-split-string line "[ \t]*|[ \t]*")) | |
6668 (setq html (concat | |
6669 html | |
6670 "<tr>" | |
6671 (mapconcat (lambda (x) | |
6672 (if (equal x "") (setq x empty)) | |
6673 (if head | |
6674 (concat "<th>" x "</th>") | |
6675 (concat "<td valign=\"top\">" x "</td>"))) | |
6676 fields "") | |
6677 "</tr>\n")))) | |
6678 (setq html (concat html "</table>\n")) | |
6679 html)) | |
6680 | |
6681 (defun org-fake-empty-table-line (line) | |
6682 "Replace everything except \"|\" with spaces." | |
6683 (let ((i (length line)) | |
6684 (newstr (copy-sequence line))) | |
6685 (while (> i 0) | |
6686 (setq i (1- i)) | |
6687 (if (not (eq (aref newstr i) ?|)) | |
6688 (aset newstr i ?\ ))) | |
6689 newstr)) | |
6690 | |
6691 (defun org-format-table-table-html (lines) | |
6692 "Format a table generated by table.el into html. | |
6693 This conversion does *not* use `table-generate-source' from table.el. | |
6694 This has the advantage that Org-mode's HTML conversions can be used. | |
6695 But it has the disadvantage, that no cell- or row-spanning is allowed." | |
6696 (let (line field-buffer | |
6697 (head org-export-highlight-first-table-line) | |
6698 fields html empty) | |
6699 (setq html (concat org-export-html-table-tag "\n")) | |
6700 (while (setq line (pop lines)) | |
6701 (setq empty " ") | |
6702 (catch 'next-line | |
6703 (if (string-match "^[ \t]*\\+-" line) | |
6704 (progn | |
6705 (if field-buffer | |
6706 (progn | |
6707 (setq html (concat | |
6708 html | |
6709 "<tr>" | |
6710 (mapconcat | |
6711 (lambda (x) | |
6712 (if (equal x "") (setq x empty)) | |
6713 (if head | |
6714 (concat "<th valign=\"top\">" x | |
6715 "</th>\n") | |
6716 (concat "<td valign=\"top\">" x | |
6717 "</td>\n"))) | |
6718 field-buffer "\n") | |
6719 "</tr>\n")) | |
6720 (setq head nil) | |
6721 (setq field-buffer nil))) | |
6722 ;; Ignore this line | |
6723 (throw 'next-line t))) | |
6724 ;; Break the line into fields and store the fields | |
6725 (setq fields (org-split-string line "[ \t]*|[ \t]*")) | |
6726 (if field-buffer | |
6727 (setq field-buffer (mapcar | |
6728 (lambda (x) | |
6729 (concat x "<br>" (pop fields))) | |
6730 field-buffer)) | |
6731 (setq field-buffer fields)))) | |
6732 (setq html (concat html "</table>\n")) | |
6733 html)) | |
6734 | |
6735 (defun org-format-table-table-html-using-table-generate-source (lines) | |
6736 "Format a table into html, using `table-generate-source' from table.el. | |
6737 This has the advantage that cell- or row-spanning is allowed. | |
6738 But it has the disadvantage, that Org-mode's HTML conversions cannot be used." | |
6739 (require 'table) | |
6740 (save-excursion | |
6741 (set-buffer (get-buffer-create " org-tmp1 ")) | |
6742 (erase-buffer) | |
6743 (insert (mapconcat 'identity lines "\n")) | |
6744 (goto-char (point-min)) | |
6745 (if (not (re-search-forward "|[^+]" nil t)) | |
6746 (error "Error processing table.")) | |
6747 (table-recognize-table) | |
6748 (save-excursion | |
6749 (set-buffer (get-buffer-create " org-tmp2 ")) | |
6750 (erase-buffer)) | |
6751 (table-generate-source 'html " org-tmp2 ") | |
6752 (set-buffer " org-tmp2 ") | |
6753 (buffer-substring (point-min) (point-max)))) | |
6754 | |
6755 (defun org-html-expand (string) | |
6756 "Prepare STRING for HTML export. Applies all active conversions." | |
6757 ;; First check if there is a link in the line - if yes, apply conversions | |
6758 ;; only before the start of the link. | |
6759 (let* ((m (string-match org-link-regexp string)) | |
6760 (s (if m (substring string 0 m) string)) | |
6761 (r (if m (substring string m) ""))) | |
6762 ;; convert < to < and > to > | |
6763 (while (string-match "<" s) | |
6764 (setq s (replace-match "<" nil nil s))) | |
6765 (while (string-match ">" s) | |
6766 (setq s (replace-match ">" nil nil s))) | |
6767 (if org-export-html-expand | |
6768 (while (string-match "@<\\([^&]*\\)>" s) | |
6769 (setq s (replace-match "<\\1>" nil nil s)))) | |
6770 (if org-export-with-emphasize | |
6771 (setq s (org-export-html-convert-emphasize s))) | |
6772 (if org-export-with-sub-superscripts | |
6773 (setq s (org-export-html-convert-sub-super s))) | |
6774 (if org-export-with-TeX-macros | |
6775 (let ((start 0) wd ass) | |
6776 (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start)) | |
6777 (setq wd (match-string 1 s)) | |
6778 (if (setq ass (assoc wd org-html-entities)) | |
6779 (setq s (replace-match (or (cdr ass) | |
6780 (concat "&" (car ass) ";")) | |
6781 t t s)) | |
6782 (setq start (+ start (length wd))))))) | |
6783 (concat s r))) | |
6784 | |
6785 (defun org-create-multibrace-regexp (left right n) | |
6786 "Create a regular expression which will match a balanced sexp. | |
6787 Opening delimiter is LEFT, and closing delimiter is RIGHT, both given | |
6788 as single character strings. | |
6789 The regexp returned will match the entire expression including the | |
6790 delimiters. It will also define a single group which contains the | |
6791 match except for the outermost delimiters. The maximum depth of | |
6792 stacked delimiters is N. Escaping delimiters is not possible." | |
6793 (let* ((nothing (concat "[^" "\\" left "\\" right "]*?")) | |
6794 (or "\\|") | |
6795 (re nothing) | |
6796 (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) | |
6797 (while (> n 1) | |
6798 (setq n (1- n) | |
6799 re (concat re or next) | |
6800 next (concat "\\(?:" nothing left next right "\\)+" nothing))) | |
6801 (concat left "\\(" re "\\)" right))) | |
6802 | |
6803 (defvar org-match-substring-regexp | |
6804 (concat | |
6805 "\\([^\\]\\)\\([_^]\\)\\(" | |
6806 "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" | |
6807 "\\|" | |
6808 "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" | |
6809 "\\|" | |
6810 "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") | |
6811 "The regular expression matching a sub- or superscript.") | |
6812 | |
6813 (defun org-export-html-convert-sub-super (string) | |
6814 "Convert sub- and superscripts in STRING to HTML." | |
6815 (let (key c) | |
6816 (while (string-match org-match-substring-regexp string) | |
6817 (setq key (if (string= (match-string 2 string) "_") "sub" "sup")) | |
6818 (setq c (or (match-string 8 string) | |
6819 (match-string 6 string) | |
6820 (match-string 5 string))) | |
6821 (setq string (replace-match | |
6822 (concat (match-string 1 string) | |
6823 "<" key ">" c "</" key ">") | |
6824 t t string))) | |
6825 (while (string-match "\\\\\\([_^]\\)" string) | |
6826 (setq string (replace-match (match-string 1 string) t t string)))) | |
6827 string) | |
6828 | |
6829 (defun org-export-html-convert-emphasize (string) | |
6830 (while (string-match | |
6831 "\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" | |
6832 string) | |
6833 (setq string (replace-match | |
6834 (concat "<b>" (match-string 3 string) "</b>") | |
6835 t t string 2))) | |
6836 (while (string-match | |
6837 "\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" | |
6838 string) | |
6839 (setq string (replace-match | |
6840 (concat "<i>" (match-string 3 string) "</i>") | |
6841 t t string 2))) | |
6842 (while (string-match | |
6843 "\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" | |
6844 string) | |
6845 (setq string (replace-match | |
6846 (concat "<u>" (match-string 3 string) "</u>") | |
6847 t t string 2))) | |
6848 string) | |
6849 | |
6850 (defun org-parse-key-lines () | |
6851 "Find the special key lines with the information for exporters." | |
6852 (save-excursion | |
6853 (goto-char 0) | |
6854 (let ((re (org-make-options-regexp | |
6855 '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) | |
6856 key) | |
6857 (while (re-search-forward re nil t) | |
6858 (setq key (match-string 1)) | |
6859 (cond ((string-equal key "TITLE") | |
6860 (setq title (match-string 2))) | |
6861 ((string-equal key "AUTHOR") | |
6862 (setq author (match-string 2))) | |
6863 ((string-equal key "EMAIL") | |
6864 (setq email (match-string 2))) | |
6865 ((string-equal key "LANGUAGE") | |
6866 (setq language (match-string 2))) | |
6867 ((string-equal key "TEXT") | |
6868 (setq text (concat text "\n" (match-string 2)))) | |
6869 ((string-equal key "OPTIONS") | |
6870 (setq options (match-string 2)))))))) | |
6871 | |
6872 (defun org-parse-export-options (s) | |
6873 "Parse the export options line." | |
6874 (let ((op '(("H" . org-export-headline-levels) | |
6875 ("num" . org-export-with-section-numbers) | |
6876 ("toc" . org-export-with-toc) | |
6877 ("\\n" . org-export-preserve-breaks) | |
6878 ("@" . org-export-html-expand) | |
6879 (":" . org-export-with-fixed-width) | |
6880 ("|" . org-export-with-tables) | |
6881 ("^" . org-export-with-sub-superscripts) | |
6882 ("*" . org-export-with-emphasize) | |
6883 ("TeX" . org-export-with-TeX-macros))) | |
6884 o) | |
6885 (while (setq o (pop op)) | |
6886 (if (string-match (concat (regexp-quote (car o)) ":\\([^ \t\n\r;,.]*\\)") | |
6887 s) | |
6888 (set (make-local-variable (cdr o)) | |
6889 (car (read-from-string (match-string 1 s)))))))) | |
6890 | |
6891 (defun org-html-level-start (level title umax with-toc head-count) | |
6892 "Insert a new level in HTML export." | |
6893 (let ((l (1+ (max level umax)))) | |
6894 (while (<= l org-level-max) | |
6895 (if (aref levels-open (1- l)) | |
6896 (progn | |
6897 (org-html-level-close l) | |
6898 (aset levels-open (1- l) nil))) | |
6899 (setq l (1+ l))) | |
6900 (if (> level umax) | |
6901 (progn | |
6902 (if (aref levels-open (1- level)) | |
6903 (insert "<li>" title "<p>\n") | |
6904 (aset levels-open (1- level) t) | |
6905 (insert "<ul><li>" title "<p>\n"))) | |
6906 (if org-export-with-section-numbers | |
6907 (setq title (concat (org-section-number level) " " title))) | |
6908 (setq level (+ level 1)) | |
6909 (if with-toc | |
6910 (insert (format "\n<H%d><a name=\"sec-%d\">%s</a></H%d>\n" | |
6911 level head-count title level)) | |
6912 (insert (format "\n<H%d>%s</H%d>\n" level title level)))))) | |
6913 | |
6914 (defun org-html-level-close (level) | |
6915 "Terminate one level in HTML export." | |
6916 (insert "</ul>")) | |
6917 | |
6918 | |
6919 ;; Variable holding the vector with section numbers | |
6920 (defvar org-section-numbers (make-vector org-level-max 0)) | |
6921 | |
6922 (defun org-init-section-numbers () | |
6923 "Initialize the vector for the section numbers." | |
6924 (let* ((level -1) | |
6925 (numbers (nreverse (org-split-string "" "\\."))) | |
6926 (depth (1- (length org-section-numbers))) | |
6927 (i depth) number-string) | |
6928 (while (>= i 0) | |
6929 (if (> i level) | |
6930 (aset org-section-numbers i 0) | |
6931 (setq number-string (or (car numbers) "0")) | |
6932 (if (string-match "\\`[A-Z]\\'" number-string) | |
6933 (aset org-section-numbers i | |
6934 (- (string-to-char number-string) ?A -1)) | |
6935 (aset org-section-numbers i (string-to-int number-string))) | |
6936 (pop numbers)) | |
6937 (setq i (1- i))))) | |
6938 | |
6939 (defun org-section-number (&optional level) | |
6940 "Return a string with the current section number. | |
6941 When LEVEL is non-nil, increase section numbers on that level." | |
6942 (let* ((depth (1- (length org-section-numbers))) idx n (string "")) | |
6943 (when level | |
6944 (when (> level -1) | |
6945 (aset org-section-numbers | |
6946 level (1+ (aref org-section-numbers level)))) | |
6947 (setq idx (1+ level)) | |
6948 (while (<= idx depth) | |
6949 (if (not (= idx 1)) | |
6950 (aset org-section-numbers idx 0)) | |
6951 (setq idx (1+ idx)))) | |
6952 (setq idx 0) | |
6953 (while (<= idx depth) | |
6954 (setq n (aref org-section-numbers idx)) | |
6955 (setq string (concat string (if (not (string= string "")) "." "") | |
6956 (int-to-string n))) | |
6957 (setq idx (1+ idx))) | |
6958 (save-match-data | |
6959 (if (string-match "\\`\\([@0]\\.\\)+" string) | |
6960 (setq string (replace-match "" nil nil string))) | |
6961 (if (string-match "\\(\\.0\\)+\\'" string) | |
6962 (setq string (replace-match "" nil nil string)))) | |
6963 string)) | |
6964 | |
6965 | |
6966 ;;; Key bindings | |
6967 | |
6968 ;; - Bindings in Org-mode map are currently | |
6969 ;; 0123456789abcdefghijklmnopqrstuvwxyz!?@#$%^&-+*/=()_{}[]:;"|,.<>~`'\t the alphabet | |
6970 ;; abcd fgh j lmnopqrstuvwxyz ? # -+ /= [] ; |,.<> \t necessary bindings | |
6971 ;; e (?) useful from outline-mode | |
6972 ;; i k @ expendable from outline-mode | |
6973 ;; 0123456789 ! $%^& * ()_{} " ~`' free | |
6974 | |
6975 (define-key org-mode-map [(tab)] 'org-cycle) | |
6976 (define-key org-mode-map "\C-i" 'org-cycle) | |
6977 (define-key org-mode-map [(meta tab)] 'org-complete) | |
6978 (define-key org-mode-map "\M-\C-i" 'org-complete) | |
6979 (define-key org-mode-map [(meta shift left)] 'org-shiftmetaleft) | |
6980 (define-key org-mode-map [(meta left)] 'org-metaleft) | |
6981 (define-key org-mode-map [(meta shift right)] 'org-shiftmetaright) | |
6982 (define-key org-mode-map [(meta shift up)] 'org-shiftmetaup) | |
6983 (define-key org-mode-map [(meta shift down)] 'org-shiftmetadown) | |
6984 (define-key org-mode-map [(meta right)] 'org-metaright) | |
6985 (define-key org-mode-map [(meta up)] 'org-metaup) | |
6986 (define-key org-mode-map [(meta down)] 'org-metadown) | |
6987 ;(define-key org-mode-map "\C-c\C-h\C-w" 'org-cut-subtree) | |
6988 ;(define-key org-mode-map "\C-c\C-h\M-w" 'org-copy-subtree) | |
6989 ;(define-key org-mode-map "\C-c\C-h\C-y" 'org-paste-subtree) | |
6990 (define-key org-mode-map "\C-c\C-h\C-w" 'org-cut-special) | |
6991 (define-key org-mode-map "\C-c\C-h\M-w" 'org-copy-special) | |
6992 (define-key org-mode-map "\C-c\C-h\C-y" 'org-paste-special) | |
6993 (define-key org-mode-map "\C-c\C-j" 'org-goto) | |
6994 (define-key org-mode-map "\C-c\C-t" 'org-todo) | |
6995 (define-key org-mode-map "\C-c\C-s" 'org-schedule) | |
6996 (define-key org-mode-map "\C-c\C-d" 'org-deadline) | |
6997 (define-key org-mode-map "\C-c;" 'org-toggle-comment) | |
6998 (define-key org-mode-map "\C-c\C-v" 'org-show-todo-tree) | |
6999 (define-key org-mode-map "\C-c\C-w" 'org-check-deadlines) | |
7000 (define-key org-mode-map "\C-c/" 'org-occur) ; Minor-mode reserved | |
7001 (define-key org-mode-map "\C-c\C-m" 'org-insert-heading) | |
7002 (define-key org-mode-map "\M-\C-m" 'org-insert-heading) | |
7003 (define-key org-mode-map "\C-c\C-l" 'org-insert-link) | |
7004 (define-key org-mode-map "\C-c\C-o" 'org-open-at-point) | |
7005 (define-key org-mode-map "\C-c\C-z" 'org-time-stamp) ; Alternative binding | |
7006 (define-key org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved | |
7007 (define-key org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved | |
7008 (define-key org-mode-map "\C-c\C-y" 'org-evaluate-time-range) | |
7009 (define-key org-mode-map "\C-c>" 'org-goto-calendar) | |
7010 (define-key org-mode-map "\C-c<" 'org-date-from-calendar) | |
7011 (define-key org-mode-map "\C-c[" 'org-add-file) | |
7012 (define-key org-mode-map "\C-c]" 'org-remove-file) | |
7013 (define-key org-mode-map "\C-c\C-r" 'org-timeline) | |
7014 ;(define-key org-mode-map [(shift up)] 'org-timestamp-up) | |
7015 ;(define-key org-mode-map [(shift down)] 'org-timestamp-down) | |
7016 (define-key org-mode-map [(shift up)] 'org-shiftup) | |
7017 (define-key org-mode-map [(shift down)] 'org-shiftdown) | |
7018 (define-key org-mode-map [(shift left)] 'org-timestamp-down-day) | |
7019 (define-key org-mode-map [(shift right)] 'org-timestamp-up-day) | |
7020 (define-key org-mode-map "\C-c-" 'org-table-insert-hline) | |
7021 ;; The following line is e.g. necessary for German keyboards under Suse Linux | |
7022 (unless org-xemacs-p | |
7023 (define-key org-mode-map [S-iso-lefttab] 'org-shifttab)) | |
7024 (define-key org-mode-map [(shift tab)] 'org-shifttab) | |
7025 (define-key org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) | |
7026 (define-key org-mode-map [(return)] 'org-return) | |
7027 (define-key org-mode-map [(shift return)] 'org-table-copy-from-above) | |
7028 (define-key org-mode-map [(control up)] 'org-move-line-up) | |
7029 (define-key org-mode-map [(control down)] 'org-move-line-down) | |
7030 (define-key org-mode-map "\C-c?" 'org-table-current-column) | |
7031 (define-key org-mode-map "\C-c " 'org-table-blank-field) | |
7032 (define-key org-mode-map "\C-c+" 'org-table-sum) | |
7033 (define-key org-mode-map "\C-c|" 'org-table-toggle-vline-visibility) | |
7034 (define-key org-mode-map "\C-c=" 'org-table-eval-formula) | |
7035 (define-key org-mode-map "\C-c#" 'org-table-create-with-table.el) | |
7036 (define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) | |
7037 (define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii) | |
7038 (define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii) | |
7039 (define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template) | |
7040 (define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section) | |
7041 (define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) | |
7042 (define-key org-mode-map "\C-c\C-x\C-h" 'org-export-as-html-and-open) | |
7043 | |
7044 (defun org-shiftcursor-error () | |
7045 "Throw an error because Shift-Cursor command was applied in wrong context." | |
7046 (error "This command is only active in tables and on headlines.")) | |
7047 | |
7048 (defun org-shifttab () | |
7049 "Call `(org-cycle t)' or `org-table-previous-field'." | |
7050 (interactive) | |
7051 (cond | |
7052 ((org-at-table-p) (org-table-previous-field)) | |
7053 (t (org-cycle '(4))))) | |
7054 | |
7055 (defun org-shiftmetaleft (&optional arg) | |
7056 "Call `org-promote-subtree' or `org-table-delete-column'." | |
7057 (interactive "P") | |
7058 (cond | |
7059 ((org-at-table-p) (org-table-delete-column arg)) | |
7060 ((org-on-heading-p) (org-promote-subtree arg)) | |
7061 (t (org-shiftcursor-error)))) | |
7062 (defun org-shiftmetaright (&optional arg) | |
7063 "Call `org-demote-subtree' or `org-table-insert-column'." | |
7064 (interactive "P") | |
7065 (cond | |
7066 ((org-at-table-p) (org-table-insert-column arg)) | |
7067 ((org-on-heading-p) (org-demote-subtree arg)) | |
7068 (t (org-shiftcursor-error)))) | |
7069 (defun org-shiftmetaup (&optional arg) | |
7070 "Call `org-move-subtree-up' or `org-table-kill-row'." | |
7071 (interactive "P") | |
7072 (cond | |
7073 ((org-at-table-p) (org-table-kill-row arg)) | |
7074 ((org-on-heading-p) (org-move-subtree-up arg)) | |
7075 (t (org-shiftcursor-error)))) | |
7076 (defun org-shiftmetadown (&optional arg) | |
7077 "Call `org-move-subtree-down' or `org-table-insert-row'." | |
7078 (interactive "P") | |
7079 (cond | |
7080 ((org-at-table-p) (org-table-insert-row arg)) | |
7081 ((org-on-heading-p) (org-move-subtree-down arg)) | |
7082 (t (org-shiftcursor-error)))) | |
7083 | |
7084 (defun org-metaleft (&optional arg) | |
7085 "Call `org-do-promote' or `org-table-move-column' to left." | |
7086 (interactive "P") | |
7087 (cond | |
7088 ((org-at-table-p) (org-table-move-column 'left)) | |
7089 ((or (org-on-heading-p) (org-region-active-p)) (org-do-promote arg)) | |
7090 (t (backward-word (prefix-numeric-value arg))))) | |
7091 (defun org-metaright (&optional arg) | |
7092 "Call `org-do-demote' or `org-table-move-column' to right." | |
7093 (interactive "P") | |
7094 (cond | |
7095 ((org-at-table-p) (org-table-move-column nil)) | |
7096 ((or (org-on-heading-p) (org-region-active-p)) (org-do-demote arg)) | |
7097 (t (forward-word (prefix-numeric-value arg))))) | |
7098 (defun org-metaup (&optional arg) | |
7099 "Call `org-move-subtree-up' or `org-table-move-row' up." | |
7100 (interactive "P") | |
7101 (cond | |
7102 ((org-at-table-p) (org-table-move-row 'up)) | |
7103 ((org-on-heading-p) (org-move-subtree-up arg)) | |
7104 (t (org-shiftcursor-error)))) | |
7105 (defun org-metadown (&optional arg) | |
7106 "Call `org-move-subtree-down' or `org-table-move-row' down." | |
7107 (interactive "P") | |
7108 (cond | |
7109 ((org-at-table-p) (org-table-move-row nil)) | |
7110 ((org-on-heading-p) (org-move-subtree-down arg)) | |
7111 (t (org-shiftcursor-error)))) | |
7112 | |
7113 (defun org-shiftup (&optional arg) | |
7114 "Call `org-timestamp-up' or `org-priority-up'." | |
7115 (interactive "P") | |
7116 (cond | |
7117 ((org-at-timestamp-p) (org-timestamp-up arg)) | |
7118 (t (org-priority-up)))) | |
7119 | |
7120 (defun org-shiftdown (&optional arg) | |
7121 "Call `org-timestamp-down' or `org-priority-down'." | |
7122 (interactive "P") | |
7123 (cond | |
7124 ((org-at-timestamp-p) (org-timestamp-down arg)) | |
7125 (t (org-priority-down)))) | |
7126 | |
7127 (defun org-copy-special (arg) | |
7128 "Call either `org-table-copy' or `org-copy-subtree'." | |
7129 (interactive "P") | |
7130 (if (org-at-table-p) | |
7131 (org-table-copy-region arg) | |
7132 (org-copy-subtree arg))) | |
7133 | |
7134 (defun org-cut-special (arg) | |
7135 "Call either `org-table-copy' or `org-copy-subtree'." | |
7136 (interactive "P") | |
7137 (if (org-at-table-p) | |
7138 (org-table-cut-region arg) | |
7139 (org-cut-subtree arg))) | |
7140 | |
7141 (defun org-paste-special (arg) | |
7142 "Call either `org-table-paste-rectangle' or `org-paste-subtree'." | |
7143 (interactive "P") | |
7144 (if (org-at-table-p) | |
7145 (org-table-paste-rectangle arg) | |
7146 (org-paste-subtree arg))) | |
7147 | |
7148 (defun org-ctrl-c-ctrl-c (&optional arg) | |
7149 "Call realign table, or recognize a table.el table. | |
7150 When the cursor is inside a table created by the table.el package, | |
7151 activate that table. Otherwise, if the cursor is at a normal table | |
7152 created with org.el, re-align that table. This command works even if | |
7153 the automatic table editor has been turned off." | |
7154 (interactive "P") | |
7155 (let ((org-enable-table-editor t)) | |
7156 (cond | |
7157 ((org-at-table.el-p) | |
7158 (require 'table) | |
7159 (beginning-of-line 1) | |
7160 (re-search-forward "|" (save-excursion (end-of-line 2) (point))) | |
7161 (table-recognize-table)) | |
7162 ((org-at-table-p) | |
7163 (org-table-align)) | |
7164 ((org-region-active-p) | |
7165 (org-table-convert-region (region-beginning) (region-end) arg)) | |
7166 ((and (region-beginning) (region-end)) | |
7167 (if (y-or-n-p "Convert inactive region to table? ") | |
7168 (org-table-convert-region (region-beginning) (region-end) arg) | |
7169 (error "Abort"))) | |
7170 (t (error "No table at point, and no region to make one."))))) | |
7171 | |
7172 (defun org-return (&optional arg) | |
7173 "Call `org-table-next-row' or `newline'." | |
7174 (interactive "P") | |
7175 (cond | |
7176 ((org-at-table-p) (org-table-next-row)) | |
7177 (t (newline)))) | |
7178 | |
7179 | |
7180 ;;; Menu entries | |
7181 | |
7182 ;; First, remove the outline menus. | |
7183 (if org-xemacs-p | |
7184 (add-hook 'org-mode-hook | |
7185 (lambda () | |
7186 (delete-menu-item '("Headings")) | |
7187 (delete-menu-item '("Show")) | |
7188 (delete-menu-item '("Hide")) | |
7189 (set-menubar-dirty-flag))) | |
7190 (setq org-mode-map (delq (assoc 'menu-bar (cdr org-mode-map)) | |
7191 org-mode-map))) | |
7192 | |
7193 ;; Define the Org-mode menus | |
7194 (easy-menu-define org-org-menu org-mode-map "Org menu" | |
7195 '("Org" | |
7196 ["Cycle Visibility" org-cycle (or (bobp) (outline-on-heading-p))] | |
7197 ["Sparse Tree" org-occur t] | |
7198 ["Show All" show-all t] | |
7199 "--" | |
7200 ["New Heading" org-insert-heading t] | |
7201 ("Navigate Headings" | |
7202 ["Up" outline-up-heading t] | |
7203 ["Next" outline-next-visible-heading t] | |
7204 ["Previous" outline-previous-visible-heading t] | |
7205 ["Next Same Level" outline-forward-same-level t] | |
7206 ["Previous Same Level" outline-backward-same-level t] | |
7207 "--" | |
7208 ["Jump" org-goto t]) | |
7209 ("Edit Structure" | |
7210 ["Move subtree up" org-shiftmetaup (not (org-at-table-p))] | |
7211 ["Move subtree down" org-shiftmetadown (not (org-at-table-p))] | |
7212 "--" | |
7213 ["Copy Subtree" org-copy-special (not (org-at-table-p))] | |
7214 ["Cut Subtree" org-cut-special (not (org-at-table-p))] | |
7215 ["Paste Subtree" org-paste-special (not (org-at-table-p))] | |
7216 "--" | |
7217 ["Promote Heading" org-metaleft (not (org-at-table-p))] | |
7218 ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] | |
7219 ["Demote Heading" org-metaright (not (org-at-table-p))] | |
7220 ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))]) | |
7221 "--" | |
7222 ("TODO lists" | |
7223 ["TODO/DONE/-" org-todo t] | |
7224 ["Show TODO Tree" org-show-todo-tree t] | |
7225 "--" | |
7226 ["Set priority" org-priority t] | |
7227 ["Priority up" org-shiftup t] | |
7228 ["Priority down" org-shiftdown t]) | |
7229 ("Dates and Scheduling" | |
7230 ["Timestamp" org-time-stamp t] | |
7231 ("Change Date" | |
7232 ["1 day later" org-timestamp-up-day t] | |
7233 ["1 day earlier" org-timestamp-down-day t] | |
7234 ["1 ... later" org-shiftup t] | |
7235 ["1 ... earlier" org-shiftdown t]) | |
7236 ["Compute Time Range" org-evaluate-time-range t] | |
7237 ["Schedule Item" org-schedule t] | |
7238 ["Deadline" org-deadline t] | |
7239 "--" | |
7240 ["Goto Calendar" org-goto-calendar t] | |
7241 ["Date from Calendar" org-date-from-calendar t]) | |
7242 "--" | |
7243 ("Timeline/Agenda" | |
7244 ["Show TODO Tree this file" org-show-todo-tree t] | |
7245 ["Check Deadlines this file" org-check-deadlines t] | |
7246 ["Timeline current file" org-timeline t] | |
7247 "--" | |
7248 ["Adenda (multifile)" org-agenda-overview t]) | |
7249 ("File List for Agenda") | |
7250 "--" | |
7251 ("Hyperlinks" | |
7252 ["Store Link (global)" org-store-link t] | |
7253 ["Insert Link" org-insert-link t] | |
7254 ["Follow Link" org-open-at-point t]) | |
7255 ;; ["BBDB" org-bbdb-name t] | |
7256 "--" | |
7257 ("Table" | |
7258 ["Align" org-ctrl-c-ctrl-c (org-at-table-p)] | |
7259 ["Next field" org-cycle (org-at-table-p)] | |
7260 ["Previous Field" org-shifttab (org-at-table-p)] | |
7261 ["Next row" org-return (org-at-table-p)] | |
7262 "--" | |
7263 ["Blank field" org-table-blank-field (org-at-table-p)] | |
7264 ["Copy field from above" org-table-copy-from-above (org-at-table-p)] | |
7265 "--" | |
7266 ("Column" | |
7267 ["Move column left" org-metaleft (org-at-table-p)] | |
7268 ["Move column right" org-metaright (org-at-table-p)] | |
7269 ["Delete column" org-shiftmetaleft (org-at-table-p)] | |
7270 ["Insert column" org-shiftmetaright (org-at-table-p)]) | |
7271 ("Row" | |
7272 ["Move row up" org-metaup (org-at-table-p)] | |
7273 ["Move row down" org-metadown (org-at-table-p)] | |
7274 ["Delete row" org-shiftmetaup (org-at-table-p)] | |
7275 ["Insert row" org-shiftmetadown (org-at-table-p)] | |
7276 "--" | |
7277 ["Insert hline" org-table-insert-hline (org-at-table-p)]) | |
7278 ("Rectangle" | |
7279 ["Copy rectangle" org-copy-special (org-at-table-p)] | |
7280 ["Cut rectangle" org-cut-special (org-at-table-p)] | |
7281 ["Paste rectangle" org-paste-special (org-at-table-p)] | |
7282 ["Fill rectangle" org-table-wrap-region (org-at-table-p)]) | |
7283 "--" | |
7284 ["Which column?" org-table-current-column (org-at-table-p)] | |
7285 ["Sum column/rectangle" org-table-sum | |
7286 (or (org-at-table-p) (org-region-active-p))] | |
7287 ["Eval formula" org-table-eval-formula (org-at-table-p)] | |
7288 "--" | |
7289 ["Invisible Vlines" org-table-toggle-vline-visibility | |
7290 :style toggle :selected (org-in-invisibility-spec-p '(org-table))] | |
7291 "--" | |
7292 ["Create" org-table-create (and (not (org-at-table-p)) | |
7293 org-enable-table-editor)] | |
7294 ["Convert region" org-ctrl-c-ctrl-c (not (org-at-table-p 'any))] | |
7295 ["Import from file" org-table-import (not (org-at-table-p))] | |
7296 ["Export to file" org-table-export (org-at-table-p)] | |
7297 "--" | |
7298 ["Create/convert from/to table.el" org-table-create-with-table.el t]) | |
7299 "--" | |
7300 ("Export" | |
7301 ["ASCII" org-export-as-ascii t] | |
7302 ["HTML" org-export-as-html t] | |
7303 ["HTML, and open" org-export-as-html-and-open t] | |
7304 "--" | |
7305 ["Option template" org-insert-export-options-template t] | |
7306 ["Toggle fixed width" org-toggle-fixed-width-section t]) | |
7307 "--" | |
7308 ("Documentation" | |
7309 ["Show Version" org-version t] | |
7310 ["Info Documentation" org-info t]) | |
7311 ("Customize" | |
7312 ["Browse Org Group" org-customize t] | |
7313 "--" | |
7314 ["Build Full Customize Menu" org-create-customize-menu | |
7315 (fboundp 'customize-menu-create)]) | |
7316 )) | |
7317 | |
7318 | |
7319 (defun org-info (&optional node) | |
7320 "Read documentation for Org-mode in the info system. | |
7321 With optional NODE, go directly to that node." | |
7322 (interactive) | |
7323 (require 'info) | |
7324 (Info-goto-node (format "(org)%s" (or node "")))) | |
7325 | |
7326 | |
7327 (defun org-install-agenda-files-menu () | |
7328 (easy-menu-change | |
7329 '("Org") "File List for Agenda" | |
7330 (append | |
7331 (list | |
7332 ["Edit file list" (customize-variable 'org-agenda-files) t] | |
7333 ["Add current file to list" org-add-file t] | |
7334 ["Remove current file from list" org-remove-file t] | |
7335 "--") | |
7336 (mapcar 'org-file-menu-entry org-agenda-files)))) | |
7337 | |
7338 ;;; Documentation | |
7339 | |
7340 (defun org-customize () | |
7341 "Call the customize function with org as argument." | |
7342 (interactive) | |
7343 (customize-browse 'org)) | |
7344 | |
7345 (defun org-create-customize-menu () | |
7346 "Create a full customization menu for Org-mode, insert it into the menu." | |
7347 (interactive) | |
7348 (if (fboundp 'customize-menu-create) | |
7349 (progn | |
7350 (easy-menu-change | |
7351 '("Org") "Customize" | |
7352 `(["Browse Org group" org-customize t] | |
7353 "--" | |
7354 ,(customize-menu-create 'org) | |
7355 ["Set" Custom-set t] | |
7356 ["Save" Custom-save t] | |
7357 ["Reset to Current" Custom-reset-current t] | |
7358 ["Reset to Saved" Custom-reset-saved t] | |
7359 ["Reset to Standard Settings" Custom-reset-standard t])) | |
7360 (message "\"Org\"-menu now contains full customization menu")) | |
7361 (error "Cannot expand menu (outdated version of cus-edit.el)"))) | |
7362 | |
7363 ;;; Miscellaneous stuff | |
7364 | |
7365 (defun org-move-line-down (arg) | |
7366 "Move the current line up." | |
7367 (interactive "p") | |
7368 (let ((col (current-column)) | |
7369 beg end pos) | |
7370 (beginning-of-line 1) (setq beg (point)) | |
7371 (beginning-of-line 2) (setq end (point)) | |
7372 (beginning-of-line (+ 1 arg)) | |
7373 (setq pos (move-marker (make-marker) (point))) | |
7374 (insert (delete-and-extract-region beg end)) | |
7375 (goto-char pos) | |
7376 (move-to-column col))) | |
7377 | |
7378 (defun org-move-line-up (arg) | |
7379 "Move the current line up." | |
7380 (interactive "p") | |
7381 (let ((col (current-column)) | |
7382 beg end pos) | |
7383 (beginning-of-line 1) (setq beg (point)) | |
7384 (beginning-of-line 2) (setq end (point)) | |
7385 (beginning-of-line (+ -2 arg)) | |
7386 (setq pos (move-marker (make-marker) (point))) | |
7387 (insert (delete-and-extract-region beg end)) | |
7388 (goto-char pos) | |
7389 (move-to-column col))) | |
7390 | |
7391 ;; Functions needed for Emacs/XEmacs region compatibility | |
7392 | |
7393 (defun org-region-active-p () | |
7394 "Is transient-mark-mode on and the region active? | |
7395 Works on both Emacs and XEmacs." | |
7396 (if org-ignore-region | |
7397 nil | |
7398 (if org-xemacs-p | |
7399 (and zmacs-regions (region-active-p)) | |
7400 (and transient-mark-mode mark-active)))) | |
7401 | |
7402 (defun org-add-to-invisibility-spec (arg) | |
7403 "Add elements to `buffer-invisibility-spec'. | |
7404 See documentation for `buffer-invisibility-spec' for the kind of elements | |
7405 that can be added." | |
7406 (cond | |
7407 ((fboundp 'add-to-invisibility-spec) | |
7408 (add-to-invisibility-spec arg)) | |
7409 ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t)) | |
7410 (setq buffer-invisibility-spec (list arg))) | |
7411 (t | |
7412 (setq buffer-invisibility-spec | |
7413 (cons arg buffer-invisibility-spec))))) | |
7414 | |
7415 (defun org-remove-from-invisibility-spec (arg) | |
7416 "Remove elements from `buffer-invisibility-spec'." | |
7417 (if (fboundp 'remove-from-invisibility-spec) | |
7418 (remove-from-invisibility-spec arg) | |
7419 (if (consp buffer-invisibility-spec) | |
7420 (setq buffer-invisibility-spec | |
7421 (delete arg buffer-invisibility-spec))))) | |
7422 | |
7423 (defun org-in-invisibility-spec-p (arg) | |
7424 "Is ARG a member of `buffer-invisibility-spec'?." | |
7425 (if (consp buffer-invisibility-spec) | |
7426 (member arg buffer-invisibility-spec) | |
7427 nil)) | |
7428 | |
7429 (defun org-image-file-name-regexp () | |
7430 "Return regexp matching the file names of images." | |
7431 (if (fboundp 'image-file-name-regexp) | |
7432 (image-file-name-regexp) | |
7433 (let ((image-file-name-extensions | |
7434 '("png" "jpeg" "jpg" "gif" "tiff" "tif" | |
7435 "xbm" "xpm" "pbm" "pgm" "ppm"))) | |
7436 (concat "\\." | |
7437 (regexp-opt (nconc (mapcar 'upcase | |
7438 image-file-name-extensions) | |
7439 image-file-name-extensions) | |
7440 t) | |
7441 "\\'")))) | |
7442 | |
7443 ;; Functions needed for compatibility with old outline.el | |
7444 | |
7445 ;; The following functions capture almost the entire compatibility code | |
7446 ;; between the different versions of outline-mode. The only other place | |
7447 ;; where this is important are the font-lock-keywords. Search for | |
7448 ;; `org-noutline-p' to find it. | |
7449 | |
7450 ;; C-a should go to the beginning of a *visible* line, also in the | |
7451 ;; new outline.el. I guess this should be patched into Emacs? | |
7452 (defun org-beginning-of-line () | |
7453 "Go to the beginning of the current line. If that is invisible, continue | |
7454 to a visible line beginning. This makes the function of C-a more intuitive." | |
7455 (interactive) | |
7456 (beginning-of-line 1) | |
7457 (if (bobp) | |
7458 nil | |
7459 (backward-char 1) | |
7460 (if (org-invisible-p) | |
7461 (while (and (not (bobp)) (org-invisible-p)) | |
7462 (backward-char 1) | |
7463 (beginning-of-line 1)) | |
7464 (forward-char 1)))) | |
7465 (when org-noutline-p | |
7466 (define-key org-mode-map "\C-a" 'org-beginning-of-line)) | |
7467 | |
7468 (defun org-invisible-p () | |
7469 "Check if point is at a character currently not visible." | |
7470 (if org-noutline-p | |
7471 ;; Early versions of noutline don't have `outline-invisible-p'. | |
7472 (if (fboundp 'outline-invisible-p) | |
7473 (outline-invisible-p) | |
7474 (get-char-property (point) 'invisible)) | |
7475 (save-excursion | |
7476 (skip-chars-backward "^\r\n") | |
7477 (if (bobp) | |
7478 nil | |
7479 (equal (char-before) ?\r))))) | |
7480 | |
7481 (defun org-back-to-heading (&optional invisible-ok) | |
7482 "Move to previous heading line, or beg of this line if it's a heading. | |
7483 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." | |
7484 (if org-noutline-p | |
7485 (outline-back-to-heading invisible-ok) | |
7486 (if (looking-at outline-regexp) | |
7487 t | |
7488 (if (re-search-backward (concat (if invisible-ok "[\r\n]" "^") | |
7489 outline-regexp) | |
7490 nil t) | |
7491 (if invisible-ok | |
7492 (progn (forward-char 1) | |
7493 (looking-at outline-regexp))) | |
7494 (error "Before first heading"))))) | |
7495 | |
7496 (defun org-on-heading-p (&optional invisible-ok) | |
7497 "Return t if point is on a (visible) heading line. | |
7498 If INVISIBLE-OK is non-nil, an invisible heading line is ok too." | |
7499 (if org-noutline-p | |
7500 (outline-on-heading-p 'invisible-ok) | |
7501 (save-excursion | |
7502 (skip-chars-backward "^\n\r") | |
7503 (and (looking-at outline-regexp) | |
7504 (or invisible-ok | |
7505 (bobp) | |
7506 (equal (char-before) ?\n)))))) | |
7507 | |
7508 (defun org-up-heading-all (arg) | |
7509 "Move to the heading line of which the present line is a subheading. | |
7510 This function considers both visible and invisible heading lines. | |
7511 With argument, move up ARG levels." | |
7512 (if org-noutline-p | |
7513 (outline-up-heading-all arg) | |
7514 (org-back-to-heading t) | |
7515 (looking-at outline-regexp) | |
7516 (if (<= (- (match-end 0) (match-beginning 0)) arg) | |
7517 (error "Cannot move up %d levels" arg) | |
7518 (re-search-backward | |
7519 (concat "[\n\r]" (regexp-quote | |
7520 (make-string (- (match-end 0) (match-beginning 0) arg) | |
7521 ?*)) | |
7522 "[^*]")) | |
7523 (forward-char 1)))) | |
7524 | |
7525 (defun org-show-hidden-entry () | |
7526 "Show an entry where even the heading is hidden." | |
7527 (save-excursion | |
7528 (if (not org-noutline-p) | |
7529 (progn | |
7530 (org-back-to-heading t) | |
7531 (org-flag-heading nil))) | |
7532 (show-entry))) | |
7533 | |
7534 (defun org-check-occur-regexp (regexp) | |
7535 "If REGEXP starts with \"^\", modify it to check for \\r as well. | |
7536 Of course, only for the old outline mode." | |
7537 (if org-noutline-p | |
7538 regexp | |
7539 (if (string-match "^\\^" regexp) | |
7540 (concat "[\n\r]" (substring regexp 1)) | |
7541 regexp))) | |
7542 | |
7543 (defun org-flag-heading (flag &optional entry) | |
7544 "Flag the current heading. FLAG non-nil means make invisible. | |
7545 When ENTRY is non-nil, show the entire entry." | |
7546 (save-excursion | |
7547 (org-back-to-heading t) | |
7548 (if (not org-noutline-p) | |
7549 ;; Make the current headline visible | |
7550 (outline-flag-region (max 1 (1- (point))) (point) (if flag ?\r ?\n))) | |
7551 ;; Check if we should show the entire entry | |
7552 (if entry | |
7553 (progn | |
7554 (show-entry) | |
7555 (save-excursion ;; FIXME: Is this the fix for points in the -| | |
7556 ;; middle of text? | | |
7557 (and (outline-next-heading) ;; | | |
7558 (org-flag-heading nil)))) ; show the next heading _| | |
7559 (outline-flag-region (max 1 (1- (point))) | |
7560 (save-excursion (outline-end-of-heading) (point)) | |
7561 (if org-noutline-p | |
7562 flag | |
7563 (if flag ?\r ?\n)))))) | |
7564 | |
7565 (defun org-make-options-regexp (kwds) | |
7566 "Make a regular expression for keyword lines." | |
7567 (concat | |
7568 (if org-noutline-p "^" "[\n\r]") | |
7569 "#?[ \t]*\\+\\(" | |
7570 (mapconcat 'regexp-quote kwds "\\|") | |
7571 "\\):[ \t]*" | |
7572 (if org-noutline-p "\\(.+\\)" "\\([^\n\r]+\\)"))) | |
7573 | |
7574 ;; Advise the bookmark-jump function to make jump position visible | |
7575 ;; Wrapped into eval-after-load to avoid loading advice unnecessarily | |
7576 (eval-after-load "bookmark" | |
7577 '(defadvice bookmark-jump (after org-make-visible activate) | |
7578 "Make the position visible." | |
7579 (and (eq major-mode 'org-mode) | |
7580 (org-invisible-p) | |
7581 (org-show-hierarchy-above)))) | |
7582 | |
7583 ;;; Finish up | |
7584 | |
7585 (provide 'org) | |
7586 | |
7587 (run-hooks 'org-load-hook) | |
7588 | |
7589 ;;; org.el ends here | |
7590 | |
58833
d97ebd9e30f6
Changes from arch/CVS synchronization
Miles Bader <miles@gnu.org>
parents:
58794
diff
changeset
|
7591 ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd |