Commit | Line | Data |
---|---|---|
891f4676 RS |
1 | ;; org.el --- Outline-based notes management and organizer |
2 | ||
359ec616 | 3 | ;; Copyright (c) 2003, 2004 Free Software Foundation |
891f4676 RS |
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/ | |
c90d0a39 | 8 | ;; Version: 3.03 |
891f4676 | 9 | |
359ec616 | 10 | ;; This file is part of GNU Emacs. |
891f4676 | 11 | |
359ec616 RS |
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) | |
891f4676 RS |
15 | ;; any later version. |
16 | ||
359ec616 RS |
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. | |
891f4676 RS |
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 | ||
7f72fcc3 | 7591 | ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd |