Mercurial > emacs
annotate lisp/textmodes/org.el @ 59994:3e0903b0d56d
*** empty log message ***
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Tue, 08 Feb 2005 23:50:46 +0000 |
parents | 8e7a2f6f9fa7 |
children | 58a53f588384 6d92d69fae33 |
rev | line source |
---|---|
58792 | 1 ;; org.el --- Outline-based notes management and organizer |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
2 ;; Carstens outline-mode for keeping track of everything. |
59546
e2696afad0c3
Fixed a few things in the file herder which I accidentially change
Carsten Dominik <dominik@science.uva.nl>
parents:
59539
diff
changeset
|
3 ;; Copyright (c) 2003, 2004 Free Software Foundation |
e2696afad0c3
Fixed a few things in the file herder which I accidentially change
Carsten Dominik <dominik@science.uva.nl>
parents:
59539
diff
changeset
|
4 |
58792 | 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/ | |
59546
e2696afad0c3
Fixed a few things in the file herder which I accidentially change
Carsten Dominik <dominik@science.uva.nl>
parents:
59539
diff
changeset
|
8 ;; Version: 3.04 |
e2696afad0c3
Fixed a few things in the file herder which I accidentially change
Carsten Dominik <dominik@science.uva.nl>
parents:
59539
diff
changeset
|
9 |
58794 | 10 ;; This file is part of GNU Emacs. |
59546
e2696afad0c3
Fixed a few things in the file herder which I accidentially change
Carsten Dominik <dominik@science.uva.nl>
parents:
59539
diff
changeset
|
11 |
58794 | 12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation; either version 2, or (at your option) | |
58792 | 15 ;; any later version. |
16 | |
58794 | 17 ;; GNU Emacs is distributed in the hope that it will be useful, |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
58792 | 21 |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 ;; Boston, MA 02111-1307, USA. | |
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
27 ;; | |
28 ;;; Commentary: | |
29 ;; | |
30 ;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing | |
31 ;; project planning with a fast and effective plain-text system. | |
32 ;; | |
33 ;; Org-mode develops organizational tasks around a NOTES file that contains | |
34 ;; information about projects as plain text. Org-mode is implemented on | |
35 ;; top of outline-mode - ideal to keep the content of large files well | |
36 ;; structured. It supports ToDo items, deadlines and time stamps, which | |
37 ;; magically appear in the diary listing of the Emacs calendar. Tables are | |
38 ;; easily created with a built-in table editor. Plain text URL-like links | |
39 ;; connect to websites, emails (VM,RMAIL,WANDERLUST), Usenet messages (Gnus), | |
40 ;; BBDB entries, and any files related to the projects. For printing and | |
41 ;; sharing of notes, an Org-mode file (or a part of it) can be exported as | |
42 ;; a structured ASCII file, or as HTML. | |
43 ;; | |
44 ;; Installation | |
45 ;; ------------ | |
46 ;; The instruction below assume that you have downloaded Org-mode from the | |
47 ;; web. If Org-mode is part of the Emacs distribution or an XEmacs package, | |
48 ;; you only need to add to .emacs the last three lines of Lisp code listed | |
49 ;; below, i.e. the `auto-mode-alist' modification and the global key bindings. | |
50 ;; | |
51 ;; Byte-compile org.el and put it on your load path. Then copy the | |
52 ;; following lines into .emacs. The last two lines define *global* | |
53 ;; keys for the commands `org-store-link' and `org-agenda' - please | |
54 ;; choose suitable keys yourself. | |
55 ;; | |
56 ;; (autoload 'org-mode "org" "Org mode" t) | |
57 ;; (autoload 'org-diary "org" "Diary entries from Org mode") | |
58 ;; (autoload 'org-agenda "org" "Multi-file agenda from Org mode" t) | |
59 ;; (autoload 'org-store-link "org" "Store a link to the current location" t) | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
60 ;; (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
61 ;; (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode") |
58792 | 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 ;; ------- | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
82 ;; Version 3.04 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
83 ;; - Table editor optimized to need fewer realignments, and to keep |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
84 ;; table shape when typing in fields. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
85 ;; - A new minor mode, orgtbl-mode, introduces the Org-mode table editor |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
86 ;; into arbitrary major modes. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
87 ;; - Fixed bug with realignment in XEmacs. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
88 ;; - Startup options can be set with special #+STARTUP line. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
89 ;; - Heading following a match in org-occur can be suppressed. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
90 ;; |
58792 | 91 ;; Version 3.03 |
92 ;; - Copyright transfer to the FSF. | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
93 ;; - Effect of C-u and C-u C-u in org-timeline swapped. |
58792 | 94 ;; - Timeline now always contains today, and `.' jumps to it. |
95 ;; - Table editor: | |
96 ;; - cut and paste of regtangular regions in tables | |
97 ;; - command to convert org-mode table to table.el table and back | |
98 ;; - command to treat several cells like a paragraph and fill it | |
99 ;; - command to convert a buffer region to a table | |
100 ;; - import/export tables as tab-separated files (exchange with Excel) | |
101 ;; - Agenda: | |
102 ;; - Sorting mechanism for agenda items rewritten from scratch. | |
103 ;; - Sorting fully configurable. | |
104 ;; - Entries specifying a time are sorted together. | |
105 ;; - Completion also covers option keywords after `#-'. | |
106 ;; - Bug fixes. | |
107 ;; | |
108 ;; Version 3.01 | |
109 ;; - New reference card, thanks to Philip Rooke for creating it. | |
110 ;; - Single file agenda renamed to "Timeline". It no longer shows | |
111 ;; warnings about upcoming deadlines/overdue scheduled items. | |
112 ;; That functionality is now limited to the (multifile) agenda. | |
113 ;; - When reading a date, the calendar can be manipulated with keys. | |
114 ;; - Link support for RMAIL and Wanderlust (from planner.el, untested) | |
115 ;; - Minor bug fixes and documentation improvements. | |
116 ;; | |
117 ;; Version 3.00 | |
118 ;; - Multifile Agenda shows current entries from many different files. | |
119 ;; - TeXInfo documentation (thanks to Christian Egli for the conversion). | |
120 ;; - Additional applications for TODO keywords, see documentation. | |
121 ;; Different files may have different TODO keywords etc. | |
122 ;; - Priorities for TODO items. | |
123 ;; - The browser mode used by `org-remember-handler' is improved. | |
124 ;; - Images get inlined in HTML export (thanks to Carsten Wimmer). | |
125 ;; - File links can contain line numbers, like file:/usr/etc/config:255 | |
126 ;; - Minor bug fixes. | |
127 ;; | |
128 ;; Version 2.10 | |
129 ;; - TODO entries can have additional states besides TODO and DONE. | |
130 ;; See new variable `org-todo-keywords'. | |
131 ;; - TODO keywords can be interpreted as categories. See variable | |
132 ;; `org-todo-interpretation'. | |
133 ;; - M-TAB completion on TODO keywords, TeX symbols, and normal words. | |
134 ;; - All keywords (like TODO, DEADLINE etc) are configurable. | |
135 ;; - Cursor positioning optimized after pro/demotion and TODO cycling. | |
136 ;; - Emphasizing in HTML works now for *bold*, /italic/ and _underline_. | |
137 ;; - New commands to kill, copy and yank entire subtrees. Yanking | |
138 ;; modifies the level of the tree before insertion. | |
139 ;; - New command `org-goto' (C-c C-j) to quickly move to other locations | |
140 ;; in the buffer without affecting outline visibility. | |
141 ;; - Hooks for John Wiegley's remember.el. | |
142 ;; - `org-read-date' pops up calendar for date selection with the mouse. | |
143 ;; See variable `org-popup-calendar-for-date-prompt'. | |
144 ;; | |
145 ;; Version 2.6 | |
146 ;; - TODO items can be SCHEDULED to a certain date. | |
147 ;; - Expired DEADLINEs are ignored if in an entry marked DONE. | |
148 ;; - From the diary or time-sorted view (C-c C-r), C-c C-t can be used to | |
149 ;; change the TODO state of an item remotely. | |
150 ;; - Horizontal computations in table editor. See `org-table-eval-formula'. | |
151 ;; - Fixed bug with summing tables (command `org-table-sum', `C-c +'). | |
152 ;; - Calendar window follows the timestamp when a timestamp is changed. | |
153 ;; New variable `org-calendar-follow-timestamp-change'. | |
154 ;; - Time-sorted view (`org-diary-view', C-c C-r) now uses the prefix | |
155 ;; argument to force inclusion of unscheduled TODO items. | |
156 ;; - New variable `org-confirm-shell-links' to turn of safety query. | |
157 ;; - New variable `org-open-non-existing-files'. | |
158 ;; | |
159 ;; Version 2.4 | |
160 ;; - A time-sorted view on all time stamps can be created with C-c C-r. | |
161 ;; - Timestamps and Deadlines can be shown in the Emacs diary. | |
162 ;; - Date ranges introduced. | |
163 ;; - Time-string formats are no longer configurable. | |
164 ;; - Vertical lines in tables can be made invisible with `C-c |'. | |
165 ;; - New "link" type to execute shell commands, like "shell:ls *.org" | |
166 ;; - Upon export, "myfile.org" becomes "myfile.html" or "myfile.txt", | |
167 ;; instead of "myfile.org.html" or "myfile.org.txt". | |
168 ;; - When the cursor is in the white space at the beginning of a line, | |
169 ;; TAB removes the whitespace before indenting again. | |
170 ;; | |
171 ;; Version 2.0 | |
172 ;; - Windows (NT/2000) support. | |
173 ;; - Works with both Emacs and XEmacs. | |
174 ;; - Fully automatic table editor. | |
175 ;; - New link types into Gnus, VM and BBDB. | |
176 ;; - Other link system changes | |
177 ;; - Time stamps are treated as links to the calendar. | |
178 ;; - Easy creation of links with global command `org-store-link'. | |
179 ;; - Insertion of links with `C-c C-l' works differently now. | |
180 ;; - Space characters allowed as part of a link. | |
181 ;; - Options in `org-file-apps' extended. The command may now be | |
182 ;; symbol 'emacs', or a lisp form. | |
183 ;; Please re-read the manual section about links. | |
184 ;; - Timestamp changes | |
185 ;; - `org-deadline' now prompts for a date. | |
186 ;; - A line can now contain several timestamps. Updating of a | |
187 ;; timestamp only happens if the cursor is at the timestamp. | |
188 ;; - Changed the time-stamp-format to ISO, to make sure it will | |
189 ;; always work (non-English month names had caused problems | |
190 ;; with `parse-time-string'.). Changing the time stamp format | |
191 ;; is not recommended. | |
192 ;; - Picture mode enhancements have been removed from org.el | |
193 ;; | |
194 ;; Version 1.4 | |
195 ;; - Some option name changes, not backward compatible. | |
196 ;; - ASCII exporter upgrade: Table of contents. | |
197 ;; - HTML exporter upgrade: fixed-width regions, better | |
198 ;; sub/superscripts, many TeX symbols supported. | |
199 ;; - Calendar support. | |
200 ;; | |
201 ;; Version 1.3 | |
202 ;; - HTML exporter upgrade, in particular table of contents | |
203 ;; | |
204 ;; Version 1.0 | |
205 ;; - Initial release | |
206 | |
207 ;;; Code: | |
208 | |
209 (eval-when-compile (require 'cl)) | |
210 (require 'outline) | |
211 (require 'time-date) | |
212 (require 'easymenu) | |
213 | |
214 ;;; Customization variables | |
215 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
216 (defvar org-version "3.04" |
58792 | 217 "The version number of the file org.el.") |
59596
8e7a2f6f9fa7
(org-version): Unnecessary prefix arg removed.
Carsten Dominik <dominik@science.uva.nl>
parents:
59547
diff
changeset
|
218 (defun org-version () |
8e7a2f6f9fa7
(org-version): Unnecessary prefix arg removed.
Carsten Dominik <dominik@science.uva.nl>
parents:
59547
diff
changeset
|
219 (interactive) |
58792 | 220 (message "Org-mode version %s" org-version)) |
221 | |
222 ;; The following two constants are for compatibility with different | |
223 ;; Emacs versions (Emacs versus XEmacs) and with different versions of | |
224 ;; outline.el. All the compatibility code in org.el is based on these two | |
225 ;; constants. | |
226 (defconst org-xemacs-p (featurep 'xemacs) | |
227 "Are we running xemacs?") | |
228 (defconst org-noutline-p (featurep 'noutline) | |
229 "Are we using the new outline mode?") | |
230 | |
231 (defgroup org nil | |
232 "Outline-based notes management and organizer " | |
233 :tag "Org" | |
234 :group 'outlines | |
235 :group 'hypermedia | |
236 :group 'calendar) | |
237 | |
238 (defgroup org-startup nil | |
239 "Options concerning startup of Org-mode." | |
240 :tag "Org Startup" | |
241 :group 'org) | |
242 | |
243 (defcustom org-startup-folded t | |
244 "Non-nil means, entering Org-mode will switch to OVERVIEW." | |
245 :group 'org-startup | |
246 :type 'boolean) | |
247 | |
248 (defcustom org-startup-truncated t | |
249 "Non-nil means, entering Org-mode will set `truncate-lines'. | |
250 This is useful since some lines containing links can be very long and | |
251 uninteresting. Also tables look terrible when wrapped." | |
252 :group 'org-startup | |
253 :type 'boolean) | |
254 | |
255 (defcustom org-startup-with-deadline-check nil | |
256 "Non-nil means, entering Org-mode will run the deadline check. | |
257 This means, if you start editing an org file, you will get an | |
258 immediate reminder of any due deadlines." | |
259 :group 'org-startup | |
260 :type 'boolean) | |
261 | |
262 (defcustom org-insert-mode-line-in-empty-file t | |
263 "Non-nil means insert the first line setting Org-mode in empty files. | |
264 When the function `org-mode' is called interactively in an empty, this | |
265 normally means that the file name does not automatically trigger Org-mode. | |
266 To ensure that the file will always be in Org-mode in the future, a | |
267 line enforcing Org-mode can be inserted into the buffer." | |
268 :group 'org-startup | |
269 :type 'boolean) | |
270 | |
271 (defgroup org-keywords nil | |
272 "Options concerning TODO items in Org-mode." | |
273 :tag "Org Keywords" | |
274 :group 'org) | |
275 | |
276 (defcustom org-todo-keywords '("TODO" "DONE") | |
277 "List of TODO entry keywords.\\<org-mode-map> | |
278 By default, this is '(\"TODO\" \"DONE\"). The last entry in the list is | |
279 considered to mean that the entry is \"done\". All the other mean that | |
280 action is required, and will make the entry show up in todo lists, diaries | |
281 etc. | |
282 The command \\[org-todo] cycles an entry through these states, and an | |
283 additional state where no keyword is present. For details about this | |
284 cycling, see also the variable `org-todo-interpretation' | |
285 Changes become only effective after restarting Emacs." | |
286 :group 'org-keywords | |
287 :type '(repeat (string :tag "Keyword"))) | |
288 | |
289 (defcustom org-todo-interpretation 'sequence | |
290 "Controls how TODO keywords are interpreted.\\<org-mode-map> | |
291 Possible values are `sequence' and `type'. | |
292 This variable is only relevant if `org-todo-keywords' contains more than two | |
293 states. There are two ways how these keywords can be used: | |
294 | |
295 - As a sequence in the process of working on a TODO item, for example | |
296 (setq org-todo-keywords '(\"TODO\" \"STARTED\" \"VERIFY\" \"DONE\") | |
297 org-todo-interpretation 'sequence) | |
298 | |
299 - As different types of TODO items, for example | |
300 (setq org-todo-keywords '(\"URGENT\" \"RELAXED\" \"REMIND\" \"FOR_TOM\" \"DONE\") | |
301 org-todo-interpretation 'type) | |
302 | |
303 When the states are interpreted as a sequence, \\[org-todo] always cycles | |
304 to the next state, in order to walk through all different states. So with | |
305 \\[org-todo], you turn an empty entry into the state TODO. When you started | |
306 working on the item, you use \\[org-todo] again to switch it to \"STARTED\", | |
307 later to VERIFY and finally to DONE. | |
308 | |
309 When the states are interpreted as types, \\[org-todo] still cycles through | |
310 when it is called several times in direct succession, in order to initially | |
311 select the type. However, if not called immediately after a previous | |
312 \\[org-todo], it switches from each type directly to DONE. So with the | |
313 above example, you could use `\\[org-todo] \\[org-todo]' to label an entry | |
314 RELAXED. If you later return to this entry and press \\[org-todo] again, | |
315 RELAXED will not be changed REMIND, but directly to DONE. | |
316 | |
317 You can create a large number of types. To initially select a | |
318 type, it is then best to use C-u \\[org-todo] in order to specify the | |
319 type with completion. Of course, you can also type the keyword | |
320 directly into the buffer. M-TAB completes TODO keywords at the | |
321 beginning of a headline." | |
322 :group 'org-keywords | |
323 :type '(choice (const sequence) | |
324 (const type))) | |
325 | |
326 (defcustom org-default-priority ?B | |
327 "The default priority of TODO items. | |
328 This is the priority an item get if no explicit priority is given." | |
329 :group 'org-keywords | |
330 :type 'character) | |
331 | |
332 (defcustom org-lowest-priority ?C | |
333 "The lowest priority of TODO items. A character like ?A, ?B etc." | |
334 :group 'org-keywords | |
335 :type 'character) | |
336 | |
337 (defcustom org-deadline-string "DEADLINE:" | |
338 "String to mark deadline entries. | |
339 A deadline 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-deadline]. | |
342 Changes become only effective after restarting Emacs." | |
343 :group 'org-keywords | |
344 :type 'string) | |
345 | |
346 (defcustom org-scheduled-string "SCHEDULED:" | |
347 "String to mark scheduled TODO entries. | |
348 A schedule is this string, followed by a time stamp. Should be a word, | |
349 terminated by a colon. You can insert a schedule keyword and | |
350 a timestamp with \\[org-schedule]. | |
351 Changes become only effective after restarting Emacs." | |
352 :group 'org-keywords | |
353 :type 'string) | |
354 | |
355 (defcustom org-comment-string "COMMENT" | |
356 "Entries starting with this keyword will never be exported. | |
357 An entry can be toggled between COMMENT and normal with | |
358 \\[org-toggle-comment]. | |
359 Changes become only effective after restarting Emacs." | |
360 :group 'org-keywords | |
361 :type 'string) | |
362 | |
363 (defcustom org-after-todo-state-change-hook nil | |
364 "Hook which is run after the state of a TODO item was changed. | |
365 The new state (a string with a todo keyword, or nil) is available in the | |
366 lisp variable `state'." | |
367 :group 'org-keywords | |
368 :type 'hook) | |
369 | |
370 ;; Variables for pre-computed regular expressions, all buffer local | |
371 (defvar org-todo-kwd-priority-p nil | |
372 "Do TODO items have priorities?") | |
373 (make-variable-buffer-local 'org-todo-kwd-priority-p) | |
374 (defvar org-todo-kwd-max-priority nil | |
375 "Maximum priority of TODO items") | |
376 (make-variable-buffer-local 'org-todo-kwd-max-priority) | |
377 (defvar org-ds-keyword-length 12 | |
378 "Maximum length of the Deadline and SCHEDULED keywords.") | |
379 (make-variable-buffer-local 'org-ds-keyword-length) | |
380 (defvar org-done-string nil | |
381 "The last string in `org-todo-keywords', indicating an item is DONE.") | |
382 (make-variable-buffer-local 'org-done-string) | |
383 (defvar org-todo-regexp nil | |
384 "Matches any of the TODO state keywords.") | |
385 (make-variable-buffer-local 'org-todo-regexp) | |
386 (defvar org-not-done-regexp nil | |
387 "Matches any of the TODO state keywords except the last one.") | |
388 (make-variable-buffer-local 'org-not-done-regexp) | |
389 (defvar org-todo-line-regexp nil | |
390 "Matches a headline and puts TODO state into group 2 if present.") | |
391 (make-variable-buffer-local 'org-todo-line-regexp) | |
392 (defvar orb-nl-done-regexp nil | |
393 "Matches newline followed by a headline with the DONE keyword.") | |
394 (make-variable-buffer-local 'orb-nl-done-regexp) | |
395 (defvar org-looking-at-done-regexp nil | |
396 "Matches the DONE keyword a point.") | |
397 (make-variable-buffer-local 'org-looking-at-done-regexp) | |
398 (defvar org-deadline-regexp nil | |
399 "Matches the DEADLINE keyword.") | |
400 (make-variable-buffer-local 'org-deadline-regexp) | |
401 (defvar org-deadline-time-regexp nil | |
402 "Matches the DEADLINE keyword together with a time stamp.") | |
403 (make-variable-buffer-local 'org-deadline-time-regexp) | |
404 (defvar org-deadline-line-regexp nil | |
405 "Matches the DEADLINE keyword and the rest of the line.") | |
406 (make-variable-buffer-local 'org-deadline-line-regexp) | |
407 (defvar org-scheduled-regexp nil | |
408 "Matches the SCHEDULED keyword.") | |
409 (make-variable-buffer-local 'org-scheduled-regexp) | |
410 (defvar org-scheduled-time-regexp nil | |
411 "Matches the SCHEDULED keyword together with a time stamp.") | |
412 (make-variable-buffer-local 'org-scheduled-time-regexp) | |
413 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
414 (defun org-set-regexps-and-options () |
58792 | 415 "Precompute regular expressions for current buffer." |
416 (when (eq major-mode 'org-mode) | |
417 (let ((re (org-make-options-regexp | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
418 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "STARTUP"))) |
58792 | 419 (splitre "[ \t]+") |
420 kwds int key value cat) | |
421 (save-restriction | |
422 (save-excursion | |
423 (widen) | |
424 (goto-char (point-min)) | |
425 (while (re-search-forward re nil t) | |
426 (setq key (match-string 1) value (match-string 2)) | |
427 (cond | |
428 ((equal key "CATEGORY") | |
429 (setq cat (intern (car (org-split-string value splitre))))) | |
430 ((equal key "SEQ_TODO") | |
431 (setq int 'sequence | |
432 kwds (append kwds (org-split-string value splitre)))) | |
433 ((equal key "PRI_TODO") | |
434 (setq int 'priority | |
435 kwds (append kwds (org-split-string value splitre)))) | |
436 ((equal key "TYP_TODO") | |
437 (setq int 'type | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
438 kwds (append kwds (org-split-string value splitre)))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
439 ((equal key "STARTUP") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
440 (let ((opts (org-split-string value splitre)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
441 (set '(("fold" org-startup-folded t) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
442 ("nofold" org-startup-folded nil) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
443 ("dlcheck" org-startup-with-deadline-check t) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
444 ("nodlcheck" org-startup-with-deadline-check nil))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
445 l var val) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
446 (while (setq l (assoc (pop opts) set)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
447 (setq var (nth 1 l) val (nth 2 l)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
448 (set (make-local-variable var) val))))) |
58792 | 449 ))) |
450 (and cat (set (make-local-variable 'org-category) cat)) | |
451 (and kwds (set (make-local-variable 'org-todo-keywords) kwds)) | |
452 (and int (set (make-local-variable 'org-todo-interpretation) int))) | |
453 ;; Compute the regular expressions and other local variables | |
454 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) | |
455 org-todo-kwd-max-priority (1- (length org-todo-keywords)) | |
456 org-ds-keyword-length (+ 2 (max (length org-deadline-string) | |
457 (length org-scheduled-string))) | |
458 org-done-string | |
459 (nth (1- (length org-todo-keywords)) org-todo-keywords) | |
460 org-todo-regexp | |
461 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords | |
462 "\\|") "\\)\\>") | |
463 org-not-done-regexp | |
464 (concat "\\<\\(" | |
465 (mapconcat 'regexp-quote | |
466 (nreverse (cdr (reverse org-todo-keywords))) | |
467 "\\|") | |
468 "\\)\\>") | |
469 org-todo-line-regexp | |
470 (concat "^\\(\\*+\\)[ \t]*\\(" | |
471 (mapconcat 'regexp-quote org-todo-keywords "\\|") | |
472 "\\)? *\\(.*\\)") | |
473 orb-nl-done-regexp | |
474 (concat "[\r\n]\\*+[ \t]+" org-done-string "\\>") | |
475 org-looking-at-done-regexp (concat "^" org-done-string "\\>") | |
476 org-deadline-regexp (concat "\\<" org-deadline-string) | |
477 org-deadline-time-regexp | |
478 (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") | |
479 org-deadline-line-regexp | |
480 (concat "\\<\\(" org-deadline-string "\\).*") | |
481 org-scheduled-regexp | |
482 (concat "\\<" org-scheduled-string) | |
483 org-scheduled-time-regexp | |
484 (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) | |
485 (org-set-font-lock-defaults))) | |
486 | |
487 (defgroup org-time nil | |
488 "Options concerning time stamps and deadlines in Org-mode." | |
489 :tag "Org Time" | |
490 :group 'org) | |
491 | |
492 (defcustom org-deadline-warning-days 30 | |
493 "No. of days before expiration during which a deadline becomes active. | |
494 This variable governs the display in the org file." | |
495 :group 'org-time | |
496 :type 'number) | |
497 | |
498 (defcustom org-popup-calendar-for-date-prompt t | |
499 "Non-nil means, pop up a calendar when prompting for a date. | |
500 In the calendar, the date can be selected with mouse-1. However, the | |
501 minibuffer will also be active, and you can simply enter the date as well. | |
502 When nil, only the minibuffer will be available." | |
503 :group 'org-time | |
504 :type 'number) | |
505 | |
506 (defcustom org-calendar-follow-timestamp-change t | |
507 "Non-nil means, make the calendar window follow timestamp changes. | |
508 When a timestamp is modified and the calendar window is visible, it will be | |
509 moved to the new date." | |
510 :group 'org-time | |
511 :type 'boolean) | |
512 | |
513 (defgroup org-agenda nil | |
514 "Options concerning agenda display Org-mode." | |
515 :tag "Org Agenda" | |
516 :group 'org) | |
517 | |
518 (defcustom org-agenda-files nil | |
519 "A list of org files for agenda/diary display. | |
520 Entries are added to this list with \\[org-add-file] and removed with | |
521 \\[org-remove-file]. You can also use customize to edit the list." | |
522 :group 'org-agenda | |
523 :type '(repeat file)) | |
524 | |
525 (defcustom org-select-timeline-window t | |
526 "Non-nil means, after creating a timeline, move cursor into Timeline window. | |
527 When nil, cursor will remain in the current window." | |
528 :group 'org-agenda | |
529 :type 'boolean) | |
530 | |
531 (defcustom org-select-agenda-window t | |
532 "Non-nil means, after creating an agenda, move cursor into Agenda window. | |
533 When nil, cursor will remain in the current window." | |
534 :group 'org-agenda | |
535 :type 'boolean) | |
536 | |
537 (defcustom org-agenda-show-all-dates t | |
538 "Non-nil means, `org-agenda' shows every day in the selected range. | |
539 When nil, only the days which actually have entries are shown." | |
540 :group 'org-agenda | |
541 :type 'boolean) | |
542 | |
543 ;; FIXME: First day of month works only for current month because it would | |
544 ;; require a variable ndays treatment. | |
545 (defcustom org-agenda-start-on-weekday 1 | |
546 "Non-nil means, start the overview always on the specified weekday. | |
547 0 Denotes Sunday, 1 denotes Monday etc. | |
548 When nil, always start on the current day." | |
549 :group 'org-agenda | |
550 :type '(choice (const :tag "Today" nil) | |
551 (const :tag "First day of month" t) | |
552 (number :tag "Weekday No."))) | |
553 | |
554 (defcustom org-agenda-ndays 7 | |
555 "Number of days to include in overview display." | |
556 :group 'org-agenda | |
557 :type 'number) | |
558 | |
559 (defcustom org-agenda-include-all-todo t | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
560 "Non-nil means, the multifile agenda will always contain all TODO entries. |
58792 | 561 When nil, date-less entries will only be shown if `org-agenda' is called |
562 with a prefix argument. | |
563 When non-nil, the TODO entries will be listed at the top of the agenda, before | |
564 the entries for specific days." | |
565 :group 'org-agenda | |
566 :type 'boolean) | |
567 | |
568 (defcustom org-agenda-include-diary nil | |
569 "Non-nil means, when preparing the agenda, also get the | |
570 entries from the emacs calendars diary." | |
571 :group 'org-agenda | |
572 :type 'boolean) | |
573 | |
574 | |
575 (defcustom org-agenda-sorting-strategy '(time-up category-keep priority-down) | |
576 "Sorting structure for the agenda items of a single day. | |
577 This is a list of symbols which will be used in sequence to determine | |
578 if an entry should be listed before another entry. The following | |
579 symbols are recognized. | |
580 | |
581 time-up Put entries with time-of-day indications first, early first | |
582 time-down Put entries with time-of-day indications first, late first | |
583 category-keep Keep the default order of categories, corresponding to the | |
584 sequence in `org-agenda-files'. | |
585 category-up Sort alphabetically by category, A-Z. | |
586 category-down Sort alphabetically by category, Z-A. | |
587 priority-up Sort numerically by priority, high priority last. | |
588 priority-down Sort numerically by priority, high priority first. | |
589 | |
590 The different possibilities will be tried in sequence, and testing stops | |
591 if one comparison returns a \"not-equal\". For example, the default | |
592 '(time-up category-keep priority-down) | |
593 means: Pull out all entries having a specified time of day and sort them, | |
594 in order to make a time schedule for the current day the first thing in the | |
595 agenda listing for the day. Of the entries without a time indication, keep | |
596 the grouped in categories, don't sort the categories, but keep them in | |
597 the sequence given in `org-agenda-files'. Within each category sort by | |
598 priority. | |
599 | |
600 Leaving out the `category-keep' would mean that items will be sorted across | |
601 categories by priority." | |
602 :group 'org-agenda | |
603 :type '(repeat | |
604 (choice | |
605 (const time-up) | |
606 (const time-down) | |
607 (const category-keep) | |
608 (const category-up) | |
609 (const category-down) | |
610 (const priority-up) | |
611 (const priority-down)))) | |
612 | |
613 (defcustom org-sort-agenda-notime-is-late t | |
614 "Non-nil means, items without time are considered late. | |
615 This is only relevant for sorting. When t, items which have no explicit | |
616 time like 15:30 will be considered as 24:01, i.e. later than any items which | |
617 do have a time. When nil, the default time is before 0:00." | |
618 :group 'org-agenda | |
619 :type 'boolean) | |
620 | |
621 (defvar org-category nil | |
622 "Variable used by org files to set a category for agenda display. | |
623 Such files should use a file variable to set it, for example | |
624 | |
625 -*- mode: org; org-category: \"ELisp\" | |
626 | |
627 If the file does not specify a category, the file's base name | |
628 is used instead.") | |
629 | |
630 (defgroup org-structure nil | |
631 "Options concerning structure editing in Org-mode." | |
632 :tag "Org Structure" | |
633 :group 'org) | |
634 | |
635 (defcustom org-adapt-indentation t | |
636 "Non-nil means, adapt indentation when promoting and demoting. | |
637 When this is set and the *entire* text in an entry is indented, the | |
638 indentation is increased by one space in a demotion command, and | |
639 decreased by one in a promotion command. If any line in the entry | |
640 body starts at column 0, indentation is not changed at all." | |
641 :group 'org-structure | |
642 :type 'boolean) | |
643 | |
644 (defcustom org-cycle-emulate-tab t | |
645 "Where should `org-cycle' emulate TAB. | |
646 nil Never | |
647 white Only in completely white lines | |
648 t Everywhere except in headlines" | |
649 :group 'org-structure | |
650 :type '(choice (const :tag "Never" nil) | |
651 (const :tag "Only in completely white lines" white) | |
652 (const :tag "Everywhere except in headlines" t) | |
653 )) | |
654 | |
655 (defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") | |
656 "Formats for `format-time-string' which are used for time stamps. | |
657 It is not recommended to change this constant.") | |
658 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
659 (defcustom org-show-following-heading t |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
660 "Non-nil means, show heading following match in `org-occur'. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
661 When doing an `org-occur' it is useful to show the headline which |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
662 follows the match, even if they do not match the regexp. This makes it |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
663 easier to edit directly inside the sparse tree. However, if you use |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
664 org-occur mainly as an overview, the following headlines are |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
665 unnecessary clutter." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
666 :group 'org-structure |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
667 :type 'boolean) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
668 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
669 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
670 |
58792 | 671 (defgroup org-link nil |
672 "Options concerning links in Org-mode." | |
673 :tag "Org Link" | |
674 :group 'org) | |
675 | |
676 (defcustom org-allow-space-in-links t | |
677 "Non-nil means, file names in links may contain space characters. | |
678 When nil, it becomes possible to put several links into a line." | |
679 :group 'org-link | |
680 :type 'boolean) | |
681 | |
682 (defcustom org-line-numbers-in-file-links t | |
683 "Non-nil means, file links from `org-store-link' contain line numbers. | |
684 The line number will be added to the file name with :NNN and interpreted | |
685 by the command `org-open-at-point'. | |
686 Using a prefix arg to the command \\[org-store-link] (`org-store-link') | |
687 negates this setting for the duration of the command." | |
688 :group 'org-link | |
689 :type 'boolean) | |
690 | |
691 (defcustom org-keep-stored-link-after-insertion nil | |
692 "Non-nil means, keep link in list for entire session. | |
693 | |
694 The command `org-store-link' adds a link pointing to the current | |
695 location to an internal list. These links accumulate during a session. | |
696 The command `org-insert-link' can be used to insert links into any | |
697 Org-mode file (offering completion for all stored links). When this | |
698 option is nil, every link which has been inserted once using `C-c C-l' | |
699 will be removed from the list, to make completing the unused links | |
700 more efficient." | |
701 :group 'org-link | |
702 :type 'boolean) | |
703 | |
704 (defcustom org-link-frame-setup | |
705 '((vm . vm-visit-folder-other-frame) | |
706 (gnus . gnus-other-frame) | |
707 (file . find-file-other-window)) | |
708 "Setup the frame configuration for following links. | |
709 When following a link with Emacs, it may often be useful to display | |
710 this link in another window or frame. This variable can be used to | |
711 set this up for the different types of links. | |
712 For VM, use any of | |
713 vm-visit-folder | |
714 vm-visit-folder-other-frame | |
715 For Gnus, use any of | |
716 gnus | |
717 gnus-other-frame | |
718 For FILE, use any of | |
719 find-file | |
720 find-file-other-window | |
721 find-file-other-frame | |
722 For the calendar, use the variable `calendar-setup'. | |
723 For BBDB, it is currently only possible to display the matches in | |
724 another window." | |
725 :group 'org-link | |
726 :type '(list | |
727 (cons (const vm) | |
728 (choice | |
729 (const vm-visit-folder) | |
730 (const vm-visit-folder-other-window) | |
731 (const vm-visit-folder-other-frame))) | |
732 (cons (const gnus) | |
733 (choice | |
734 (const gnus) | |
735 (const gnus-other-frame))) | |
736 (cons (const file) | |
737 (choice | |
738 (const find-file) | |
739 (const find-file-other-window) | |
740 (const find-file-other-frame))))) | |
741 | |
742 (defcustom org-usenet-links-prefer-google nil | |
743 "Non-nil means, `org-store-link' will create web links to google groups. | |
744 When nil, Gnus will be used for such links. | |
745 Using a prefix arg to the command \\[org-store-link] (`org-store-link') | |
746 negates this setting for the duration of the command." | |
747 :group 'org-link | |
748 :type 'boolean) | |
749 | |
750 (defcustom org-open-non-existing-files nil | |
751 "Non-nil means, `org-open-file' will open non-existing file. | |
752 When nil, an error will be generated." | |
753 :group 'org-link | |
754 :type 'boolean) | |
755 | |
756 (defcustom org-confirm-shell-links t | |
757 "Non-nil means, ask for confirmation before executing shell links. | |
758 The default is true, to keep new users from shooting into their own foot." | |
759 :group 'org-link | |
760 :type 'boolean) | |
761 | |
762 (defconst org-file-apps-defaults-linux | |
763 '((t . emacs) | |
764 ("jpg" . "xv %s") | |
765 ("gif" . "xv %s") | |
766 ("ppm" . "xv %s") | |
767 ("pgm" . "xv %s") | |
768 ("pbm" . "xv %s") | |
769 ("tif" . "xv %s") | |
770 ("png" . "xv %s") | |
771 ("ps" . "gv %s") | |
772 ("ps.gz" . "gv %s") | |
773 ("eps" . "gv %s") | |
774 ("eps.gz" . "gv %s") | |
775 ("dvi" . "xdvi %s") | |
776 ("mpeg" . "plaympeg %s") | |
777 ("mp3" . "plaympeg %s") | |
778 ("fig" . "xfig %s") | |
779 ("pdf" . "acroread %s") | |
780 ("doc" . "soffice %s") | |
781 ("ppt" . "soffice %s") | |
782 ("pps" . "soffice %s") | |
783 ("html" . "netscape -remote openURL(%s,new-window)") | |
784 ("htm" . "netscape -remote openURL(%s,new-window)") | |
785 ("xs" . "soffice %s")) | |
786 "Default file applications on a UNIX/LINUX system. | |
787 See `org-file-apps'.") | |
788 | |
789 (defconst org-file-apps-defaults-macosx | |
790 '((t . "open %s") | |
791 ("ps" . "gv %s") | |
792 ("ps.gz" . "gv %s") | |
793 ("eps" . "gv %s") | |
794 ("eps.gz" . "gv %s") | |
795 ("dvi" . "xdvi %s") | |
796 ("fig" . "xfig %s")) | |
797 "Default file applications on a MacOS X system. | |
798 The system \"open\" is known as a default, but we use X11 applications | |
799 for some files for which the OS does not have a good default. | |
800 See `org-file-apps'.") | |
801 | |
802 (defconst org-file-apps-defaults-windowsnt | |
803 '((t . (w32-shell-execute "open" file))) | |
804 "Default file applications on a Windows NT system. | |
805 The system \"open\" is used for most files. | |
806 See `org-file-apps'.") | |
807 | |
808 (defcustom org-file-apps | |
809 '( | |
810 ("txt" . emacs) | |
811 ("tex" . emacs) | |
812 ("ltx" . emacs) | |
813 ("org" . emacs) | |
814 ("el" . emacs) | |
815 ) | |
816 "External applications for opening `file:path' items in a document. | |
817 Org-mode uses system defaults for different file types, but | |
818 you can use this variable to set the application for a given file | |
819 extension. The entries in this list are cons cells with a file extension | |
820 and the corresponding command. Possible values for the command are: | |
821 `emacs' The file will be visited by the current Emacs process. | |
822 `default' Use the default application for this file type. | |
823 string A command to be executed by a shell. %s will be replaced | |
824 by the path to the file. | |
825 sexp A lisp form which will be evaluated. The file path will | |
826 be available in the lisp variable `file'. | |
827 For more examples, see the system specific constants | |
828 `org-file-apps-defaults-macosx' | |
829 `org-file-apps-defaults-windowsnt' | |
830 `org-file-apps-defaults-linux'." | |
831 :group 'org-link | |
832 :type '(repeat | |
833 (cons (string :tag "Extension") | |
834 (choice :value "" | |
835 (const :tag "Visit with Emacs" 'emacs) | |
836 (const :tag "Use system default" 'default) | |
837 (string :tag "Command") | |
838 (sexp :tag "Lisp form"))))) | |
839 | |
840 | |
841 (defgroup org-remember nil | |
842 "Options concerning interaction with remember.el." | |
843 :tag "Org Remember" | |
844 :group 'org) | |
845 | |
846 (defcustom org-directory "~/org" | |
847 "Directory with org files. | |
848 This directory will be used as default to prompt for org files. | |
849 Used by the hooks for remember.el." | |
850 :group 'org-remember | |
851 :type 'directory) | |
852 | |
853 (defcustom org-default-notes-file "~/.notes" | |
854 "Default target for storing notes. | |
855 Used by the hooks for remember.el. This can be a string, or nil to mean | |
856 the value of `remember-data-file'." | |
857 :group 'org-remember | |
858 :type '(choice | |
859 (const :tag "Default from remember-data-file" nil) | |
860 file)) | |
861 | |
862 (defcustom org-reverse-note-order nil | |
863 "Non-nil means, store new notes at the beginning of a file or entry. | |
864 When nil, new notes will be filed to the end of a file or entry." | |
865 :group 'org-remember | |
866 :type '(choice | |
867 (const :tag "Reverse always" t) | |
868 (const :tag "Reverse never" nil) | |
869 (repeat :tag "By file name regexp" | |
870 (cons regexp boolean)))) | |
871 | |
872 (defgroup org-table nil | |
873 "Options concerning tables in Org-mode." | |
874 :tag "Org Table" | |
875 :group 'org) | |
876 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
877 (defcustom org-enable-table-editor 'optimized |
58792 | 878 "Non-nil means, lines starting with \"|\" are handled by the table editor. |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
879 When nil, such lines will be treated like ordinary lines. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
880 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
881 When equal to the symbol `optimized', the table editor will be optimized to |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
882 do the following |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
883 - Use automatic overwrite mode in front of whitespace in table fields. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
884 This make the structure of the table stay in tact as long as the edited |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
885 field does not exceed the column width. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
886 - Minimize the number of realigns. Normally, the table is aligned each time |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
887 TAB or RET are pressed to move to another field. With optimization this |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
888 happens only if changes to a field might have changed the column width. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
889 Optimization requires replacing the functions `self-insert-command', |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
890 `delete-char', and `backward-delete-char' in Org-mode buffers, with a |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
891 slight (in fact: unnoticable) speed impact for normal typing. Org-mode is |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
892 very good at guessing when a re-align will be necessary, but you can always |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
893 force one with `C-c C-c'. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
894 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
895 I you would like to use the optimized version in Org-mode, but the un-optimized |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
896 version in OrgTbl-mode, see the variable `orgtbl-optimized'. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
897 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
898 This variable can be used to turn on and off the table editor during a session, |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
899 but in order to toggle optimization, a restart is required." |
58792 | 900 :group 'org-table |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
901 :type '(choice |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
902 (const :tag "off" nil) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
903 (const :tag "on" t) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
904 (const :tag "on, optimized" optimized))) |
58792 | 905 |
906 (defcustom org-table-default-size "5x2" | |
907 "The default size for newly created tables, Columns x Rows." | |
908 :group 'org-table | |
909 :type 'string) | |
910 | |
911 (defcustom org-table-automatic-realign t | |
912 "Non-nil means, automatically re-align table when pressing TAB or RETURN. | |
913 When nil, aligning is only done with \\[org-table-align], or after column | |
914 removal/insertion." | |
915 :group 'org-table | |
916 :type 'boolean) | |
917 | |
918 (defcustom org-table-spaces-around-separators '(1 . 1) | |
919 "The number of spaces to be placed before and after separators." | |
920 :group 'org-table | |
921 :type '(cons (number :tag "Before \"|\"") (number :tag " After \"|\""))) | |
922 | |
923 (defcustom org-table-spaces-around-invisible-separators '(1 . 2) | |
924 "The number of spaces to be placed before and after separators. | |
925 This option applies when the column separators have been made invisible." | |
926 :group 'org-table | |
927 :type '(cons (number :tag "Before \"|\"") (number :tag " After \"|\""))) | |
928 | |
929 (defcustom org-table-number-regexp "^[<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*$" | |
930 "Regular expression for recognizing numbers in table columns. | |
931 If a table column contains mostly numbers, it will be aligned to the | |
932 right. If not, it will be aligned to the left. | |
933 | |
934 The default value of this option is a regular expression which allows | |
935 anything which looks remotely like a number as used in scientific | |
936 context. For example, all of the following will be considered a | |
937 number: | |
938 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5 | |
939 | |
940 Other options offered by the customize interface are more restrictive." | |
941 :group 'org-table | |
942 :type '(choice | |
943 (const :tag "Positive Integers" | |
944 "^[0-9]+$") | |
945 (const :tag "Integers" | |
946 "^[-+]?[0-9]+$") | |
947 (const :tag "Floating Point Numbers" | |
948 "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$") | |
949 (const :tag "Floating Point Number or Integer" | |
950 "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") | |
951 (const :tag "Exponential, Floating point, Integer" | |
952 "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") | |
953 (const :tag "Very General Number-Like" | |
954 "^[<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*$") | |
955 (string :tag "Regexp:"))) | |
956 | |
957 (defcustom org-table-number-fraction 0.5 | |
958 "Fraction of numbers in a column required to make the column align right. | |
959 In a column all non-white fields are considered. If at least this | |
960 fraction of fields is matched by `org-table-number-fraction', | |
961 alignment to the right border applies." | |
962 :group 'org-table | |
963 :type 'number) | |
964 | |
965 (defcustom org-export-highlight-first-table-line t | |
966 "Non-nil means, highlight the first table line. | |
967 In HTML export, this means use <th> instead of <td>. | |
968 In tables created with table.el, this applies to the first table line. | |
969 In Org-mode tables, all lines before the first horizontal separator | |
970 line will be formatted with <th> tags." | |
971 :group 'org-table | |
972 :type 'boolean) | |
973 | |
974 (defcustom org-table-tab-recognizes-table.el t | |
975 "Non-nil means, TAB will automatically notice a table.el table. | |
976 When it sees such a table, it moves point into it and - if necessary - | |
977 calls `table-recognize-table'." | |
978 :group 'org-table | |
979 :type 'boolean) | |
980 | |
981 (defcustom org-export-prefer-native-exporter-for-tables nil | |
982 "Non-nil means, always export tables created with table.el natively. | |
983 Natively means, use the HTML code generator in table.el. | |
984 When nil, Org-mode's own HTML generator is used when possible (i.e. if | |
985 the table does not use row- or column-spanning). This has the | |
986 advantage, that the automatic HTML conversions for math symbols and | |
987 sub/superscripts can be applied. Org-mode's HTML generator is also | |
988 much faster." | |
989 :group 'org-table | |
990 :type 'boolean) | |
991 | |
992 (defcustom org-enable-fixed-width-editor t | |
993 "Non-nil means, lines starting with \":\" are treated as fixed-width. | |
994 This currently only means, they are never auto-wrapped. | |
995 When nil, such lines will be treated like ordinary lines." | |
996 :group 'org-table | |
997 :type 'boolean) | |
998 | |
999 (defgroup org-export nil | |
1000 "Options for exporting org-listings." | |
1001 :tag "Org Export" | |
1002 :group 'org) | |
1003 | |
1004 (defcustom org-export-language-setup | |
1005 '(("en" "Author" "Date" "Table of Contents") | |
1006 ("da" "Ophavsmand" "Dato" "Indhold") | |
1007 ("de" "Autor" "Datum" "Inhaltsverzeichnis") | |
1008 ("es" "Autor" "Fecha" "\xccndice") | |
1009 ("fr" "Auteur" "Date" "Table des Mati\xe8res") | |
1010 ("it" "Autore" "Data" "Indice") | |
1011 ("nl" "Auteur" "Datum" "Inhoudsopgave") | |
1012 ("nn" "Forfattar" "Dato" "Innhold") ;; nn = Norsk (nynorsk) | |
1013 ("sv" "F\xf6rfattarens" "Datum" "Inneh\xe5ll")) | |
1014 "Terms used in export text, translated to different languages. | |
1015 Use the variable `org-export-default-language' to set the language, | |
1016 or use the +OPTION lines for a per-file setting." | |
1017 :group 'org-export | |
1018 :type '(repeat | |
1019 (list | |
1020 (string :tag "HTML language tag") | |
1021 (string :tag "Author") | |
1022 (string :tag "Date") | |
1023 (string :tag "Table of Contents")))) | |
1024 | |
1025 (defcustom org-export-default-language "en" | |
1026 "The default language of HTML export, as a string. | |
1027 This should have an association in `org-export-language-setup'" | |
1028 :group 'org-export | |
1029 :type 'string) | |
1030 | |
1031 (defcustom org-export-headline-levels 3 | |
1032 "The last level which is still exported as a headline. | |
1033 Inferior levels will produce itemize lists when exported. | |
1034 Note that a numeric prefix argument to an exporter function overrides | |
1035 this setting. | |
1036 | |
1037 This option can also be set with the +OPTIONS line, e.g. \"H:2\"." | |
1038 :group 'org-export | |
1039 :type 'number) | |
1040 | |
1041 (defcustom org-export-with-section-numbers t | |
1042 "Non-nil means, add section numbers to headlines when exporting. | |
1043 | |
1044 This option can also be set with the +OPTIONS line, e.g. \"num:t\"." | |
1045 :group 'org-export | |
1046 :type 'boolean) | |
1047 | |
1048 (defcustom org-export-with-toc t | |
1049 "Non-nil means, create a table of contents in exported files. | |
1050 The TOC contains headlines with levels up to`org-export-headline-levels'. | |
1051 | |
1052 Headlines which contain any TODO items will be marked with \"(*)\" in | |
1053 ASCII export, and with red color in HTML output. | |
1054 | |
1055 In HTML output, the TOC will be clickable. | |
1056 | |
1057 This option can also be set with the +OPTIONS line, e.g. \"toc:nil\"." | |
1058 :group 'org-export | |
1059 :type 'boolean) | |
1060 | |
1061 (defcustom org-export-preserve-breaks nil | |
1062 "Non-nil means, preserve all line breaks when exporting. | |
1063 Normally, in HTML output paragraphs will be reformatted. In ASCII | |
1064 export, line breaks will always be preserved, regardless of this variable. | |
1065 | |
1066 This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"." | |
1067 :group 'org-export | |
1068 :type 'boolean) | |
1069 | |
1070 (defcustom org-export-html-inline-images t | |
1071 "Non-nil means, inline images into exported HTML pages. | |
1072 The link will still be to the original location of the image file. | |
1073 So if you are moving the page, lets say to your public HTML site, | |
1074 you will have to move the image and maybe change the link." | |
1075 :group 'org-export | |
1076 :type 'boolean) | |
1077 | |
1078 (defcustom org-export-html-expand t | |
1079 "Non-nil means, for HTML export, treat @<...> as HTML tag. | |
1080 When nil, these tags will be exported as plain text and therefore | |
1081 not be interpreted by a browser. | |
1082 | |
1083 This option can also be set with the +OPTIONS line, e.g. \"@:nil\"." | |
1084 :group 'org-export | |
1085 :type 'boolean) | |
1086 | |
1087 (defcustom org-export-with-fixed-width t | |
1088 "Non-nil means, lines starting with \":\" will be in fixed width font. | |
1089 This can be used to have preformatted text, fragments of code etc. For | |
1090 example | |
1091 : ;; Some Lisp examples | |
1092 : (while (defc cnt) | |
1093 : (ding)) | |
1094 will be looking just like this in also HTML. In ASCII export, this option | |
1095 has no effect. | |
1096 | |
1097 This option can also be set with the +OPTIONS line, e.g. \"::nil\"." | |
1098 :group 'org-export | |
1099 :type 'boolean) | |
1100 | |
1101 (defcustom org-export-with-tables t | |
1102 "Non-nil means, lines starting with \"|\" define a table | |
1103 For example: | |
1104 | |
1105 | Name | Address | Birthday | | |
1106 |-------------+----------+-----------| | |
1107 | Arthur Dent | England | 29.2.2100 | | |
1108 | |
1109 In ASCII export, this option has no effect. | |
1110 | |
1111 This option can also be set with the +OPTIONS line, e.g. \"|:nil\"." | |
1112 :group 'org-export | |
1113 :type 'boolean) | |
1114 | |
1115 (defcustom org-export-html-table-tag | |
1116 "<table border=1 cellspacing=0 cellpadding=6>" | |
1117 "The HTML tag used to start a table. | |
1118 This must be a <table> tag, but you may change the options like | |
1119 borders and spacing." | |
1120 :group 'org-export | |
1121 :type 'string) | |
1122 | |
1123 (defcustom org-export-with-emphasize t | |
1124 "Non-nil means, interprete *word*, /word/, and _word_ as emphasized text. | |
1125 If the export target supports emphasizing text, the word will be | |
1126 typeset in bold, italic, or underlined, respectively. Works only for | |
1127 single words, but you can say: I *really* *mean* *this*. | |
1128 In ASCII export, this option has no effect. | |
1129 | |
1130 This option can also be set with the +OPTIONS line, e.g. \"*:nil\"." | |
1131 :group 'org-export | |
1132 :type 'boolean) | |
1133 | |
1134 (defcustom org-match-sexp-depth 3 | |
1135 "Number of stacked braces for sub/superscript matching. | |
1136 This has to be set before loading org.el to be effective." | |
1137 :group 'org-export | |
1138 :type 'integer) | |
1139 | |
1140 ;; FIXME: Should () parens be removed as well in sub/superscripts? | |
1141 (defcustom org-export-with-sub-superscripts t | |
1142 "Non-nil means, interprete \"_\" and \"^\" for export. | |
1143 When this option is turned on, you can use TeX-like syntax for sub- and | |
1144 superscripts. Several characters after \"_\" or \"^\" will be | |
1145 considered as a single item - so grouping with {} is normally not | |
1146 needed. For example, the following things will be parsed as single | |
1147 sub- or superscripts. | |
1148 | |
1149 10^24 or 10^tau several digits will be considered 1 item | |
1150 10^-12 or 10^-tau a leading sign with digits or a word | |
1151 x^2-y^3 will be read as x^2 - y^3, because items are | |
1152 terminated by almost any nonword/nondigit char. | |
1153 x_{i^2} or x^(2-i) braces or parenthesis do grouping. | |
1154 | |
1155 Still, ambiguity is possible - so when in doubt use {} to enclose the | |
1156 sub/superscript. | |
1157 In ASCII export, this option has no effect. | |
1158 | |
1159 This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." | |
1160 :group 'org-export | |
1161 :type 'boolean) | |
1162 | |
1163 (defcustom org-export-with-TeX-macros t | |
1164 "Non-nil means, interprete simple TeX-like macros when exporting. | |
1165 For example, HTML export converts \\alpha to α and \\AA to Å. | |
1166 No only real TeX macros will work here, but the standard HTML entities | |
1167 for math can be used as macro names as well. For a list of supported | |
1168 names in HTML export, see the constant `org-html-entities'. | |
1169 In ASCII export, this option has no effect. | |
1170 | |
1171 This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." | |
1172 :group 'org-export | |
1173 :type 'boolean) | |
1174 | |
1175 (defcustom org-export-html-with-timestamp nil | |
1176 "Non-nil means, write `org-export-html-html-helper-timestamp' | |
1177 into the exported html text. Otherwise, the buffer will just be saved | |
1178 to a file." | |
1179 :group 'org-export | |
1180 :type 'boolean) | |
1181 | |
1182 (defcustom org-export-html-html-helper-timestamp | |
1183 "<br><br><hr><p><!-- hhmts start --> <!-- hhmts end -->\n" | |
1184 "The HTML tag used as timestamp delimiter for HTML-helper-mode." | |
1185 :group 'org-export | |
1186 :type 'string) | |
1187 | |
1188 (defcustom org-export-ascii-show-new-buffer t | |
1189 "Non-nil means, popup buffer containing the exported ASCII text. | |
1190 Otherwise the buffer will just be saved to a file and stay hidden." | |
1191 :group 'org-export | |
1192 :type 'boolean) | |
1193 | |
1194 (defcustom org-export-html-show-new-buffer nil | |
1195 "Non-nil means, popup buffer containing the exported html text. | |
1196 Otherwise, the buffer will just be saved to a file and stay hidden." | |
1197 :group 'org-export | |
1198 :type 'boolean) | |
1199 | |
1200 | |
1201 (defgroup org-faces nil | |
1202 "Faces for highlighting in Org-mode." | |
1203 :tag "Org Faces" | |
1204 :group 'org) | |
1205 | |
1206 (defface org-level-1-face ;; font-lock-function-name-face | |
1207 '((((type tty) (class color)) (:foreground "blue" :weight bold)) | |
1208 (((class color) (background light)) (:foreground "Blue")) | |
1209 (((class color) (background dark)) (:foreground "LightSkyBlue")) | |
1210 (t (:inverse-video t :bold t))) | |
1211 "Face used for level 1 headlines." | |
1212 :group 'org-faces) | |
1213 | |
1214 (defface org-level-2-face ;; font-lock-variable-name-face | |
1215 '((((type tty) (class color)) (:foreground "yellow" :weight light)) | |
1216 (((class color) (background light)) (:foreground "DarkGoldenrod")) | |
1217 (((class color) (background dark)) (:foreground "LightGoldenrod")) | |
1218 (t (:bold t :italic t))) | |
1219 "Face used for level 2 headlines." | |
1220 :group 'org-faces) | |
1221 | |
1222 (defface org-level-3-face ;; font-lock-keyword-face | |
1223 '((((type tty) (class color)) (:foreground "cyan" :weight bold)) | |
1224 (((class color) (background light)) (:foreground "Purple")) | |
1225 (((class color) (background dark)) (:foreground "Cyan")) | |
1226 (t (:bold t))) | |
1227 "Face used for level 3 headlines." | |
1228 :group 'org-faces) | |
1229 | |
1230 (defface org-level-4-face ;; font-lock-comment-face | |
1231 '((((type tty pc) (class color) (background light)) (:foreground "red")) | |
1232 (((type tty pc) (class color) (background dark)) (:foreground "red1")) | |
1233 (((class color) (background light)) (:foreground "Firebrick")) | |
1234 (((class color) (background dark)) (:foreground "chocolate1")) | |
1235 (t (:bold t :italic t))) | |
1236 "Face used for level 4 headlines." | |
1237 :group 'org-faces) | |
1238 | |
1239 (defface org-level-5-face ;; font-lock-type-face | |
1240 '((((type tty) (class color)) (:foreground "green")) | |
1241 (((class color) (background light)) (:foreground "ForestGreen")) | |
1242 (((class color) (background dark)) (:foreground "PaleGreen")) | |
1243 (t (:bold t :underline t))) | |
1244 "Face used for level 5 headlines." | |
1245 :group 'org-faces) | |
1246 | |
1247 (defface org-level-6-face ;; font-lock-constant-face | |
1248 '((((type tty) (class color)) (:foreground "magenta")) | |
1249 (((class color) (background light)) (:foreground "CadetBlue")) | |
1250 (((class color) (background dark)) (:foreground "Aquamarine")) | |
1251 (t (:bold t :underline t))) | |
1252 "Face used for level 6 headlines." | |
1253 :group 'org-faces) | |
1254 | |
1255 (defface org-level-7-face ;; font-lock-builtin-face | |
1256 '((((type tty) (class color)) (:foreground "blue" :weight light)) | |
1257 (((class color) (background light)) (:foreground "Orchid")) | |
1258 (((class color) (background dark)) (:foreground "LightSteelBlue")) | |
1259 (t (:bold t))) | |
1260 "Face used for level 7 headlines." | |
1261 :group 'org-faces) | |
1262 | |
1263 (defface org-level-8-face ;;font-lock-string-face | |
1264 '((((type tty) (class color)) (:foreground "green")) | |
1265 (((class color) (background light)) (:foreground "RosyBrown")) | |
1266 (((class color) (background dark)) (:foreground "LightSalmon")) | |
1267 (t (:italic t))) | |
1268 "Face used for level 8 headlines." | |
1269 :group 'org-faces) | |
1270 | |
1271 (defface org-warning-face ;; font-lock-warning-face | |
1272 '((((type tty) (class color)) (:foreground "red")) | |
1273 (((class color) (background light)) (:foreground "Red" :bold t)) | |
1274 (((class color) (background dark)) (:foreground "Pink" :bold t)) | |
1275 (t (:inverse-video t :bold t))) | |
1276 "Face for deadlines and TODO keyords." | |
1277 :group 'org-faces) | |
1278 | |
1279 ;; Inheritance does not work for xemacs, unfortunately. | |
1280 ;; We just copy the definitions and waste some space.... | |
1281 | |
1282 (defface org-deadline-announce-face | |
1283 '((((type tty) (class color)) (:foreground "blue" :weight bold)) | |
1284 (((class color) (background light)) (:foreground "Blue")) | |
1285 (((class color) (background dark)) (:foreground "LightSkyBlue")) | |
1286 (t (:inverse-video t :bold t))) | |
1287 "Face for upcoming deadlines." | |
1288 :group 'org-faces) | |
1289 | |
1290 (defface org-scheduled-today-face | |
1291 '((((type tty) (class color)) (:foreground "green")) | |
1292 (((class color) (background light)) (:foreground "DarkGreen")) | |
1293 (((class color) (background dark)) (:foreground "PaleGreen")) | |
1294 (t (:bold t :underline t))) | |
1295 "Face for items scheduled for a certain day." | |
1296 :group 'org-faces) | |
1297 | |
1298 (defface org-scheduled-previously-face | |
1299 '((((type tty pc) (class color) (background light)) (:foreground "red")) | |
1300 (((type tty pc) (class color) (background dark)) (:foreground "red1")) | |
1301 (((class color) (background light)) (:foreground "Firebrick")) | |
1302 (((class color) (background dark)) (:foreground "chocolate1")) | |
1303 (t (:bold t :italic t))) | |
1304 "Face for items scheduled previously, and not yet done." | |
1305 :group 'org-faces) | |
1306 | |
1307 (defface org-link-face | |
1308 '((((type tty) (class color)) (:foreground "cyan" :weight bold)) | |
1309 (((class color) (background light)) (:foreground "Purple")) | |
1310 (((class color) (background dark)) (:foreground "Cyan")) | |
1311 (t (:bold t))) | |
1312 "Face for links." | |
1313 :group 'org-faces) | |
1314 | |
1315 (defface org-done-face ;; font-lock-type-face | |
1316 '((((type tty) (class color)) (:foreground "green")) | |
1317 (((class color) (background light)) (:foreground "ForestGreen" :bold t)) | |
1318 (((class color) (background dark)) (:foreground "PaleGreen" :bold t)) | |
1319 (t (:bold t :underline t))) | |
1320 "Face used for DONE." | |
1321 :group 'org-faces) | |
1322 | |
1323 (defface org-table-face ;; font-lock-function-name-face | |
1324 '((((type tty) (class color)) (:foreground "blue" :weight bold)) | |
1325 (((class color) (background light)) (:foreground "Blue")) | |
1326 (((class color) (background dark)) (:foreground "LightSkyBlue")) | |
1327 (t (:inverse-video t :bold t))) | |
1328 "Face used for tables." | |
1329 :group 'org-faces) | |
1330 | |
1331 (defvar org-level-faces | |
1332 '( | |
1333 org-level-1-face | |
1334 org-level-2-face | |
1335 org-level-3-face | |
1336 org-level-4-face | |
1337 org-level-5-face | |
1338 org-level-6-face | |
1339 org-level-7-face | |
1340 org-level-8-face | |
1341 )) | |
1342 (defvar org-n-levels (length org-level-faces)) | |
1343 | |
1344 | |
1345 ;; Tell the compiler about dynamically scoped variables, | |
1346 ;; and variables from other packages | |
1347 (eval-when-compile | |
1348 (defvar zmacs-regions) | |
1349 (defvar org-transient-mark-mode) | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
1350 (defvar org-old-auto-fill-inhibit-regexp) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
1351 (defvar orgtbl-mode-menu) |
58792 | 1352 (defvar org-html-entities) |
1353 (defvar org-goto-start-pos) | |
1354 (defvar org-cursor-color) | |
1355 (defvar org-time-was-given) | |
1356 (defvar org-ts-what) | |
1357 (defvar timecnt) | |
1358 (defvar levels-open) | |
1359 (defvar title) | |
1360 (defvar author) | |
1361 (defvar email) | |
1362 (defvar text) | |
1363 (defvar entry) | |
1364 (defvar date) | |
1365 (defvar language) | |
1366 (defvar options) | |
1367 (defvar ans1) | |
1368 (defvar ans2) | |
1369 (defvar starting-day) | |
1370 (defvar include-all-loc) | |
1371 (defvar vm-message-pointer) | |
1372 (defvar vm-folder-directory) | |
1373 (defvar wl-summary-buffer-elmo-folder) | |
1374 (defvar wl-summary-buffer-folder-name) | |
1375 (defvar gnus-group-name) | |
1376 (defvar gnus-article-current) | |
1377 (defvar w3m-current-url) | |
1378 (defvar org-selected-point) | |
1379 (defvar calendar-mode-map) | |
1380 (defvar remember-save-after-remembering) | |
1381 (defvar remember-data-file)) | |
1382 | |
1383 | |
1384 ;;; Define the mode | |
1385 | |
1386 (defvar org-mode-map (copy-keymap outline-mode-map) | |
1387 "Keymap for Org-mode.") | |
1388 | |
1389 (defvar org-struct-menu) | |
1390 (defvar org-org-menu) | |
1391 | |
1392 ;;;###autoload | |
1393 (defun org-mode (&optional arg) | |
1394 "Outline-based notes management and organizer, alias | |
1395 \"Carstens outline-mode for keeping track of everything.\" | |
1396 | |
1397 Org-mode develops organizational tasks around a NOTES file which | |
1398 contains information about projects as plain text. Org-mode is | |
1399 implemented on top of outline-mode, which is ideal to keep the content | |
1400 of large files well structured. It supports ToDo items, deadlines and | |
1401 time stamps, which magically appear in the diary listing of the Emacs | |
1402 calendar. Tables are easily created with a built-in table editor. | |
1403 Plain text URL-like links connect to websites, emails (VM), Usenet | |
1404 messages (Gnus), BBDB entries, and any files related to the project. | |
1405 For printing and sharing of notes, an Org-mode file (or a part of it) | |
1406 can be exported as a well-structured ASCII or HTML file. | |
1407 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
1408 The following commands are available: |
58792 | 1409 |
1410 \\{org-mode-map}" | |
1411 (interactive "P") | |
1412 (outline-mode) | |
1413 (setq major-mode 'org-mode) | |
1414 (setq mode-name "Org") | |
1415 (use-local-map org-mode-map) | |
1416 (easy-menu-add org-org-menu) | |
1417 (org-install-agenda-files-menu) | |
1418 (setq outline-regexp "\\*+") | |
1419 (if org-startup-truncated (setq truncate-lines t)) | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
1420 (org-set-regexps-and-options) |
58792 | 1421 (set (make-local-variable 'font-lock-unfontify-region-function) |
1422 'org-unfontify-region) | |
1423 ;; Activate before-change-function | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
1424 (set (make-local-variable 'org-table-may-need-update) t) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
1425 (make-local-hook 'before-change-functions) ;; needed for XEmacs |
58792 | 1426 (add-hook 'before-change-functions 'org-before-change-function nil |
1427 'local) | |
1428 ;; Inhibit auto-fill for headers, tables and fixed-width lines. | |
1429 (set (make-local-variable 'auto-fill-inhibit-regexp) | |
1430 (concat "\\*" | |
1431 (if (or org-enable-table-editor org-enable-fixed-width-editor) | |
1432 (concat | |
1433 "\\|[ \t]*[" | |
1434 (if org-enable-table-editor "|" "") | |
1435 (if org-enable-fixed-width-editor ":" "") | |
1436 "]")))) | |
1437 ;; Hook, and startup actions | |
1438 (if (or arg | |
1439 (and org-insert-mode-line-in-empty-file | |
1440 (= (point-min) (point-max)))) | |
1441 (save-excursion | |
1442 (goto-char (point-min)) | |
1443 (insert " -*- mode: org -*-\n\n"))) | |
1444 (run-hooks 'org-mode-hook) | |
1445 (if org-startup-with-deadline-check | |
1446 (call-interactively 'org-check-deadlines) | |
1447 (if org-startup-folded (org-cycle t)))) | |
1448 | |
1449 ;;; Font-Lock stuff | |
1450 | |
1451 (defvar org-mouse-map (make-sparse-keymap)) | |
1452 (define-key org-mouse-map | |
1453 (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse) | |
1454 (define-key org-mouse-map | |
1455 (if org-xemacs-p [button3] [mouse-3]) 'org-find-file-at-mouse) | |
1456 | |
1457 (require 'font-lock) | |
1458 | |
1459 (defconst org-link-regexp | |
1460 (if org-allow-space-in-links | |
1461 "\\(https?\\|ftp\\|mailto\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^\t\n\r]+[^ \t\n\r]\\)" | |
1462 "\\(https?\\|ftp\\|mailto\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^ \t\n\r]+\\)" | |
1463 ) | |
1464 "Regular expression for matching links.") | |
1465 (defconst org-ts-lengths | |
1466 (cons (length (format-time-string (car org-time-stamp-formats))) | |
1467 (length (format-time-string (cdr org-time-stamp-formats)))) | |
1468 "This holds the lengths of the two different time formats.") | |
1469 (defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*\\)>" | |
1470 "Regular expression for fast time stamp matching.") | |
1471 (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" | |
1472 "Regular expression matching time strings for analysis.") | |
1473 (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 ">") | |
1474 "Regular expression matching time stamps, with groups.") | |
1475 (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) | |
1476 "Regular expression matching a time stamp range.") | |
1477 (defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" | |
1478 org-ts-regexp "\\)?") | |
1479 "Regular expression matching a time stamp or time stamp range.") | |
1480 | |
1481 (defun org-activate-links (limit) | |
1482 "Run through the buffer and add overlays to links." | |
1483 (if (re-search-forward org-link-regexp limit t) | |
1484 (progn | |
1485 (add-text-properties (match-beginning 0) (match-end 0) | |
1486 (list 'mouse-face 'highlight | |
1487 'keymap org-mouse-map)) | |
1488 t))) | |
1489 | |
1490 (defun org-activate-dates (limit) | |
1491 "Run through the buffer and add overlays to links." | |
1492 (if (re-search-forward org-tsr-regexp limit t) | |
1493 (progn | |
1494 (add-text-properties (match-beginning 0) (match-end 0) | |
1495 (list 'mouse-face 'highlight | |
1496 'keymap org-mouse-map)) | |
1497 t))) | |
1498 | |
1499 | |
1500 (defun org-font-lock-level () | |
1501 (save-excursion | |
1502 (org-back-to-heading t) | |
1503 (- (match-end 0) (match-beginning 0)))) | |
1504 | |
1505 (defun org-set-font-lock-defaults () | |
1506 (let ((org-font-lock-extra-keywords | |
1507 (list | |
1508 '(org-activate-links (0 'org-link-face)) | |
1509 '(org-activate-dates (0 'org-link-face)) | |
1510 (list (concat "^\\*+[ \t]*" org-not-done-regexp) '(1 'org-warning-face t)) | |
1511 (list (concat "\\[#[A-Z]\\]") '(0 'org-warning-face t)) | |
1512 (list (concat "\\<" org-deadline-string) '(0 'org-warning-face t)) | |
1513 (list (concat "\\<" org-scheduled-string) '(0 'org-warning-face t)) | |
1514 ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" | |
1515 ;; (3 'bold)) | |
1516 ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" | |
1517 ;; (3 'italic)) | |
1518 ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" | |
1519 ;; (3 'underline)) | |
1520 '("\\<FIXME\\>" (0 'org-warning-face t)) | |
1521 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") | |
1522 '(1 'org-warning-face t)) | |
1523 '("^#.*" (0 'font-lock-comment-face t)) | |
1524 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") | |
1525 '(1 'org-done-face t)) | |
1526 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" | |
1527 (1 'org-table-face t)) | |
1528 '("^[ \t]*\\(:.*\\)" (1 'org-table-face t))))) | |
1529 (set (make-local-variable 'org-font-lock-keywords) | |
1530 (append | |
1531 (if org-noutline-p ; FIXME: I am not sure if eval will work | |
1532 ; on XEmacs if noutline is ever ported | |
1533 '((eval . (list "^\\(\\*+\\).*" | |
1534 0 '(nth | |
1535 (% (- (match-end 1) (match-beginning 1) 1) | |
1536 org-n-levels) | |
1537 org-level-faces) | |
1538 nil t))) | |
1539 '(("^\\(\\(\\*+\\)[^\r\n]*\\)[\n\r]" | |
1540 (1 (nth (% (- (match-end 2) (match-beginning 2) 1) | |
1541 org-n-levels) | |
1542 org-level-faces) | |
1543 nil t)))) | |
1544 org-font-lock-extra-keywords)) | |
1545 (set (make-local-variable 'font-lock-defaults) | |
1546 '(org-font-lock-keywords t nil nil backward-paragraph)) | |
1547 (kill-local-variable 'font-lock-keywords) nil)) | |
1548 | |
1549 (defvar org-font-lock-keywords nil) | |
1550 | |
1551 (defun org-unfontify-region (beg end &optional maybe_loudly) | |
1552 "Remove fontification and activation overlays from links." | |
1553 (font-lock-default-unfontify-region beg end) | |
1554 (let* ((modified (buffer-modified-p)) ;; FIXME: Why did I add this??? | |
1555 (buffer-undo-list t) | |
1556 (inhibit-read-only t) (inhibit-point-motion-hooks t) | |
1557 (inhibit-modification-hooks t) | |
1558 deactivate-mark buffer-file-name buffer-file-truename) | |
1559 (remove-text-properties beg end '(mouse-face nil keymap nil)))) | |
1560 | |
1561 ;;; Visibility cycling | |
1562 | |
1563 (defvar org-cycle-global-status nil) | |
1564 (defvar org-cycle-subtree-status nil) | |
1565 (defun org-cycle (&optional arg) | |
59547
dbd07a2c89d3
*** empty log message ***
Carsten Dominik <dominik@science.uva.nl>
parents:
59546
diff
changeset
|
1566 "Visibility cycling for org-mode. |
58792 | 1567 |
1568 - When this function is called with a prefix argument, rotate the entire | |
1569 buffer through 3 states (global cycling) | |
1570 1. OVERVIEW: Show only top-level headlines. | |
1571 2. CONTENTS: Show all headlines of all levels, but no body text. | |
1572 3. SHOW ALL: Show everything. | |
1573 | |
1574 - When point is at the beginning of a headline, rotate the subtree started | |
1575 by this line through 3 different states (local cycling) | |
1576 1. FOLDED: Only the main headline is shown. | |
1577 2. CHILDREN: The main headline and the direct children are shown. From | |
1578 this state, you can move to one of the children and | |
1579 zoom in further. | |
1580 3. SUBTREE: Show the entire subtree, including body text. | |
1581 | |
1582 - When point is not at the beginning of a headline, execute | |
1583 `indent-relative', like TAB normally does. See the option | |
1584 `org-cycle-emulate-tab' for details. | |
1585 | |
1586 - Special case: if point is the the beginning of the buffer and there is | |
1587 no headline in line 1, this function will act as if called with prefix arg." | |
1588 (interactive "P") | |
1589 | |
1590 (if (and (bobp) (not (looking-at outline-regexp))) | |
1591 ; special case: use global cycling | |
1592 (setq arg t)) | |
1593 | |
1594 (cond | |
1595 | |
1596 ((org-at-table-p 'any) | |
1597 ;; Enter the table or move to the next field in the table | |
1598 (or (org-table-recognize-table.el) | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
1599 (progn |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
1600 (org-table-justify-field-maybe) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
1601 (org-table-next-field)))) |
58792 | 1602 |
1603 (arg ;; Global cycling | |
1604 | |
1605 (cond | |
1606 ((and (eq last-command this-command) | |
1607 (eq org-cycle-global-status 'overview)) | |
1608 ;; We just created the overview - now do table of contents | |
1609 ;; This can be slow in very large buffers, so indicate action | |
1610 (message "CONTENTS...") | |
1611 (save-excursion | |
1612 ;; Visit all headings and show their offspring | |
1613 (goto-char (point-max)) | |
1614 (catch 'exit | |
1615 (while (and (progn (condition-case nil | |
1616 (outline-previous-visible-heading 1) | |
1617 (error (goto-char (point-min)))) | |
1618 t) | |
1619 (looking-at outline-regexp)) | |
1620 (show-branches) | |
1621 (if (bobp) (throw 'exit nil)))) | |
1622 (message "CONTENTS...done")) | |
1623 (setq org-cycle-global-status 'contents)) | |
1624 ((and (eq last-command this-command) | |
1625 (eq org-cycle-global-status 'contents)) | |
1626 ;; We just showed the table of contents - now show everything | |
1627 (show-all) | |
1628 (message "SHOW ALL") | |
1629 (setq org-cycle-global-status 'all)) | |
1630 (t | |
1631 ;; Default action: go to overview | |
1632 (hide-sublevels 1) | |
1633 (message "OVERVIEW") | |
1634 (setq org-cycle-global-status 'overview)))) | |
1635 | |
1636 ((save-excursion (beginning-of-line 1) (looking-at outline-regexp)) | |
1637 ;; At a heading: rotate between three different views | |
1638 (org-back-to-heading) | |
1639 (let ((goal-column 0) beg eoh eol eos nxh) | |
1640 ;; First, some boundaries | |
1641 (save-excursion | |
1642 (org-back-to-heading) (setq beg (point)) | |
1643 (save-excursion | |
1644 (beginning-of-line 2) | |
1645 (while (and (not (eobp)) ;; this is like `next-line' | |
1646 (get-char-property (1- (point)) 'invisible)) | |
1647 (beginning-of-line 2)) (setq eol (point))) | |
1648 (outline-end-of-heading) (setq eoh (point)) | |
1649 (outline-end-of-subtree) (setq eos (point)) | |
1650 (outline-next-heading) (setq nxh (point))) | |
1651 ;; Find out what to do next and set `this-command' | |
1652 (cond | |
1653 ((= eos eoh) | |
1654 ;; Nothing is hidden behind this heading | |
1655 (message "EMPTY ENTRY") | |
1656 (setq org-cycle-subtree-status nil)) | |
1657 ((>= eol eos) | |
1658 ;; Entire subtree is hidden in one line: open it | |
1659 (show-entry) | |
1660 (show-children) | |
1661 (message "CHILDREN") | |
1662 (setq org-cycle-subtree-status 'children)) | |
1663 ((and (eq last-command this-command) | |
1664 (eq org-cycle-subtree-status 'children)) | |
1665 ;; We just showed the children, now show everything. | |
1666 (show-subtree) | |
1667 (message "SUBTREE") | |
1668 (setq org-cycle-subtree-status 'subtree)) | |
1669 (t | |
1670 ;; Default action: hide the subtree. | |
1671 (hide-subtree) | |
1672 (message "FOLDED") | |
1673 (setq org-cycle-subtree-status 'folded))))) | |
1674 | |
1675 ;; TAB emulation | |
1676 (buffer-read-only (org-back-to-heading)) | |
1677 ((if (and (eq org-cycle-emulate-tab 'white) | |
1678 (save-excursion (beginning-of-line 1) (looking-at "[ \t]+$"))) | |
1679 t | |
1680 (eq org-cycle-emulate-tab t)) | |
1681 (if (and (looking-at "[ \n\r\t]") | |
1682 (string-match "^[ \t]*$" (buffer-substring | |
1683 (point-at-bol) (point)))) | |
1684 (progn | |
1685 (beginning-of-line 1) | |
1686 (and (looking-at "[ \t]+") (replace-match "")))) | |
1687 (indent-relative)) | |
1688 | |
1689 (t (save-excursion | |
1690 (org-back-to-heading) | |
1691 (org-cycle))))) | |
1692 | |
1693 (defvar org-goto-window-configuration nil) | |
1694 (defvar org-goto-marker nil) | |
1695 (defvar org-goto-map (make-sparse-keymap)) | |
1696 (let ((cmds '(isearch-forward isearch-backward)) cmd) | |
1697 (while (setq cmd (pop cmds)) | |
1698 (substitute-key-definition cmd cmd org-goto-map global-map))) | |
1699 (define-key org-goto-map [(return)] 'org-goto-ret) | |
1700 (define-key org-goto-map [(left)] 'org-goto-left) | |
1701 (define-key org-goto-map [(right)] 'org-goto-right) | |
1702 (define-key org-goto-map [(?q)] 'org-goto-quit) | |
1703 (define-key org-goto-map [(control ?g)] 'org-goto-quit) | |
1704 (define-key org-goto-map [(tab)] 'org-cycle) | |
1705 (define-key org-goto-map [(down)] 'outline-next-visible-heading) | |
1706 (define-key org-goto-map [(up)] 'outline-previous-visible-heading) | |
1707 (define-key org-goto-map "n" 'outline-next-visible-heading) | |
1708 (define-key org-goto-map "p" 'outline-previous-visible-heading) | |
1709 (define-key org-goto-map "f" 'outline-forward-same-level) | |
1710 (define-key org-goto-map "b" 'outline-backward-same-level) | |
1711 (define-key org-goto-map "u" 'outline-up-heading) | |
1712 (define-key org-goto-map "\C-c\C-n" 'outline-next-visible-heading) | |
1713 (define-key org-goto-map "\C-c\C-p" 'outline-previous-visible-heading) | |
1714 (define-key org-goto-map "\C-c\C-f" 'outline-forward-same-level) | |
1715 (define-key org-goto-map "\C-c\C-b" 'outline-backward-same-level) | |
1716 (define-key org-goto-map "\C-c\C-u" 'outline-up-heading) | |
1717 (let ((l '(1 2 3 4 5 6 7 8 9 0))) | |
1718 (while l (define-key org-goto-map (int-to-string (pop l)) 'digit-argument))) | |
1719 | |
1720 (defconst org-goto-help | |
1721 "Select a location to jump to, press RET | |
1722 \[Up]/[Down]=next/prev headline TAB=cycle visibility RET=select [Q]uit") | |
1723 | |
1724 (defun org-goto () | |
1725 "Go to a different location of the document, keeping current visibility. | |
1726 | |
1727 When you want to go to a different location in a document, the fastest way | |
1728 is often to fold the entire buffer and then dive into the tree. This | |
1729 method has the disadvantage, than the previous location will be folded, and | |
1730 that can be unwanted. | |
1731 | |
1732 This command works around this by showing a copy of the current buffer in | |
1733 overview mode. You can dive into the tree in that copy, to find the | |
1734 location you want to reach. When pressing RET, the command returns to the | |
1735 original buffer in which the visibility is still unchanged. It then jumps | |
1736 to the new location, making it and the headline hierarchy above it visible." | |
1737 (interactive) | |
1738 (let* ((org-goto-start-pos (point)) | |
1739 (selected-point | |
1740 (org-get-location (current-buffer) org-goto-help))) | |
1741 (if selected-point | |
1742 (progn | |
1743 (goto-char selected-point) | |
1744 (if (org-invisible-p) (org-show-hierarchy-above))) | |
1745 (error "Quit")))) | |
1746 | |
1747 (defun org-get-location (buf help) | |
1748 "Let the user select a location in the Org-mode buffer BUF. | |
1749 This function uses a recursive edit. It returns the selected position | |
1750 or nil." | |
1751 (let (org-selected-point) | |
1752 (save-excursion | |
1753 (save-window-excursion | |
1754 (delete-other-windows) | |
1755 (switch-to-buffer (get-buffer-create "*org-goto*")) | |
1756 (with-output-to-temp-buffer "*Help*" | |
1757 (princ help)) | |
1758 (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*")) | |
1759 (setq buffer-read-only nil) | |
1760 (erase-buffer) | |
1761 (insert-buffer buf) | |
1762 (let ((org-startup-truncated t) | |
1763 (org-startup-folded t) | |
1764 (org-startup-with-deadline-check nil)) | |
1765 (org-mode)) | |
1766 (setq buffer-read-only t) | |
1767 (if (boundp 'org-goto-start-pos) | |
1768 (goto-char org-goto-start-pos) | |
1769 (goto-char (point-min))) | |
1770 (org-beginning-of-line) | |
1771 (message "Select location and press RET") | |
1772 ;; now we make sure that during selection, ony very few keys work | |
1773 ;; and that it is impossible to switch to another window. | |
1774 (let ((gm (current-global-map)) | |
1775 (overriding-local-map org-goto-map)) | |
1776 (unwind-protect | |
1777 (progn | |
1778 (use-global-map org-goto-map) | |
1779 (recursive-edit)) | |
1780 (use-global-map gm))))) | |
1781 (kill-buffer "*org-goto*") | |
1782 org-selected-point)) | |
1783 | |
1784 ;; FIXME: It may not be a good idea to temper with the prefix argument... | |
1785 (defun org-goto-ret (&optional arg) | |
1786 "Finish org-goto by going to the new location." | |
1787 (interactive "P") | |
1788 (setq org-selected-point (point) | |
1789 current-prefix-arg arg) | |
1790 (throw 'exit nil)) | |
1791 | |
1792 (defun org-goto-left (&optional arg) | |
1793 "Finish org-goto by going to the new location." | |
1794 (interactive "P") | |
1795 (if (org-on-heading-p) | |
1796 (progn | |
1797 (beginning-of-line 1) | |
1798 (setq org-selected-point (point) | |
1799 current-prefix-arg (- (match-end 0) (match-beginning 0))) | |
1800 (throw 'exit nil)) | |
1801 (error "Not on a heading"))) | |
1802 | |
1803 (defun org-goto-right (&optional arg) | |
1804 "Finish org-goto by going to the new location." | |
1805 (interactive "P") | |
1806 (if (org-on-heading-p) | |
1807 (progn | |
1808 (outline-end-of-subtree) | |
1809 (or (eobp) (forward-char 1)) | |
1810 (setq org-selected-point (point) | |
1811 current-prefix-arg (- (match-end 0) (match-beginning 0))) | |
1812 (throw 'exit nil)) | |
1813 (error "Not on a heading"))) | |
1814 | |
1815 (defun org-goto-quit () | |
1816 "Finish org-goto without cursor motion." | |
1817 (interactive) | |
1818 (setq org-selected-point nil) | |
1819 (throw 'exit nil)) | |
1820 | |
1821 ;;; Promotion, Demotion, Inserting new headlines | |
1822 | |
1823 (defvar org-ignore-region nil | |
1824 "To temporary disable the active region.") | |
1825 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
1826 (defun org-insert-heading (arg) |
58792 | 1827 "Insert a new heading with same depth at point." |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
1828 (interactive "P") |
58792 | 1829 (let* ((head (save-excursion |
1830 (condition-case nil | |
1831 (org-back-to-heading) | |
1832 (error (outline-next-heading))) | |
1833 (prog1 (match-string 0) | |
1834 (funcall outline-level))))) | |
1835 (unless (bolp) (newline)) | |
1836 (insert head) | |
1837 (unless (eolp) | |
1838 (save-excursion (newline-and-indent))) | |
1839 (unless (equal (char-before) ?\ ) | |
1840 (insert " ")) | |
1841 (run-hooks 'org-insert-heading-hook))) | |
1842 | |
1843 (defun org-promote-subtree (&optional arg) | |
1844 "Promote the entire subtree. | |
1845 See also `org-promote'." | |
1846 (interactive "P") | |
1847 (org-map-tree 'org-promote)) | |
1848 | |
1849 (defun org-demote-subtree (&optional arg) | |
1850 "Demote the entire subtree. See `org-demote'. | |
1851 See also `org-promote'." | |
1852 (interactive "P") | |
1853 (org-map-tree 'org-demote)) | |
1854 | |
1855 (defun org-do-promote (&optional arg) | |
1856 "Promote the current heading higher up the tree. | |
1857 If the region is active in transient-mark-mode, promote all headings | |
1858 in the region." | |
1859 (interactive "P") | |
1860 (save-excursion | |
1861 (if (org-region-active-p) | |
1862 (org-map-region 'org-promote (region-beginning) (region-end)) | |
1863 (org-promote))) | |
1864 (org-fix-position-after-promote)) | |
1865 | |
1866 (defun org-do-demote (&optional arg) | |
1867 "Demote the current heading lower down the tree. | |
1868 If the region is active in transient-mark-mode, demote all headings | |
1869 in the region." | |
1870 (interactive "P") | |
1871 (save-excursion | |
1872 (if (org-region-active-p) | |
1873 (org-map-region 'org-demote (region-beginning) (region-end)) | |
1874 (org-demote))) | |
1875 (org-fix-position-after-promote)) | |
1876 | |
1877 (defun org-fix-position-after-promote () | |
1878 "Make sure that after pro/demotion cursor position is right." | |
1879 (and (equal (char-after) ?\ ) | |
1880 (equal (char-before) ?*) | |
1881 (forward-char 1))) | |
1882 | |
1883 (defun org-promote () | |
1884 "Promote the current heading higher up the tree. | |
1885 If the region is active in transient-mark-mode, promote all headings | |
1886 in the region." | |
1887 (org-back-to-heading t) | |
1888 (let* ((level (save-match-data (funcall outline-level))) | |
1889 (up-head (make-string (1- level) ?*))) | |
1890 (if (= level 1) (error "Cannot promote to level 0. UNDO to recover.")) | |
1891 (replace-match up-head nil t) | |
1892 (if org-adapt-indentation | |
1893 (org-fixup-indentation "^ " "" "^ ?\\S-")))) | |
1894 | |
1895 (defun org-demote () | |
1896 "Demote the current heading lower down the tree. | |
1897 If the region is active in transient-mark-mode, demote all headings | |
1898 in the region." | |
1899 (org-back-to-heading t) | |
1900 (let* ((level (save-match-data (funcall outline-level))) | |
1901 (down-head (make-string (1+ level) ?*))) | |
1902 (replace-match down-head nil t) | |
1903 (if org-adapt-indentation | |
1904 (org-fixup-indentation "^ " " " "^\\S-")))) | |
1905 | |
1906 (defun org-map-tree (fun) | |
1907 "Call FUN for every heading underneath the current one." | |
1908 (org-back-to-heading) | |
1909 (let ((level (outline-level))) | |
1910 (save-excursion | |
1911 (funcall fun) | |
1912 (while (and (progn | |
1913 (outline-next-heading) | |
1914 (> (funcall outline-level) level)) | |
1915 (not (eobp))) | |
1916 (funcall fun))))) | |
1917 | |
1918 (defun org-map-region (fun beg end) | |
1919 "Call FUN for every heading between BEG and END." | |
1920 (let ((org-ignore-region t)) | |
1921 (save-excursion | |
1922 (setq end (copy-marker end)) | |
1923 (goto-char beg) | |
1924 ;; (if (fboundp 'deactivate-mark) (deactivate-mark)) | |
1925 ;; (if (fboundp 'zmacs-deactivate-region) (zmacs-deactivate-region)) | |
1926 (if (and (re-search-forward (concat "^" outline-regexp) nil t) | |
1927 (< (point) end)) | |
1928 (funcall fun)) | |
1929 (while (and (progn | |
1930 (outline-next-heading) | |
1931 (< (point) end)) | |
1932 (not (eobp))) | |
1933 (funcall fun))))) | |
1934 | |
1935 (defun org-fixup-indentation (from to prohibit) | |
1936 "Change the indentation in the current entry by re-replacing FROM with TO. | |
1937 However, if the regexp PROHIBIT matches at all, don't do anything. | |
1938 This is being used to change indentation along with the length of the | |
1939 heading marker. But if there are any lines which are not indented, nothing | |
1940 is changed at all." | |
1941 (save-excursion | |
1942 (let ((end (save-excursion (outline-next-heading) | |
1943 (point-marker)))) | |
1944 (unless (save-excursion (re-search-forward prohibit end t)) | |
1945 (while (re-search-forward from end t) | |
1946 (replace-match to) | |
1947 (beginning-of-line 2))) | |
1948 (move-marker end nil)))) | |
1949 | |
1950 ;;; Vertical tree motion, cutting and pasting of subtrees | |
1951 | |
1952 (defun org-move-subtree-up (&optional arg) | |
1953 "Move the current subtree up past ARG headlines of the same level." | |
1954 (interactive "p") | |
1955 (org-move-subtree-down (- (prefix-numeric-value arg)))) | |
1956 | |
1957 (defun org-move-subtree-down (&optional arg) | |
1958 "Move the current subtree down past ARG headlines of the same level." | |
1959 (interactive "p") | |
1960 (setq arg (prefix-numeric-value arg)) | |
1961 (let ((movfunc (if (> arg 0) 'outline-get-next-sibling | |
1962 'outline-get-last-sibling)) | |
1963 (ins-point (make-marker)) | |
1964 (cnt (abs arg)) | |
1965 beg end txt folded) | |
1966 ;; Select the tree | |
1967 (org-back-to-heading) | |
1968 (setq beg (point)) | |
1969 (save-match-data | |
1970 (save-excursion (outline-end-of-heading) | |
1971 (setq folded (org-invisible-p))) | |
1972 (outline-end-of-subtree)) | |
1973 (if (equal (char-after) ?\n) (forward-char 1)) | |
1974 (setq end (point)) | |
1975 ;; Find insertion point, with error handling | |
1976 (goto-char beg) | |
1977 (while (> cnt 0) | |
1978 (or (and (funcall movfunc) (looking-at outline-regexp)) | |
1979 (progn (goto-char beg) | |
1980 (error "Cannot move past superior level or buffer limit"))) | |
1981 (setq cnt (1- cnt))) | |
1982 (if (> arg 0) | |
1983 ;; Moving forward - still need to move over subtree | |
1984 (progn (outline-end-of-subtree) | |
1985 (if (equal (char-after) ?\n) (forward-char 1)))) | |
1986 (move-marker ins-point (point)) | |
1987 (setq txt (buffer-substring beg end)) | |
1988 (delete-region beg end) | |
1989 (insert txt) | |
1990 (goto-char ins-point) | |
1991 (if folded (hide-subtree)) | |
1992 (move-marker ins-point nil))) | |
1993 | |
1994 (defvar org-subtree-clip "" | |
1995 "Clipboard for cut and paste of subtrees. | |
1996 This is actually only a cpoy of the kill, because we use the normal kill | |
1997 ring. We need it to check if the kill was created by `org-copy-subtree'.") | |
1998 | |
1999 (defvar org-subtree-clip-folded nil | |
2000 "Was the last copied suptree folded? | |
2001 This is used to fold the tree back after pasting.") | |
2002 | |
2003 (defun org-cut-subtree (&optional arg) | |
2004 "Cut the current subtree into the clipboard. | |
2005 This is a short-hand for marking the subtree and then cutting it." | |
2006 (interactive "p") | |
2007 (org-copy-subtree arg 'cut)) | |
2008 | |
2009 (defun org-copy-subtree (&optional arg cut) | |
2010 "Cut the current subtree into the clipboard. | |
2011 This is a short-hand for marking the subtree and then copying it. | |
2012 If CUT is non nil, actually cur the subtree." | |
2013 (interactive "p") | |
2014 (let (beg end folded) | |
2015 (org-back-to-heading) | |
2016 (setq beg (point)) | |
2017 (save-match-data | |
2018 (save-excursion (outline-end-of-heading) | |
2019 (setq folded (org-invisible-p))) | |
2020 (outline-end-of-subtree)) | |
2021 (if (equal (char-after) ?\n) (forward-char 1)) | |
2022 (setq end (point)) | |
2023 (goto-char beg) | |
2024 (when (> end beg) | |
2025 (setq org-subtree-clip-folded folded) | |
2026 (if cut (kill-region beg end) (copy-region-as-kill beg end)) | |
2027 (setq org-subtree-clip (current-kill 0)) | |
2028 (message "%s: Subtree with %d characters" | |
2029 (if cut "Cut" "Copied") | |
2030 (length org-subtree-clip))))) | |
2031 | |
2032 (defun org-paste-subtree (&optional level tree) | |
2033 "Paste the clipboard as a subtree, with modification of headline level. | |
2034 The entire subtree is promoted or demoted in order to match a new headline | |
2035 level. By default, the new level is derived from the visible headings | |
2036 before and after the insertion point, and taken to be the inferior headline | |
2037 level of the two. So if the previous visible heading is level 3 and the | |
2038 next is level 4 (or vice versa), level 4 will be used for insertion. | |
2039 This makes sure that the subtree remains an independent subtree and does | |
2040 not swallow low level entries. | |
2041 | |
2042 You can also force a different level, either by using a numeric prefix | |
2043 argument, or by inserting the heading marker by hand. For example, if the | |
2044 cursor is after \"*****\", then the tree will be shifted to level 5. | |
2045 | |
2046 If you want to insert the tree as is, just use \\[yank]. | |
2047 | |
2048 If optional TREE is given, use this text instead of the kill ring." | |
2049 (interactive "P") | |
2050 (unless (org-kill-is-subtree-p tree) | |
2051 (error | |
2052 (substitute-command-keys | |
2053 "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) | |
2054 (let* ((txt (or tree (current-kill 0))) | |
2055 (^re (concat "^\\(" outline-regexp "\\)")) | |
2056 (re (concat "\\(" outline-regexp "\\)")) | |
2057 (^re_ (concat "\\(" outline-regexp "\\)[ \t]*")) | |
2058 | |
2059 (old-level (if (string-match ^re txt) | |
2060 (- (match-end 0) (match-beginning 0)) | |
2061 -1)) | |
2062 (force-level (cond (level (prefix-numeric-value level)) | |
2063 ((string-match | |
2064 ^re_ (buffer-substring (point-at-bol) (point))) | |
2065 (- (match-end 0) (match-beginning 0))) | |
2066 (t nil))) | |
2067 (prevous-level (save-excursion | |
2068 (outline-previous-visible-heading 1) | |
2069 (if (looking-at re) | |
2070 (- (match-end 0) (match-beginning 0)) | |
2071 1))) | |
2072 (next-level (save-excursion | |
2073 (outline-next-visible-heading 1) | |
2074 (if (looking-at re) | |
2075 (- (match-end 0) (match-beginning 0)) | |
2076 1))) | |
2077 (new-level (or force-level (max prevous-level next-level))) | |
2078 (shift (if (or (= old-level -1) | |
2079 (= new-level -1) | |
2080 (= old-level new-level)) | |
2081 0 | |
2082 (- new-level old-level))) | |
2083 (shift1 shift) | |
2084 (delta (if (> shift 0) -1 1)) | |
2085 (func (if (> shift 0) 'org-demote 'org-promote)) | |
2086 beg end) | |
2087 ;; Remove the forces level indicator | |
2088 (if force-level | |
2089 (delete-region (point-at-bol) (point))) | |
2090 ;; Make sure we start at the beginning of an empty line | |
2091 (if (not (bolp)) (insert "\n")) | |
2092 (if (not (looking-at "[ \t]*$")) | |
2093 (progn (insert "\n") (backward-char 1))) | |
2094 ;; Paste | |
2095 (setq beg (point)) | |
2096 (insert txt) | |
2097 (setq end (point)) | |
2098 (goto-char beg) | |
2099 ;; Shift if necessary | |
2100 (if (= shift 0) | |
2101 (message "Pasted at level %d, without shift" new-level) | |
2102 (save-restriction | |
2103 (narrow-to-region beg end) | |
2104 (while (not (= shift 0)) | |
2105 (org-map-region func (point-min) (point-max)) | |
2106 (setq shift (+ delta shift))) | |
2107 (goto-char (point-min)) | |
2108 (message "Pasted at level %d, with shift by %d levels" | |
2109 new-level shift1))) | |
2110 (if (and (eq org-subtree-clip (current-kill 0)) | |
2111 org-subtree-clip-folded) | |
2112 ;; The tree was folded before it was killed/copied | |
2113 (hide-subtree)))) | |
2114 | |
2115 (defun org-kill-is-subtree-p (&optional txt) | |
2116 "Check if the current kill is an outline subtree, or a set of trees. | |
2117 Returns nil if kill does not start with a headline, or if the first | |
2118 headline level is not the largest headline level in the tree. | |
2119 So this will actually acceept several entries of equal levels as well, | |
2120 which is OK for `org-paste-subtree'. | |
2121 If optional TXT is given, check this string instead of the current kill." | |
2122 (let* ((kill (or txt (current-kill 0) "")) | |
2123 (start-level (and (string-match (concat "\\`" outline-regexp) kill) | |
2124 (- (match-end 0) (match-beginning 0)))) | |
2125 (re (concat "^" outline-regexp)) | |
2126 (start 1)) | |
2127 (if (not start-level) | |
2128 nil ;; does not even start with a heading | |
2129 (catch 'exit | |
2130 (while (setq start (string-match re kill (1+ start))) | |
2131 (if (< (- (match-end 0) (match-beginning 0)) start-level) | |
2132 (throw 'exit nil))) | |
2133 t)))) | |
2134 | |
2135 ;;; Completion | |
2136 | |
2137 (defun org-complete (&optional arg) | |
2138 "Perform completion on word at point. | |
2139 At the beginning of a headline, this completes TODO keywords as given in | |
2140 `org-todo-keywords'. | |
2141 If the current word is preceeded by a backslash, completes the TeX symbols | |
2142 that are supported for HTML support. | |
2143 If the current word is preceeded by \"#+\", completes special words for | |
2144 setting file options. | |
2145 At all other locations, this simply calls `ispell-complete-word'." | |
2146 (interactive "P") | |
2147 (catch 'exit | |
2148 (let* ((end (point)) | |
2149 (beg (save-excursion | |
2150 (if (equal (char-before (point)) ?\ ) (backward-char 1)) | |
2151 (skip-chars-backward "a-zA-Z0-9_:") | |
2152 (point))) | |
2153 (texp (equal (char-before beg) ?\\)) | |
2154 (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) | |
2155 beg) | |
2156 "#+")) | |
2157 (pattern (buffer-substring-no-properties beg end)) | |
2158 (completion-ignore-case opt) | |
2159 (type nil) | |
2160 (table (cond | |
2161 (opt | |
2162 (setq type :opt) | |
2163 (mapcar (lambda (x) | |
2164 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) | |
2165 (cons (match-string 2 x) (match-string 1 x))) | |
2166 (org-split-string (org-get-current-options) "\n"))) | |
2167 (texp | |
2168 (setq type :tex) | |
2169 org-html-entities) | |
2170 ((string-match "\\`\\*+[ \t]*\\'" | |
2171 (buffer-substring (point-at-bol) beg)) | |
2172 (setq type :todo) | |
2173 (mapcar 'list org-todo-keywords)) | |
2174 (t (progn (ispell-complete-word arg) (throw 'exit nil))))) | |
2175 (completion (try-completion pattern table))) | |
2176 (cond ((eq completion t) | |
2177 (if (equal type :opt) | |
2178 (insert (substring (cdr (assoc (upcase pattern) table)) | |
2179 (length pattern))))) | |
2180 ((null completion) | |
2181 (message "Can't find completion for \"%s\"" pattern) | |
2182 (ding)) | |
2183 ((not (string= pattern completion)) | |
2184 (delete-region beg end) | |
2185 (if (string-match " +$" completion) | |
2186 (setq completion (replace-match "" t t completion))) | |
2187 (insert completion) | |
2188 (if (get-buffer-window "*Completions*") | |
2189 (delete-window (get-buffer-window "*Completions*"))) | |
2190 (if (and (eq type :todo) | |
2191 (assoc completion table)) | |
2192 (insert " ")) | |
2193 (if (and (equal type :opt) (assoc completion table)) | |
2194 (message (substitute-command-keys | |
2195 "Press \\[org-complete] again to insert example settings")))) | |
2196 (t | |
2197 (message "Making completion list...") | |
2198 (let ((list (sort (all-completions pattern table) 'string<))) | |
2199 (with-output-to-temp-buffer "*Completions*" | |
2200 (display-completion-list list))) | |
2201 (message "Making completion list...%s" "done")))))) | |
2202 | |
2203 ;;; Comments, TODO and DEADLINE | |
2204 | |
2205 (defun org-toggle-comment () | |
2206 "Change the COMMENT state of an entry." | |
2207 (interactive) | |
2208 (save-excursion | |
2209 (org-back-to-heading) | |
2210 (if (looking-at (concat outline-regexp | |
2211 "\\( +\\<" org-comment-string "\\>\\)")) | |
2212 (replace-match "" t t nil 1) | |
2213 (if (looking-at outline-regexp) | |
2214 (progn | |
2215 (goto-char (match-end 0)) | |
2216 (insert " " org-comment-string)))))) | |
2217 | |
2218 (defun org-todo (&optional arg) | |
2219 "Change the TODO state of an item. | |
2220 The state of an item is given by a keyword at the start of the heading, | |
2221 like | |
2222 *** TODO Write paper | |
2223 *** DONE Call mom | |
2224 | |
2225 The different keywords are specified in the variable `org-todo-keywords'. By | |
2226 default the available states are \"TODO\" and \"DONE\". | |
2227 So for this example: when the item starts with TODO, it is changed to DONE. | |
2228 When it starts with DONE, the DONE is removed. And when neither TODO nor | |
2229 DONE are present, add TODO at the beginning of the heading. | |
2230 | |
2231 With prefix arg, use completion to determined the new state. With numeric | |
2232 prefix arg, switch to that state." | |
2233 (interactive "P") | |
2234 (save-excursion | |
2235 (org-back-to-heading) | |
2236 (if (looking-at outline-regexp) (goto-char (match-end 0))) | |
2237 (or (looking-at (concat " +" org-todo-regexp " *")) | |
2238 (looking-at " *")) | |
2239 (let* ((this (match-string 1)) | |
2240 (completion-ignore-case t) | |
2241 (member (member this org-todo-keywords)) | |
2242 (tail (cdr member)) | |
2243 (state (cond | |
2244 ((equal arg '(4)) | |
2245 ;; Read a state with completion | |
2246 (completing-read "State: " (mapcar (lambda(x) (list x)) | |
2247 org-todo-keywords) | |
2248 nil t)) | |
2249 (arg | |
2250 ;; user requests a specific state | |
2251 (nth (1- (prefix-numeric-value arg)) | |
2252 org-todo-keywords)) | |
2253 ((null member) (car org-todo-keywords)) | |
2254 ((null tail) nil) ;; -> first entry | |
2255 ((eq org-todo-interpretation 'sequence) | |
2256 (car tail)) | |
2257 ((memq org-todo-interpretation '(type priority)) | |
2258 (if (eq this-command last-command) | |
2259 (car tail) | |
2260 (if (> (length tail) 0) org-done-string nil))) | |
2261 (t nil))) | |
2262 (next (if state (concat " " state " ") " "))) | |
2263 (replace-match next t t) | |
2264 (run-hooks 'org-after-todo-state-change-hook))) | |
2265 ;; Fixup cursor location if close to the keyword | |
2266 (if (and (outline-on-heading-p) | |
2267 (not (bolp)) | |
2268 (save-excursion (goto-char (point-at-bol)) | |
2269 (looking-at org-todo-line-regexp)) | |
2270 (< (point) (+ 2 (or (match-end 2) (match-end 1))))) | |
2271 (progn | |
2272 (goto-char (or (match-end 2) (match-end 1))) | |
2273 (just-one-space)))) | |
2274 | |
2275 (defun org-show-todo-tree (arg) | |
2276 "Make a compact tree which shows all headlines marked with TODO. | |
2277 The tree will show the lines where the regexp matches, and all higher | |
2278 headlines above the match." | |
2279 (interactive "P") | |
2280 (let ((case-fold-search nil) | |
2281 (kwd-re (if arg org-todo-regexp org-not-done-regexp))) | |
2282 (message "%d TODO entries found" | |
2283 (org-occur (concat "^" outline-regexp " +" kwd-re ))))) | |
2284 | |
2285 (defun org-deadline () | |
2286 "Insert the DEADLINE: string to make a deadline. | |
2287 A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] | |
2288 to modify it to the correct date." | |
2289 (interactive) | |
2290 (insert | |
2291 org-deadline-string " " | |
2292 (format-time-string (car org-time-stamp-formats) | |
2293 (org-read-date nil 'to-time))) | |
2294 (message (substitute-command-keys | |
2295 "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) | |
2296 | |
2297 (defun org-schedule () | |
2298 "Insert the SCHEDULED: string to schedule a TODO item. | |
2299 A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] | |
2300 to modify it to the correct date." | |
2301 (interactive) | |
2302 (insert | |
2303 org-scheduled-string " " | |
2304 (format-time-string (car org-time-stamp-formats) | |
2305 (org-read-date nil 'to-time))) | |
2306 (message (substitute-command-keys | |
2307 "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) | |
2308 | |
2309 | |
2310 (defun org-occur (regexp &optional callback) | |
2311 "Make a compact tree which shows all matches of REGEXP. | |
2312 The tree will show the lines where the regexp matches, and all higher | |
2313 headlines above the match. It will also show the heading after the match, | |
2314 to make sure editing the matching entry is easy. | |
2315 if CALLBACK is non-nil, it is a function which is called to confirm | |
2316 that the match should indeed be shown." | |
2317 (interactive "sRegexp: ") | |
2318 (setq regexp (org-check-occur-regexp regexp)) | |
2319 (let ((cnt 0)) | |
2320 (save-excursion | |
2321 (goto-char (point-min)) | |
2322 (hide-sublevels 1) | |
2323 (while (re-search-forward regexp nil t) | |
2324 (when (or (not callback) | |
2325 (funcall callback)) | |
2326 (setq cnt (1+ cnt)) | |
2327 (org-show-hierarchy-above)))) | |
2328 (if (interactive-p) | |
2329 (message "%d match(es) for regexp %s" cnt regexp)) | |
2330 cnt)) | |
2331 | |
2332 (defun org-show-hierarchy-above () | |
2333 "Make sure point and the headings hierarchy above is visible." | |
2334 (if (org-on-heading-p t) | |
2335 (org-flag-heading nil) ; only show the heading | |
2336 (org-show-hidden-entry)) ; show entire entry | |
2337 (save-excursion | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
2338 (and org-show-following-heading |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
2339 (outline-next-heading) |
58792 | 2340 (org-flag-heading nil))) ; show the next heading |
2341 (save-excursion ; show all higher headings | |
2342 (while (condition-case nil | |
2343 (progn (org-up-heading-all 1) t) | |
2344 (error nil)) | |
2345 (org-flag-heading nil)))) | |
2346 | |
2347 ;;; Priorities | |
2348 | |
2349 (defvar org-priority-regexp ".*?\\(\\[#\\([A-Z]\\)\\] ?\\)" | |
2350 "Regular expression matching the priority indicator.") | |
2351 | |
2352 (defun org-priority-up () | |
2353 "Increase the priority of the current item." | |
2354 (interactive) | |
2355 (org-priority 'up)) | |
2356 | |
2357 (defun org-priority-down () | |
2358 "Decrease the priority of the current item." | |
2359 (interactive) | |
2360 (org-priority 'down)) | |
2361 | |
2362 (defun org-priority (&optional action) | |
2363 "Change the priority of an item by ARG. | |
2364 ACTION can be set, up, or down." | |
2365 (interactive) | |
2366 (setq action (or action 'set)) | |
2367 (let (current new news have remove) | |
2368 (save-excursion | |
2369 (org-back-to-heading) | |
2370 (if (looking-at org-priority-regexp) | |
2371 (setq current (string-to-char (match-string 2)) | |
2372 have t) | |
2373 (setq current org-default-priority)) | |
2374 (cond | |
2375 ((eq action 'set) | |
2376 (message (format "Priority A-%c, SPC to remove: " org-lowest-priority)) | |
2377 (setq new (read-char-exclusive)) | |
2378 (if (equal new ?\ ) (setq remove t))) | |
2379 ((eq action 'up) | |
2380 (setq new (1- current))) | |
2381 ((eq action 'down) | |
2382 (setq new (1+ current))) | |
2383 (t (error "Illegal ection"))) | |
2384 (setq new (min (max ?A (upcase new)) org-lowest-priority)) | |
2385 (setq news (format "%c" new)) | |
2386 (if have | |
2387 (if remove | |
2388 (replace-match "" t t nil 1) | |
2389 (replace-match news t t nil 2)) | |
2390 (looking-at org-todo-line-regexp) | |
2391 (if (match-end 2) | |
2392 (progn | |
2393 (goto-char (match-end 2)) | |
2394 (insert " [#" news "]")) | |
2395 (goto-char (match-beginning 3)) | |
2396 (insert "[#" news "] ")))) | |
2397 (if remove | |
2398 (message "Priority removed") | |
2399 (message "Priority of current item set to %s" news)))) | |
2400 | |
2401 | |
2402 (defun org-get-priority (s) | |
2403 "Find priority cookie and return priority." | |
2404 (save-match-data | |
2405 (if (not (string-match org-priority-regexp s)) | |
2406 (* 1000 (- org-lowest-priority org-default-priority)) | |
2407 (* 1000 (- org-lowest-priority | |
2408 (string-to-char (match-string 2 s))))))) | |
2409 | |
2410 ;;; Timestamps | |
2411 | |
2412 (defvar org-last-changed-timestamp nil) | |
2413 | |
2414 (defun org-time-stamp (arg) | |
2415 "Prompt for a date/time and insert a time stamp. | |
2416 If the user specifies a time like HH:MM, or if this command is called | |
2417 with a prefix argument, the time stamp will contain date and time. | |
2418 Otherwise, only the date will be included. All parts of a date not | |
2419 specified by the user will be filled in from the current date/time. | |
2420 So if you press just return without typing anything, the time stamp | |
2421 will represent the current date/time. If there is already a timestamp | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
2422 at the cursor, it will be modified." |
58792 | 2423 (interactive "P") |
2424 (let ((fmt (if arg (cdr org-time-stamp-formats) | |
2425 (car org-time-stamp-formats))) | |
2426 (org-time-was-given nil) | |
2427 time) | |
2428 (cond | |
2429 ((and (org-at-timestamp-p) | |
2430 (eq last-command 'org-time-stamp) | |
2431 (eq this-command 'org-time-stamp)) | |
2432 (insert "--") | |
2433 (setq time (let ((this-command this-command)) | |
2434 (org-read-date arg 'totime))) | |
2435 (if org-time-was-given (setq fmt (cdr org-time-stamp-formats))) | |
2436 (insert (format-time-string fmt time))) | |
2437 ((org-at-timestamp-p) | |
2438 (setq time (let ((this-command this-command)) | |
2439 (org-read-date arg 'totime))) | |
2440 (and (org-at-timestamp-p) (replace-match | |
2441 (setq org-last-changed-timestamp | |
2442 (format-time-string fmt time)) | |
2443 t t)) | |
2444 (message "Timestamp updated")) | |
2445 (t | |
2446 (setq time (let ((this-command this-command)) | |
2447 (org-read-date arg 'totime))) | |
2448 (if org-time-was-given (setq fmt (cdr org-time-stamp-formats))) | |
2449 (insert (format-time-string fmt time)))))) | |
2450 | |
2451 ;;; FIXME: Make the function take "Fri" as "next friday" | |
2452 (defun org-read-date (&optional with-time to-time) | |
2453 "Read a date and make things smooth for the user. | |
2454 The prompt will suggest to enter an ISO date, but you can also enter anything | |
2455 which will at least partially be understood by `parse-time-string'. | |
2456 Unrecognized parts of the date will default to the current day, month ,year, | |
2457 hour and minute. For example, | |
2458 3-2-5 --> 2003-02-05 | |
2459 feb 15 --> currentyear-02-15 | |
2460 sep 12 9 --> 2009-09-12 | |
2461 12:45 --> today 12:45 | |
2462 22 sept 0:34 --> currentyear-09-22 0:34 | |
2463 12 --> currentyear-currentmonth-12 | |
2464 etc. | |
2465 The function understands only English month and weekday abbreviations, | |
2466 but this can be configured with the variables `parse-time-months' and | |
2467 `parse-time-weekdays'. | |
2468 | |
2469 While prompting, a calendar is popped up - you can also select the | |
2470 date with the mouse (button 1). The calendar shows a period of three | |
2471 month. To scroll it to other months, use the keys `>' and `<'. | |
2472 If you don't like the calendar, turn it off with | |
2473 \(setq org-popup-calendar-for-date-prompt nil). | |
2474 | |
2475 With optional argument TO-TIME, the date will immediately be converted | |
2476 to an internal time. | |
2477 With an optional argument WITH-TIME, the prompt will suggest to also | |
2478 insert a time. Note that when WITH-TIME is not set, you can still | |
2479 enter a time, and this function will inform the calling routine about | |
2480 this change. The calling routine may then choose to change the format | |
2481 used to insert the time stamp into the buffer to include the time." | |
2482 (let* ((default-time | |
2483 ;; Default time is either today, or, when entering a range, | |
2484 ;; the range start. | |
2485 (if (save-excursion | |
2486 (re-search-backward | |
2487 (concat org-ts-regexp "--\\=") | |
2488 (- (point) 20) t)) | |
2489 (apply | |
2490 'encode-time | |
2491 (mapcar (lambda(x) (or x 0)) ;; FIXME: Problem with timezone? | |
2492 (parse-time-string (match-string 1)))) | |
2493 (current-time))) | |
2494 (timestr (format-time-string | |
2495 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time)) | |
2496 (prompt (format "YYYY-MM-DD [%s]: " timestr)) | |
2497 ans ans1 ans2 | |
2498 second minute hour day month year tl) | |
2499 | |
2500 (if org-popup-calendar-for-date-prompt | |
2501 ;; Also show a calendar for date selection | |
2502 ;; Copied (with modifications) from planner.el by John Wiegley | |
2503 (save-excursion | |
2504 (save-window-excursion | |
2505 (calendar) | |
2506 (calendar-forward-day (- (time-to-days default-time) | |
2507 (calendar-absolute-from-gregorian | |
2508 (calendar-current-date)))) | |
2509 (let* ((old-map (current-local-map)) | |
2510 (map (copy-keymap calendar-mode-map)) | |
2511 (minibuffer-local-map (copy-keymap minibuffer-local-map))) | |
2512 (define-key map (kbd "RET") 'org-calendar-select) | |
2513 (define-key map (if org-xemacs-p [button1] [mouse-1]) | |
2514 'org-calendar-select) | |
2515 (define-key minibuffer-local-map [(meta shift left)] | |
2516 (lambda () (interactive) | |
2517 (org-eval-in-calendar '(calendar-backward-month 1)))) | |
2518 (define-key minibuffer-local-map [(meta shift right)] | |
2519 (lambda () (interactive) | |
2520 (org-eval-in-calendar '(calendar-forward-month 1)))) | |
2521 (define-key minibuffer-local-map [(shift up)] | |
2522 (lambda () (interactive) | |
2523 (org-eval-in-calendar '(calendar-backward-week 1)))) | |
2524 (define-key minibuffer-local-map [(shift down)] | |
2525 (lambda () (interactive) | |
2526 (org-eval-in-calendar '(calendar-forward-week 1)))) | |
2527 (define-key minibuffer-local-map [(shift left)] | |
2528 (lambda () (interactive) | |
2529 (org-eval-in-calendar '(calendar-backward-day 1)))) | |
2530 (define-key minibuffer-local-map [(shift right)] | |
2531 (lambda () (interactive) | |
2532 (org-eval-in-calendar '(calendar-forward-day 1)))) | |
2533 (define-key minibuffer-local-map ">" | |
2534 (lambda () (interactive) | |
2535 (org-eval-in-calendar '(scroll-calendar-left 1)))) | |
2536 (define-key minibuffer-local-map "<" | |
2537 (lambda () (interactive) | |
2538 (org-eval-in-calendar '(scroll-calendar-right 1)))) | |
2539 (unwind-protect | |
2540 (progn | |
2541 (use-local-map map) | |
2542 (setq ans (read-string prompt "" nil nil)) | |
2543 (setq ans (or ans1 ans2 ans))) | |
2544 (use-local-map old-map))))) | |
2545 ;; Naked prompt only | |
2546 (setq ans (read-string prompt "" nil timestr))) | |
2547 | |
2548 (if (string-match | |
2549 "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans) | |
2550 (progn | |
2551 (setq year (if (match-end 2) | |
2552 (string-to-number (match-string 2 ans)) | |
2553 (string-to-number (format-time-string "%Y"))) | |
2554 month (string-to-number (match-string 3 ans)) | |
2555 day (string-to-number (match-string 4 ans))) | |
2556 (if (< year 100) (setq year (+ 2000 year))) | |
2557 (setq ans (replace-match (format "%04d-%02d-%02d" year month day) | |
2558 t t ans)))) | |
2559 (setq tl (parse-time-string ans) | |
2560 year (or (nth 5 tl) (string-to-number (format-time-string "%Y"))) | |
2561 month (or (nth 4 tl) (string-to-number (format-time-string "%m"))) | |
2562 day (or (nth 3 tl) (string-to-number (format-time-string "%d"))) | |
2563 hour (or (nth 2 tl) (string-to-number (format-time-string "%H"))) | |
2564 minute (or (nth 1 tl) (string-to-number (format-time-string "%M"))) | |
2565 second (or (nth 0 tl) 0)) | |
2566 (if (and (boundp 'org-time-was-given) | |
2567 (nth 2 tl)) | |
2568 (setq org-time-was-given t)) | |
2569 (if (< year 100) (setq year (+ 2000 year))) | |
2570 (if to-time | |
2571 (encode-time second minute hour day month year) | |
2572 (if (or (nth 1 tl) (nth 2 tl)) | |
2573 (format "%04d-%02d-%02d %02d:%02d" year month day hour minute) | |
2574 (format "%04d-%02d-%02d" year month day))))) | |
2575 | |
2576 (defun org-eval-in-calendar (form) | |
2577 "Eval FORM in the calendar window and return to current window. | |
2578 Also, store the cursor date in variable ans2." | |
2579 (let ((sw (selected-window))) | |
2580 (select-window (get-buffer-window "*Calendar*")) | |
2581 (eval form) | |
2582 (when (calendar-cursor-to-date) | |
2583 (let* ((date (calendar-cursor-to-date)) | |
2584 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
2585 (setq ans2 (format-time-string "%Y-%m-%d" time)))) | |
2586 (select-window sw))) | |
2587 | |
2588 (defun org-calendar-select () | |
2589 "Return to `org-read-date' with the date currently selected. | |
2590 This is used by `org-read-date' in a temporary keymap for the calendar buffer." | |
2591 (interactive) | |
2592 (when (calendar-cursor-to-date) | |
2593 (let* ((date (calendar-cursor-to-date)) | |
2594 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
2595 (setq ans1 (format-time-string "%Y-%m-%d" time))) | |
2596 (if (active-minibuffer-window) (exit-minibuffer)))) | |
2597 | |
2598 (defun org-check-deadlines (ndays) | |
2599 "Check if there are any deadlines due or past due. | |
2600 A deadline is considered due if it happens within `org-deadline-warning-days' | |
2601 days from todays date. If the deadline appears in an entry marked DONE, | |
2602 it is not shown. The prefix arg NDAYS can be used to test that many | |
2603 days. If the prefix are is a raw C-u prefix, all deadlines are shown." | |
2604 (interactive "P") | |
2605 (let* ((org-warn-days | |
2606 (cond | |
2607 ((equal ndays '(4)) 100000) | |
2608 (ndays (prefix-numeric-value ndays)) | |
2609 (t org-deadline-warning-days))) | |
2610 (case-fold-search nil) | |
2611 (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) | |
2612 (callback | |
2613 (lambda () | |
2614 (and (let ((d1 (time-to-days (current-time))) | |
2615 (d2 (time-to-days | |
2616 (org-time-string-to-time (match-string 1))))) | |
2617 (< (- d2 d1) org-warn-days)) | |
2618 (not (org-entry-is-done-p)))))) | |
2619 (message "%d deadlines past-due or due within %d days" | |
2620 (org-occur regexp callback) | |
2621 org-warn-days))) | |
2622 | |
2623 (defun org-evaluate-time-range (&optional to-buffer) | |
2624 "Evaluate a time range by computing the difference between start and end. | |
2625 Normally the result is just printed in the echo area, but with prefix arg | |
2626 TO-BUFFER, the result is inserted just after the date stamp into the buffer. | |
2627 If the time range is actually in a table, the result is inserted into the | |
2628 next column. | |
2629 For time difference computation, a year is assumed to be exactly 365 | |
2630 days in order to avoid rounding problems." | |
2631 (interactive "P") | |
2632 (save-excursion | |
2633 (unless (org-at-date-range-p) | |
2634 (goto-char (point-at-bol)) | |
2635 (re-search-forward org-tr-regexp (point-at-eol) t)) | |
2636 (if (not (org-at-date-range-p)) | |
2637 (error "Not at a time-stamp range, and none found in current line."))) | |
2638 (let* ((ts1 (match-string 1)) | |
2639 (ts2 (match-string 2)) | |
2640 (match-end (match-end 0)) | |
2641 (time1 (org-time-string-to-time ts1)) | |
2642 (time2 (org-time-string-to-time ts2)) | |
2643 (t1 (time-to-seconds time1)) | |
2644 (t2 (time-to-seconds time2)) | |
2645 (diff (abs (- t2 t1))) | |
2646 (negative (< (- t2 t1) 0)) | |
2647 (ys (floor (* 365 24 60 60))) | |
2648 (ds (* 24 60 60)) | |
2649 (hs (* 60 60)) | |
2650 (fy "%dy %dd %02d:%02d") | |
2651 (fd "%dd %02d:%02d") | |
2652 (fh "%02d:%02d") | |
2653 y d h m align) | |
2654 (setq y (floor (/ diff ys)) diff (mod diff ys) | |
2655 d (floor (/ diff ds)) diff (mod diff ds) | |
2656 h (floor (/ diff hs)) diff (mod diff hs) | |
2657 m (floor (/ diff 60))) | |
2658 (if to-buffer | |
2659 (progn | |
2660 (goto-char match-end) | |
2661 (when (and (org-at-table-p) (looking-at " *|")) | |
2662 (setq align t) | |
2663 (goto-char (match-end 0))) | |
2664 (if (looking-at | |
2665 "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") | |
2666 (replace-match "")) | |
2667 (if negative (insert " -")) | |
2668 (if (> y 0) (insert " " (format fy y d h m)) | |
2669 (if (> d 0) (insert " " (format fd d h m)) | |
2670 (insert " " (format fh h m)))) | |
2671 (if align (org-table-align)) | |
2672 (message "Time difference inserted")) | |
2673 (message (org-make-tdiff-string y d h m))))) | |
2674 | |
2675 (defun org-make-tdiff-string (y d h m) | |
2676 (let ((fmt "") | |
2677 (l nil)) | |
2678 (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ") | |
2679 l (push y l))) | |
2680 (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ") | |
2681 l (push d l))) | |
2682 (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ") | |
2683 l (push h l))) | |
2684 (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ") | |
2685 l (push m l))) | |
2686 (apply 'format fmt (nreverse l)))) | |
2687 | |
2688 (defun org-time-string-to-time (s) | |
2689 (apply 'encode-time (org-parse-time-string s))) | |
2690 | |
2691 (defun org-parse-time-string (s) | |
2692 "Parse the standard Org-mode time string. | |
2693 This should be a lot faster than the normal parse-time-string." | |
2694 (if (string-match org-ts-regexp1 s) | |
2695 (list 0 | |
2696 (string-to-number (or (match-string 8 s) "0")) | |
2697 (string-to-number (or (match-string 7 s) "0")) | |
2698 (string-to-number (match-string 4 s)) | |
2699 (string-to-number (match-string 3 s)) | |
2700 (string-to-number (match-string 2 s)) | |
2701 nil nil nil) | |
2702 (make-list 9 0))) | |
2703 | |
2704 (defun org-timestamp-up (&optional arg) | |
2705 "Increase the date item at the cursor by one. | |
2706 If the cursor is on the year, change the year. If it is on the month or | |
2707 the day, change that. | |
2708 With prefix ARG, change by that many units." | |
2709 (interactive "p") | |
2710 (org-timestamp-change (prefix-numeric-value arg))) | |
2711 | |
2712 (defun org-timestamp-down (&optional arg) | |
2713 "Decrease the date item at the cursor by one. | |
2714 If the cursor is on the year, change the year. If it is on the month or | |
2715 the day, change that. | |
2716 With prefix ARG, change by that many units." | |
2717 (interactive "p") | |
2718 (org-timestamp-change (- (prefix-numeric-value arg)))) | |
2719 | |
2720 (defun org-timestamp-up-day (&optional arg) | |
2721 "Increase the date in the time stamp by one day. | |
2722 With prefix ARG, change that many days." | |
2723 (interactive "p") | |
2724 (org-timestamp-change (prefix-numeric-value arg) 'day)) | |
2725 | |
2726 (defun org-timestamp-down-day (&optional arg) | |
2727 "Increase the date in the time stamp by one day. | |
2728 With prefix ARG, change that many days." | |
2729 (interactive "p") | |
2730 (org-timestamp-change (- (prefix-numeric-value arg)) 'day)) | |
2731 | |
2732 (defsubst org-pos-in-match-range (pos n) | |
2733 (and (match-beginning n) | |
2734 (<= (match-beginning n) pos) | |
2735 (>= (match-end n) pos))) | |
2736 | |
2737 (defun org-at-timestamp-p () | |
2738 "Determine if the the cursor is in or at a timestamp." | |
2739 (interactive) | |
2740 (let* ((tsr org-ts-regexp2) | |
2741 (pos (point)) | |
2742 (ans (or (looking-at tsr) | |
2743 (save-excursion | |
2744 (skip-chars-backward "^<\n\r\t") | |
2745 (if (> (point) 1) (backward-char 1)) | |
2746 (and (looking-at tsr) | |
2747 (> (- (match-end 0) pos) -1)))))) | |
2748 (and (boundp 'org-ts-what) | |
2749 (setq org-ts-what | |
2750 (cond | |
2751 ((org-pos-in-match-range pos 2) 'year) | |
2752 ((org-pos-in-match-range pos 3) 'month) | |
2753 ((org-pos-in-match-range pos 7) 'hour) | |
2754 ((org-pos-in-match-range pos 8) 'minute) | |
2755 ((or (org-pos-in-match-range pos 4) | |
2756 (org-pos-in-match-range pos 5)) 'day) | |
2757 (t 'day)))) | |
2758 ans)) | |
2759 | |
2760 (defun org-timestamp-change (n &optional what) | |
2761 "Change the date in the time stamp at point. | |
2762 The date will be changed by N times WHAT. WHAT can be `day', `month', | |
2763 `year', `minute', `second'. If WHAT is not given, the cursor position | |
2764 in the timestamp determines what will be changed." | |
2765 (let ((fmt (car org-time-stamp-formats)) | |
2766 org-ts-what | |
2767 (pos (point)) | |
2768 ts time time0) | |
2769 (if (not (org-at-timestamp-p)) | |
2770 (error "Not at a timestamp")) | |
2771 (setq org-ts-what (or what org-ts-what)) | |
2772 (setq fmt (if (<= (abs (- (cdr org-ts-lengths) | |
2773 (- (match-end 0) (match-beginning 0)))) | |
2774 1) | |
2775 (cdr org-time-stamp-formats) | |
2776 (car org-time-stamp-formats))) | |
2777 (setq ts (match-string 0)) | |
2778 (replace-match "") | |
2779 (setq time0 (org-parse-time-string ts)) | |
2780 (setq time | |
2781 (apply 'encode-time | |
2782 (append | |
2783 (list (or (car time0) 0)) | |
2784 (list (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))) | |
2785 (list (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))) | |
2786 (list (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))) | |
2787 (list (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))) | |
2788 (list (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))) | |
2789 (nthcdr 6 time0)))) | |
2790 (if (eq what 'calendar) | |
2791 (let ((cal-date | |
2792 (save-excursion | |
2793 (save-match-data | |
2794 (set-buffer "*Calendar*") | |
2795 (calendar-cursor-to-date))))) | |
2796 (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month | |
2797 (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day | |
2798 (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year | |
2799 (setcar time0 (or (car time0) 0)) | |
2800 (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) | |
2801 (setcar (nthcdr 2 time0) (or (nth 1 time0) 0)) | |
2802 (setq time (apply 'encode-time time0)))) | |
2803 (insert (setq org-last-changed-timestamp (format-time-string fmt time))) | |
2804 (goto-char pos) | |
2805 ;; Try to recenter the calendar window, if any | |
2806 (if (and org-calendar-follow-timestamp-change | |
2807 (get-buffer-window "*Calendar*" t) | |
2808 (memq org-ts-what '(day month year))) | |
2809 (org-recenter-calendar (time-to-days time))))) | |
2810 | |
2811 (defun org-recenter-calendar (date) | |
2812 "If the calendar is visible, recenter it to DATE." | |
2813 (let* ((win (selected-window)) | |
2814 (cwin (get-buffer-window "*Calendar*" t))) | |
2815 (when cwin | |
2816 (select-window cwin) | |
2817 (calendar-goto-date (if (listp date) date | |
2818 (calendar-gregorian-from-absolute date))) | |
2819 (select-window win)))) | |
2820 | |
2821 (defun org-goto-calendar (&optional arg) | |
2822 "Go to the Emacs calendar at the current date. | |
2823 If there is a time stamp in the current line, go to that date. | |
2824 A prefix ARG can be used force the current date." | |
2825 (interactive "P") | |
2826 (let ((tsr org-ts-regexp) diff) | |
2827 (if (or (org-at-timestamp-p) | |
2828 (save-excursion | |
2829 (beginning-of-line 1) | |
2830 (looking-at (concat ".*" tsr)))) | |
2831 (let ((d1 (time-to-days (current-time))) | |
2832 (d2 (time-to-days | |
2833 (org-time-string-to-time (match-string 1))))) | |
2834 (setq diff (- d2 d1)))) | |
2835 (calendar) | |
2836 (calendar-goto-today) | |
2837 (if (and diff (not arg)) (calendar-forward-day diff)))) | |
2838 | |
2839 (defun org-date-from-calendar () | |
2840 "Insert time stamp corresponding to cursor date in *Calendar* buffer. | |
2841 If there is already a time stamp at the cursor position, update it." | |
2842 (interactive) | |
2843 (org-timestamp-change 0 'calendar)) | |
2844 | |
2845 ;;; Agenda, and Diary Integration | |
2846 | |
2847 ;;; Define the mode | |
2848 | |
2849 (defvar org-agenda-mode-map (make-sparse-keymap) | |
2850 "Keymap for org-agenda-mode.") | |
2851 | |
2852 (defvar org-agenda-menu) | |
2853 (defvar org-agenda-follow-mode nil) | |
2854 (defvar org-agenda-buffer-name "*Org Agenda*") | |
2855 (defvar org-agenda-redo-command nil) | |
2856 | |
2857 ;;;###autoload | |
2858 (defun org-agenda-mode () | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
2859 "Mode for time-sorted view on action items in Org-mode files. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
2860 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
2861 The following commands are available: |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
2862 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
2863 \\{org-agenda-mode-map}" |
58792 | 2864 (interactive) |
2865 (kill-all-local-variables) | |
2866 (setq major-mode 'org-agenda-mode) | |
2867 (setq mode-name "Org-Agenda") | |
2868 (use-local-map org-agenda-mode-map) | |
2869 (easy-menu-add org-agenda-menu) | |
2870 (if org-startup-truncated (setq truncate-lines t)) | |
2871 (add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) | |
2872 (setq org-agenda-follow-mode nil) | |
2873 (easy-menu-change | |
2874 '("Agenda") "Agenda Files" | |
2875 (append | |
2876 (list | |
2877 ["Edit file list" (customize-variable 'org-agenda-files) t] | |
2878 "--") | |
2879 (mapcar 'org-file-menu-entry org-agenda-files))) | |
2880 (org-agenda-set-mode-name) | |
2881 (run-hooks 'org-agenda-mode-hook)) | |
2882 | |
2883 (define-key org-agenda-mode-map [(tab)] 'org-agenda-goto) | |
2884 (define-key org-agenda-mode-map [(return)] 'org-agenda-switch-to) | |
2885 (define-key org-agenda-mode-map " " 'org-agenda-show) | |
2886 (define-key org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) | |
2887 (define-key org-agenda-mode-map "o" 'delete-other-windows) | |
2888 (define-key org-agenda-mode-map "l" 'org-agenda-recenter) | |
2889 (define-key org-agenda-mode-map "t" 'org-agenda-todo) | |
2890 (define-key org-agenda-mode-map "." 'org-agenda-goto-today) | |
2891 (define-key org-agenda-mode-map "w" 'org-agenda-week-view) | |
2892 (define-key org-agenda-mode-map [(shift right)] 'org-agenda-date-later) | |
2893 (define-key org-agenda-mode-map [(shift left)] 'org-agenda-date-earlier) | |
2894 | |
2895 (define-key org-agenda-mode-map ">" 'org-agenda-date-today) | |
2896 (let ((l '(1 2 3 4 5 6 7 8 9 0))) | |
2897 (while l (define-key org-agenda-mode-map | |
2898 (int-to-string (pop l)) 'digit-argument))) | |
2899 | |
2900 (define-key org-agenda-mode-map "f" 'org-agenda-follow-mode) | |
2901 (define-key org-agenda-mode-map "d" 'org-agenda-toggle-diary) | |
2902 (define-key org-agenda-mode-map "r" 'org-agenda-redo) | |
2903 (define-key org-agenda-mode-map "q" 'org-agenda-quit) | |
2904 (define-key org-agenda-mode-map "x" 'org-agenda-exit) | |
2905 (define-key org-agenda-mode-map "P" 'org-agenda-show-priority) | |
2906 (define-key org-agenda-mode-map "p" 'org-agenda-priority) | |
2907 (define-key org-agenda-mode-map "," 'org-agenda-priority) | |
2908 (define-key org-agenda-mode-map "i" 'org-agenda-diary-entry) | |
2909 (define-key org-agenda-mode-map "+" 'org-agenda-priority-up) | |
2910 (define-key org-agenda-mode-map "-" 'org-agenda-priority-down) | |
2911 (define-key org-agenda-mode-map [(right)] 'org-agenda-later) | |
2912 (define-key org-agenda-mode-map [(left)] 'org-agenda-earlier) | |
2913 | |
2914 (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) | |
2915 "Local keymap for agenda entries from Org-mode.") | |
2916 | |
2917 (define-key org-agenda-keymap | |
2918 (if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) | |
2919 (define-key org-agenda-keymap | |
2920 (if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) | |
2921 | |
2922 (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" | |
2923 '("Agenda" | |
2924 ("Agenda Files") | |
2925 "--" | |
2926 ["Show" org-agenda-show t] | |
2927 ["Go To (other window)" org-agenda-goto t] | |
2928 ["Go To (one window)" org-agenda-switch-to t] | |
2929 ["Follow Mode" org-agenda-follow-mode | |
2930 :style toggle :selected org-agenda-follow-mode :active t] | |
2931 "--" | |
2932 ["Cycle TODO" org-agenda-todo t] | |
2933 ("Reschedule" | |
2934 ["Reschedule +1 day" org-agenda-date-later t] | |
2935 ["Reschedule -1 day" org-agenda-date-earlier t] | |
2936 "--" | |
2937 ["Reschedule to today" org-agenda-date-today t]) | |
2938 ("Priority" | |
2939 ["Set Priority" org-agenda-priority t] | |
2940 ["Increase Priority" org-agenda-priority-up t] | |
2941 ["Decrease Priority" org-agenda-priority-down t] | |
2942 ["Show Priority" org-agenda-show-priority t]) | |
2943 "--" | |
2944 ["Rebuild" org-agenda-redo t] | |
2945 ["Goto Today" org-agenda-goto-today t] | |
2946 ["Next Dates" org-agenda-later (local-variable-p 'starting-day)] | |
2947 ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)] | |
2948 "--" | |
2949 ["Week/Day View" org-agenda-week-view (local-variable-p 'starting-day)] | |
2950 ["Include Diary" org-agenda-toggle-diary | |
2951 :style toggle :selected org-agenda-include-diary :active t] | |
2952 "--" | |
2953 ["New Diary Entry" org-agenda-diary-entry t] | |
2954 "--" | |
2955 ["Quit" org-agenda-quit t] | |
2956 ["Exit and Release Buffers" org-agenda-exit t] | |
2957 )) | |
2958 | |
2959 (defvar org-agenda-markers nil | |
2960 "List of all currently active markers created by org-agenda") | |
2961 (defvar org-agenda-last-marker-time (time-to-seconds (current-time)) | |
2962 "Creation time of the last agenda marker.") | |
2963 | |
2964 (defun org-agenda-new-marker (pos) | |
2965 "Return a new agenda marker. | |
2966 Org-mode keeps a list of these markers and resets them when they are | |
2967 no longer in use." | |
2968 (let ((m (copy-marker pos))) | |
2969 (setq org-agenda-last-marker-time (time-to-seconds (current-time))) | |
2970 (push m org-agenda-markers) | |
2971 m)) | |
2972 | |
2973 (defun org-agenda-maybe-reset-markers (&optional force) | |
2974 "Reset markers created by org-agenda. But only if they are old enough." | |
2975 (if (or force | |
2976 (> (- (time-to-seconds (current-time)) | |
2977 org-agenda-last-marker-time) | |
2978 5)) | |
2979 (while org-agenda-markers | |
2980 (move-marker (pop org-agenda-markers) nil)))) | |
2981 | |
2982 (defvar org-agenda-new-buffers nil | |
2983 "Buffers created to visit agenda files.") | |
2984 | |
2985 (defun org-get-agenda-file-buffer (file) | |
2986 "Get a buffer visiting FILE. If the buffer needs to be created, add | |
2987 it to the list of buffers which might be released later." | |
2988 (let ((buf (find-buffer-visiting file))) | |
2989 (if buf | |
2990 buf ; just return it | |
2991 ;; Make a new buffer and remember it | |
2992 (setq buf (find-file-noselect file)) | |
2993 (if buf (push buf org-agenda-new-buffers)) | |
2994 buf))) | |
2995 | |
2996 (defun org-release-buffers (blist) | |
2997 "Release all buffers in list, asking the user for confirmation when needed. | |
2998 When a buffer is unmodified, it is just killed. When modified, it is saved | |
2999 \(if the user agrees) and then killed." | |
3000 (let (buf file) | |
3001 (while (setq buf (pop blist)) | |
3002 (setq file (buffer-file-name buf)) | |
3003 (when (and (buffer-modified-p buf) | |
3004 file | |
3005 (y-or-n-p (format "Save file %s? " file))) | |
3006 (save-excursion | |
3007 (set-buffer buf) (save-buffer))) | |
3008 (kill-buffer buf)))) | |
3009 | |
3010 (defun org-timeline (&optional include-all) | |
3011 "Show a time-sorted view of the entries in the current org file. | |
3012 Only entries with a time stamp of today or later will be listed. With | |
3013 one C-u prefix argument, also past entries will be listed. | |
3014 With two C-u prefixes, all unfinished TODO items will also be shown, | |
3015 under the current date. | |
3016 If the buffer contains an active region, only check the region for | |
3017 dates." | |
3018 (interactive "P") | |
3019 (require 'calendar) | |
3020 (org-agenda-maybe-reset-markers 'force) | |
3021 (let* ((dopast include-all) | |
3022 (dotodo (equal include-all '(16))) | |
3023 (entry (buffer-file-name)) | |
3024 (org-agenda-files (list (buffer-file-name))) | |
3025 (date (calendar-current-date)) | |
3026 (win (selected-window)) | |
3027 (pos1 (point)) | |
3028 (beg (if (org-region-active-p) (region-beginning) (point-min))) | |
3029 (end (if (org-region-active-p) (region-end) (point-max))) | |
3030 (day-numbers (org-get-all-dates beg end 'no-ranges | |
3031 t)) ; always include today | |
3032 (today (time-to-days (current-time))) | |
3033 (org-respect-restriction t) | |
3034 (past t) | |
3035 s e rtn d pos) | |
3036 (setq org-agenda-redo-command | |
3037 (list 'progn | |
3038 (list 'switch-to-buffer-other-window (current-buffer)) | |
3039 (list 'org-timeline include-all))) | |
3040 (if (not dopast) | |
3041 ;; Remove past dates from the list of dates. | |
3042 (setq day-numbers (delq nil (mapcar (lambda(x) | |
3043 (if (>= x today) x nil)) | |
3044 day-numbers)))) | |
3045 (switch-to-buffer-other-window | |
3046 (get-buffer-create org-agenda-buffer-name)) | |
3047 (setq buffer-read-only nil) | |
3048 (erase-buffer) | |
3049 (org-agenda-mode) (setq buffer-read-only nil) | |
3050 (while (setq d (pop day-numbers)) | |
3051 (if (and (>= d today) | |
3052 dopast | |
3053 past) | |
3054 (progn | |
3055 (setq past nil) | |
3056 (insert (make-string 79 ?-) "\n"))) | |
3057 (setq date (calendar-gregorian-from-absolute d)) | |
3058 (setq s (point)) | |
3059 (if dotodo | |
3060 (setq rtn (org-agenda-get-day-entries | |
3061 entry date :todo :timestamp)) | |
3062 (setq rtn (org-agenda-get-day-entries entry date :timestamp))) | |
3063 (if (or rtn (equal d today)) | |
3064 (progn | |
3065 (insert (calendar-day-name date) " " | |
3066 (number-to-string (extract-calendar-day date)) " " | |
3067 (calendar-month-name (extract-calendar-month date)) " " | |
3068 (number-to-string (extract-calendar-year date)) "\n") | |
3069 (put-text-property s (1- (point)) 'face | |
3070 'org-link-face) | |
3071 (if (equal d today) | |
3072 (put-text-property s (1- (point)) 'org-today t)) | |
3073 (insert (org-finalize-agenda-entries rtn) "\n") | |
3074 (put-text-property s (1- (point)) 'day d)))) | |
3075 (goto-char (point-min)) | |
3076 (setq buffer-read-only t) | |
3077 (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) | |
3078 (point-min))) | |
3079 (when (not org-select-timeline-window) | |
3080 (select-window win) | |
3081 (goto-char pos1)))) | |
3082 | |
3083 ;;;###autoload | |
3084 (defun org-agenda (&optional include-all start-day ndays) | |
3085 "Produce a weekly view from all files in variable `org-agenda-files'. | |
3086 The view will be for the current week, but from the overview buffer you | |
3087 will be able to go to other weeks. | |
3088 With one C-u prefix argument INCLUDE-ALL, all unfinished TODO items will | |
3089 also be shown, under the current date. | |
3090 START-DAY defaults to TODAY, or to the most recent match for the weekday | |
3091 given in `org-agenda-start-on-weekday'. | |
3092 NDAYS defaults to `org-agenda-ndays'." | |
3093 (interactive "P") | |
3094 (org-agenda-maybe-reset-markers 'force) | |
3095 (require 'calendar) | |
3096 (let* ((org-agenda-start-on-weekday | |
3097 (if (or (equal ndays 1) | |
3098 (and (null ndays) (equal 1 org-agenda-ndays))) | |
3099 nil org-agenda-start-on-weekday)) | |
3100 (files (copy-sequence org-agenda-files)) | |
3101 (win (selected-window)) | |
3102 (today (time-to-days (current-time))) | |
3103 (sd (or start-day today)) | |
3104 (start (if (or (null org-agenda-start-on-weekday) | |
3105 (< org-agenda-ndays 7)) | |
3106 sd | |
3107 (let* ((nt (calendar-day-of-week | |
3108 (calendar-gregorian-from-absolute sd))) | |
3109 (n1 org-agenda-start-on-weekday) | |
3110 (d (- nt n1))) | |
3111 (- sd (+ (if (< d 0) 7 0) d))))) | |
3112 (day-numbers (list start)) | |
3113 s e rtn rtnall file date d start-pos) | |
3114 (setq org-agenda-redo-command | |
3115 (list 'org-agenda include-all start-day ndays)) | |
3116 ;; Make the list of days | |
3117 (setq ndays (or ndays org-agenda-ndays)) | |
3118 (while (> ndays 1) | |
3119 (push (1+ (car day-numbers)) day-numbers) | |
3120 (setq ndays (1- ndays))) | |
3121 (setq day-numbers (nreverse day-numbers)) | |
3122 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) | |
3123 (progn | |
3124 (delete-other-windows) | |
3125 (switch-to-buffer-other-window | |
3126 (get-buffer-create org-agenda-buffer-name)))) | |
3127 (setq buffer-read-only nil) | |
3128 (erase-buffer) | |
3129 (org-agenda-mode) (setq buffer-read-only nil) | |
3130 (set (make-local-variable 'starting-day) (car day-numbers)) | |
3131 (set (make-local-variable 'include-all-loc) include-all) | |
3132 (when (and (or include-all org-agenda-include-all-todo) | |
3133 (member today day-numbers)) | |
3134 (setq files org-agenda-files | |
3135 rtnall nil) | |
3136 (while (setq file (pop files)) | |
3137 (catch 'nextfile | |
3138 (org-check-agenda-file file) | |
3139 (setq date (calendar-gregorian-from-absolute today) | |
3140 rtn (org-agenda-get-day-entries | |
3141 file date :todo)) | |
3142 (setq rtnall (append rtnall rtn)))) | |
3143 (if rtnall (insert (org-finalize-agenda-entries rtnall) "\n"))) | |
3144 (while (setq d (pop day-numbers)) | |
3145 (setq date (calendar-gregorian-from-absolute d) | |
3146 s (point)) | |
3147 (if (or (= d today) | |
3148 (and (not start-pos) (= d sd))) | |
3149 (setq start-pos (point))) | |
3150 (setq files org-agenda-files | |
3151 rtnall nil) | |
3152 (while (setq file (pop files)) | |
3153 (catch 'nextfile | |
3154 (org-check-agenda-file file) | |
3155 (setq rtn (org-agenda-get-day-entries file date)) | |
3156 (setq rtnall (append rtnall rtn)))) | |
3157 (if org-agenda-include-diary | |
3158 (progn | |
3159 (require 'calendar) | |
3160 (require 'diary-lib) | |
3161 (setq rtn (org-get-entries-from-diary date)) | |
3162 (setq rtnall (append rtnall rtn)))) | |
3163 (if (or rtnall org-agenda-show-all-dates) | |
3164 (progn | |
3165 (insert (format "%-9s %2d %-9s %4d\n" | |
3166 (calendar-day-name date) | |
3167 (extract-calendar-day date) | |
3168 (calendar-month-name (extract-calendar-month date)) | |
3169 (extract-calendar-year date))) | |
3170 (put-text-property s (1- (point)) 'face | |
3171 'org-link-face) | |
3172 (if rtnall (insert (org-finalize-agenda-entries rtnall) "\n")) | |
3173 (put-text-property s (1- (point)) 'day d)))) | |
3174 (goto-char (point-min)) | |
3175 (setq buffer-read-only t) | |
3176 (goto-char (or start-pos 1)) | |
3177 (if (not org-select-agenda-window) (select-window win)) | |
3178 (message ""))) | |
3179 | |
3180 (defun org-check-agenda-file (file) | |
3181 "Make sure FILE exists. If not, ask user what to do." | |
3182 ;; FIXME: this does not correctly change the menus | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
3183 ;; Could probably be fixed by explicitly going to the buffer. |
58792 | 3184 (when (not (file-exists-p file)) |
3185 (message "non-existent file %s. [R]emove from agenda-files or [A]bort?" | |
3186 file) | |
3187 (let ((r (downcase (read-char-exclusive)))) | |
3188 (cond | |
3189 ((equal r ?r) | |
3190 (org-remove-file file) | |
3191 (throw 'nextfile t)) | |
3192 (t (error "Abort")))))) | |
3193 | |
3194 (defun org-agenda-quit (arg) | |
3195 "Exit agenda by removing the window or the buffer." | |
3196 (interactive "P") | |
3197 (let ((buf (current-buffer))) | |
3198 (if (not (one-window-p)) (delete-window)) | |
3199 (kill-buffer buf) | |
3200 (org-agenda-maybe-reset-markers 'force))) | |
3201 | |
3202 (defun org-agenda-exit (arg) | |
3203 "Exit agenda by removing the window or the buffer. | |
3204 Also kill all Org-mode buffers which have be loaded by `org-agenda'. | |
3205 Org-mode buffers visitied directly by the user will no be touched." | |
3206 (interactive "P") | |
3207 (org-release-buffers org-agenda-new-buffers) | |
3208 (setq org-agenda-new-buffers nil) | |
3209 (org-agenda-quit arg)) | |
3210 | |
3211 (defun org-agenda-redo (&optional arg) | |
3212 "Rebuild Agenda" | |
3213 (interactive "P") | |
3214 (eval org-agenda-redo-command)) | |
3215 | |
3216 (defun org-agenda-goto-today (arg) | |
3217 "Go to today." | |
3218 (interactive "P") | |
3219 (if (boundp 'starting-day) | |
3220 (let ((cmd (car org-agenda-redo-command)) | |
3221 (iall (nth 1 org-agenda-redo-command)) | |
3222 (nday (nth 3 org-agenda-redo-command))) | |
3223 (eval (list cmd iall nil nday))) | |
3224 (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) | |
3225 (point-min))))) | |
3226 | |
3227 (defun org-agenda-later (arg) | |
3228 "Go forward in time by `org-agenda-ndays' days. | |
3229 With prefix ARG, go forward that many times `org-agenda-ndays'." | |
3230 (interactive "p") | |
3231 (unless (boundp 'starting-day) | |
3232 (error "Not allowed")) | |
3233 (org-agenda (if (boundp 'include-all-loc) include-all-loc nil) | |
3234 (+ starting-day (* arg org-agenda-ndays)))) | |
3235 | |
3236 (defun org-agenda-earlier (arg) | |
3237 "Go back in time by `org-agenda-ndays' days. | |
3238 With prefix ARG, go back that many times `org-agenda-ndays'." | |
3239 (interactive "p") | |
3240 (unless (boundp 'starting-day) | |
3241 (error "Not allowed")) | |
3242 (org-agenda (if (boundp 'include-all-loc) include-all-loc nil) | |
3243 (- starting-day (* arg org-agenda-ndays)))) | |
3244 | |
3245 (defun org-agenda-day-view (arg) | |
3246 "Switch agenda to single day view." | |
3247 (interactive "P") | |
3248 (unless (boundp 'starting-day) | |
3249 (error "Not allowed")) | |
3250 (setq org-agenda-ndays 1) | |
3251 (org-agenda include-all-loc starting-day 1)) | |
3252 | |
3253 (defun org-agenda-week-view (arg) | |
3254 "Switch agenda to week view." | |
3255 (interactive "P") | |
3256 (unless (boundp 'starting-day) | |
3257 (error "Not allowed")) | |
3258 (setq org-agenda-ndays | |
3259 (if (equal org-agenda-ndays 1) 7 1)) | |
3260 (org-agenda include-all-loc | |
3261 (or (get-text-property (point) 'day) | |
3262 starting-day)) | |
3263 (org-agenda-set-mode-name) | |
3264 (message "Switched to %s view" | |
3265 (if (equal org-agenda-ndays 1) "day" "week"))) | |
3266 | |
3267 (defun org-agenda-follow-mode () | |
3268 "Toggle follow mode in an agenda buffer." | |
3269 (interactive) | |
3270 (setq org-agenda-follow-mode (not org-agenda-follow-mode)) | |
3271 (org-agenda-set-mode-name) | |
3272 (message "Follow mode is %s" | |
3273 (if org-agenda-follow-mode "on" "off"))) | |
3274 | |
3275 (defun org-agenda-toggle-diary () | |
3276 "Toggle follow mode in an agenda buffer." | |
3277 (interactive) | |
3278 (setq org-agenda-include-diary (not org-agenda-include-diary)) | |
3279 (org-agenda-redo) | |
3280 (org-agenda-set-mode-name) | |
3281 (message "Diary inclusion turned %s" | |
3282 (if org-agenda-include-diary "on" "off"))) | |
3283 | |
3284 (defun org-agenda-set-mode-name () | |
3285 "Set the mode name to indicate all the small mode seetings." | |
3286 (setq mode-name | |
3287 (concat "Org-Agenda" | |
3288 (if (equal org-agenda-ndays 1) " Day" "") | |
3289 (if (equal org-agenda-ndays 7) " Week" "") | |
3290 (if org-agenda-follow-mode " Follow" "") | |
3291 (if org-agenda-include-diary " Diary" ""))) | |
3292 (force-mode-line-update)) | |
3293 | |
3294 (defun org-agenda-post-command-hook () | |
3295 (if (and org-agenda-follow-mode | |
3296 (get-text-property (point) 'org-marker)) | |
3297 (org-agenda-show))) | |
3298 | |
3299 (defun org-get-entries-from-diary (date) | |
3300 "Get the (emacs calendar) diary entries for DATE." | |
3301 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") | |
3302 (diary-display-hook '(sort-diary-entries fancy-diary-display)) | |
3303 entries | |
3304 (disable-org-agenda t)) | |
3305 (save-excursion | |
3306 (save-window-excursion | |
3307 (list-diary-entries date 1))) | |
3308 (if (not (get-buffer fancy-diary-buffer)) | |
3309 (setq entries nil) | |
3310 (save-excursion | |
3311 (set-buffer fancy-diary-buffer) | |
3312 (setq buffer-read-only nil) | |
3313 (if (= (point-max) 1) | |
3314 ;; No entries | |
3315 (setq entries nil) | |
3316 ;; Omit the date | |
3317 (beginning-of-line 3) | |
3318 (delete-region (point-min) (point)) | |
3319 (while (and (re-search-forward "^" nil t) (not (eobp))) | |
3320 (replace-match " Diary: ")) | |
3321 (setq entries (buffer-substring (point-min) (- (point-max) 1)))) | |
3322 (set-buffer-modified-p nil) | |
3323 (kill-buffer fancy-diary-buffer))) | |
3324 (when entries | |
3325 (setq entries (org-split-string entries "\n")) | |
3326 (setq entries | |
3327 (mapcar | |
3328 (lambda (x) | |
3329 (if (string-match "\\<\\([012][0-9]\\):\\([0-6][0-9]\\)" x) | |
3330 (add-text-properties | |
3331 1 (length x) | |
3332 (list 'time-of-day | |
3333 (+ (* 100 (string-to-number | |
3334 (match-string 1 x))) | |
3335 (string-to-number (match-string 2 x)))) | |
3336 x)) | |
3337 x) | |
3338 entries))))) | |
3339 | |
3340 (defun org-add-file (&optional file) | |
3341 "Add current file to the list of files in variable `org-agenda-files'. | |
3342 These are the files which are being checked for agenda entries. | |
3343 Optional argument FILE means, use this file instead of the current. | |
3344 It is possible (but not recommended) to add this function to the | |
3345 `org-mode-hook'." | |
3346 (interactive) | |
3347 (catch 'exit | |
3348 (let* ((file (or file (buffer-file-name) | |
3349 (if (interactive-p) | |
3350 (error "Buffer is not visiting a file") | |
3351 (throw 'exit nil)))) | |
3352 (true-file (file-truename file)) | |
3353 (afile (abbreviate-file-name file)) | |
3354 (present (delq nil (mapcar | |
3355 (lambda (x) | |
3356 (equal true-file (file-truename x))) | |
3357 org-agenda-files)))) | |
3358 (if (not present) | |
3359 (progn | |
3360 (setq org-agenda-files | |
3361 (cons afile org-agenda-files)) | |
3362 ;; Make sure custom.el does not end up with Org-mode | |
3363 (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) | |
3364 (customize-save-variable 'org-agenda-files org-agenda-files)) | |
3365 (org-install-agenda-files-menu) | |
3366 (message "Added file: %s" afile)) | |
3367 (message "File was already in list: %s" afile))))) | |
3368 | |
3369 (defun org-remove-file (&optional file) | |
3370 "Remove current file from the list of files in variable `org-agenda-files'. | |
3371 These are the files which are being checked for agenda entries. | |
3372 Optional argument FILE means, use this file instead of the current." | |
3373 (interactive) | |
3374 (let* ((file (or file (buffer-file-name))) | |
3375 (true-file (file-truename file)) | |
3376 (afile (abbreviate-file-name file)) | |
3377 (files (delq nil (mapcar | |
3378 (lambda (x) | |
3379 (if (equal true-file | |
3380 (file-truename x)) | |
3381 nil x)) | |
3382 org-agenda-files)))) | |
3383 (if (not (= (length files) (length org-agenda-files))) | |
3384 (progn | |
3385 (setq org-agenda-files files) | |
3386 (customize-save-variable 'org-agenda-files org-agenda-files) | |
3387 (org-install-agenda-files-menu) | |
3388 (message "Removed file: %s" afile)) | |
3389 (message "File was not in list: %s" afile)))) | |
3390 | |
3391 (defun org-file-menu-entry (file) | |
3392 (vector file (list 'find-file file) t)) | |
3393 | |
3394 (defun org-get-all-dates (beg end &optional no-ranges force-today) | |
3395 "Return a list of all relevant day numbers from BEG to END buffer positions. | |
3396 If NO-RANGES is non-nil, include only the start and end dates of a range, | |
3397 not every single day in the range. If FORCE-TODAY is non-nil, make | |
3398 sure that TODAY is included in the list." | |
3399 (let (dates date day day1 day2 ts1 ts2) | |
3400 (if force-today | |
3401 (setq dates (list (time-to-days (current-time))))) | |
3402 (save-excursion | |
3403 (goto-char beg) | |
3404 (while (re-search-forward org-ts-regexp end t) | |
3405 (setq day (time-to-days (org-time-string-to-time | |
3406 (substring (match-string 1) 0 10)))) | |
3407 (or (memq day dates) (push day dates))) | |
3408 (unless no-ranges | |
3409 (goto-char beg) | |
3410 (while (re-search-forward org-tr-regexp end t) | |
3411 (setq ts1 (substring (match-string 1) 0 10) | |
3412 ts2 (substring (match-string 2) 0 10) | |
3413 day1 (time-to-days (org-time-string-to-time ts1)) | |
3414 day2 (time-to-days (org-time-string-to-time ts2))) | |
3415 (while (< (setq day1 (1+ day1)) day2) | |
3416 (or (memq day1 dates) (push day1 dates))))) | |
3417 (sort dates '<)))) | |
3418 | |
3419 ;;;###autoload | |
3420 (defun org-diary (&rest args) | |
3421 "Returns diary information from org-files. | |
3422 This function can be used in an \"sexp\" diary entry in the Emacs calendar. | |
3423 It accesses org files and extracts information from those files to be | |
3424 listed in the diary. The function accepts arguments specifying what | |
3425 items should be listed. The following arguments are allowed: | |
3426 | |
3427 :timestamp List the headlines of items containing a date stamp or | |
3428 date range matching the selected date. Deadlines will | |
3429 also be listed, on the expiration day. | |
3430 | |
3431 :deadline List any deadlines past due, or due within | |
3432 `org-deadline-warning-days'. The listing occurs only | |
3433 in the diary for *today*, not at any other date. If | |
3434 an entry is marked DONE, it is no longer listed. | |
3435 | |
3436 :scheduled List all items which are scheduled for the given date. | |
3437 The diary for *today* also contains items which were | |
3438 scheduled earlier and are not yet marked DONE. | |
3439 | |
3440 :todo List all TODO items from the org-file. This may be a | |
3441 long list - so this is not turned on by default. | |
3442 Like deadlines, these entires only show up in the | |
3443 diary for *today*, not at any other date. | |
3444 | |
3445 The call in the diary file should look like this: | |
3446 | |
3447 &%%(org-diary) ~/path/to/some/orgfile.org | |
3448 | |
3449 Use a separate line for each org file to check. Or, if you omit the file name, | |
3450 all files listed in `org-agenda-files' will be checked automatically: | |
3451 | |
3452 &%%(org-diary) | |
3453 | |
3454 If you don't give any arguments (as in the example above), the default | |
3455 arguments (:deadline :scheduled :timestamp) are used. So the example above may | |
3456 also be written as | |
3457 | |
3458 &%%(org-diary :deadline :timestamp :scheduled) | |
3459 | |
3460 The function expects the lisp variables `entry' and `date' to be provided | |
3461 by the caller, because this is how the calendar works. Don't use this | |
3462 function from a program - use `org-agenda-get-day-entries' instead." | |
3463 (org-agenda-maybe-reset-markers) | |
3464 (setq args (or args '(:deadline :scheduled :timestamp))) | |
3465 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) | |
3466 (list entry) | |
3467 org-agenda-files)) | |
3468 file rtn results) | |
3469 ;; If this is called during org-agenda, don't return any entries to | |
3470 ;; the calendar. Org Agenda will list these entries itself. | |
3471 (if (boundp 'disable-org-agenda) (setq files nil)) | |
3472 (while (setq file (pop files)) | |
3473 (setq rtn (apply 'org-agenda-get-day-entries file date args)) | |
3474 (setq results (append results rtn))) | |
3475 (concat (org-finalize-agenda-entries results) "\n"))) | |
3476 | |
3477 (defun org-agenda-get-day-entries (file date &rest args) | |
3478 "Does the work for `org-diary' and `org-agenda' | |
3479 FILE is the path to a file to be checked for entries. DATE is date like | |
3480 the one returned by `calendar-current-date'. ARGS are symbols indicating | |
3481 which kind of entries should be extracted. For details about these, see | |
3482 the documentation of `org-diary'." | |
3483 (setq args (or args '(:deadline :scheduled :timestamp))) | |
3484 (let* ((org-startup-with-deadline-check nil) | |
3485 (org-startup-folded nil) | |
3486 (buffer (if (file-exists-p file) | |
3487 ; (find-file-noselect file) | |
3488 (org-get-agenda-file-buffer file) | |
3489 (error "No such file %s" file))) | |
3490 (respect-narrow-p (boundp 'org-respect-restriction)) | |
3491 arg results rtn) | |
3492 (if (not buffer) | |
3493 ;; If file does not exist, make sure an error message ends up in diary | |
3494 (format "ORG-AGENDA-ERROR: No such org-file %s" file) | |
3495 (save-excursion | |
3496 (set-buffer buffer) | |
3497 (let ((case-fold-search nil)) | |
3498 (save-excursion | |
3499 (save-restriction | |
3500 (if respect-narrow-p | |
3501 (if (org-region-active-p) | |
3502 ;; Respect a region to restrict search | |
3503 (narrow-to-region (region-beginning) (region-end))) | |
3504 ;; If we work for the calendar or many files, | |
3505 ;; get rid of any restriction | |
3506 (widen)) | |
3507 (while (setq arg (pop args)) | |
3508 (cond | |
3509 ((and (eq arg :todo) | |
3510 (equal date (calendar-current-date))) | |
3511 (setq rtn (org-agenda-get-todos)) | |
3512 (setq results (append results rtn))) | |
3513 ((eq arg :timestamp) | |
3514 (setq rtn (org-agenda-get-blocks)) | |
3515 (setq results (append results rtn)) | |
3516 (setq rtn (org-agenda-get-timestamps)) | |
3517 (setq results (append results rtn))) | |
3518 ((eq arg :scheduled) | |
3519 (setq rtn (org-agenda-get-scheduled)) | |
3520 (setq results (append results rtn))) | |
3521 ((and (eq arg :deadline) | |
3522 (equal date (calendar-current-date))) | |
3523 (setq rtn (org-agenda-get-deadlines)) | |
3524 (setq results (append results rtn)))))))))) | |
3525 results)) | |
3526 | |
3527 (defun org-entry-is-done-p () | |
3528 "Is the current entry marked DONE?" | |
3529 (save-excursion | |
3530 (and (re-search-backward "[\r\n]\\*" nil t) | |
3531 (looking-at orb-nl-done-regexp)))) | |
3532 | |
3533 (defun org-at-date-range-p () | |
3534 "It the cursor inside a date range?" | |
3535 (interactive) | |
3536 (save-excursion | |
3537 (catch 'exit | |
3538 (let ((pos (point))) | |
3539 (skip-chars-backward "^<\r\n") | |
3540 (skip-chars-backward "<") | |
3541 (and (looking-at org-tr-regexp) | |
3542 (>= (match-end 0) pos) | |
3543 (throw 'exit t)) | |
3544 (skip-chars-backward "^<\r\n") | |
3545 (skip-chars-backward "<") | |
3546 (and (looking-at org-tr-regexp) | |
3547 (>= (match-end 0) pos) | |
3548 (throw 'exit t))) | |
3549 nil))) | |
3550 | |
3551 (defun org-agenda-get-todos () | |
3552 "Return the TODO information for agenda display." | |
3553 (let* ((props (list 'face nil | |
3554 'mouse-face 'highlight | |
3555 'keymap org-agenda-keymap | |
3556 'help-echo | |
3557 (format "mouse-2 or RET jump to org file %s" | |
3558 (abbreviate-file-name (buffer-file-name))))) | |
3559 (regexp (concat "[\n\r]\\*+ *\\(" org-not-done-regexp | |
3560 "[^\n\r]*\\)")) | |
3561 marker priority | |
3562 ee txt pl) | |
3563 (goto-char (point-min)) | |
3564 (while (re-search-forward regexp nil t) | |
3565 (goto-char (match-beginning 1)) | |
3566 (setq marker (org-agenda-new-marker (point)) | |
3567 txt (org-format-agenda-item "" (match-string 1)) | |
3568 priority | |
3569 (+ (org-get-priority txt) | |
3570 (if org-todo-kwd-priority-p | |
3571 (- org-todo-kwd-max-priority -2 | |
3572 (length | |
3573 (member (match-string 2) org-todo-keywords))) | |
3574 1))) | |
3575 (add-text-properties | |
3576 0 (length txt) (append (list 'org-marker marker 'priority priority) | |
3577 props) | |
3578 txt) | |
3579 (push txt ee) | |
3580 (goto-char (match-end 1))) | |
3581 (nreverse ee))) | |
3582 | |
3583 (defconst org-agenda-no-heading-message | |
3584 "No heading for this item in buffer or region") | |
3585 | |
3586 (defun org-agenda-get-timestamps () | |
3587 "Return the date stamp information for agenda display." | |
3588 (let* ((props (list 'face nil | |
3589 'mouse-face 'highlight | |
3590 'keymap org-agenda-keymap | |
3591 'help-echo | |
3592 (format "mouse-2 or RET jump to org file %s" | |
3593 (abbreviate-file-name (buffer-file-name))))) | |
3594 (regexp (regexp-quote | |
3595 (substring | |
3596 (format-time-string | |
3597 (car org-time-stamp-formats) | |
3598 (apply 'encode-time ; DATE bound by calendar | |
3599 (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) | |
3600 0 11))) | |
3601 marker deadlinep scheduledp tmp priority | |
3602 ee txt) | |
3603 (goto-char (point-min)) | |
3604 (while (re-search-forward regexp nil t) | |
3605 (if (not (save-match-data (org-at-date-range-p))) | |
3606 (progn | |
3607 (setq marker (org-agenda-new-marker (point)) | |
3608 tmp (buffer-substring (max (point-min) | |
3609 (- (match-beginning 0) | |
3610 org-ds-keyword-length)) | |
3611 (match-beginning 0)) | |
3612 deadlinep (string-match org-deadline-regexp tmp) | |
3613 scheduledp (string-match org-scheduled-regexp tmp)) | |
3614 (save-excursion | |
3615 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) | |
3616 (progn | |
3617 (goto-char (match-end 1)) | |
3618 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") | |
3619 (setq txt (org-format-agenda-item | |
3620 (format "%s%s" | |
3621 (if deadlinep "Deadline: " "") | |
3622 (if scheduledp "Scheduled: " "")) | |
3623 (match-string 1)))) | |
3624 (setq txt org-agenda-no-heading-message)) | |
3625 (setq priority (org-get-priority txt)) | |
3626 (add-text-properties | |
3627 0 (length txt) (append (list 'org-marker marker) props) | |
3628 txt) | |
3629 (if deadlinep | |
3630 (add-text-properties | |
3631 0 (length txt) | |
3632 (list 'face 'org-warning-face | |
3633 'priority (+ 100 priority)) | |
3634 txt) | |
3635 (if scheduledp | |
3636 (add-text-properties | |
3637 0 (length txt) | |
3638 (list 'face 'org-scheduled-today-face | |
3639 priority (+ 99 priority)) | |
3640 txt) | |
3641 (add-text-properties | |
3642 0 (length txt) | |
3643 (list 'priority priority) txt))) | |
3644 (push txt ee)) | |
3645 (outline-next-heading)))) | |
3646 (nreverse ee))) | |
3647 | |
3648 (defun org-agenda-get-deadlines () | |
3649 "Return the deadline information for agenda display." | |
3650 (let* ((wdays org-deadline-warning-days) | |
3651 (props (list 'face nil | |
3652 'mouse-face 'highlight | |
3653 'keymap org-agenda-keymap | |
3654 'help-echo | |
3655 (format "mouse-2 or RET jump to org file %s" | |
3656 (abbreviate-file-name (buffer-file-name))))) | |
3657 (regexp org-deadline-time-regexp) | |
3658 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar | |
3659 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar | |
3660 d2 diff pos | |
3661 ee txt head) | |
3662 (goto-char (point-min)) | |
3663 (while (re-search-forward regexp nil t) | |
3664 (setq d2 (time-to-days | |
3665 (org-time-string-to-time (match-string 1))) | |
3666 pos (point) | |
3667 diff (- d2 d1)) | |
3668 ;; When to show a deadline in the calendar: | |
3669 ;; If the expiration is within wdays warning time. | |
3670 ;; Past-due deadlines are only shown on the current date | |
3671 (if (and (< diff wdays) todayp (not (= diff 0))) | |
3672 (save-excursion | |
3673 (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) | |
3674 (progn | |
3675 (goto-char (match-end 0)) | |
3676 (setq head (buffer-substring-no-properties | |
3677 (point) | |
3678 (progn (skip-chars-forward "^\r\n") | |
3679 (point)))) | |
3680 (if (string-match org-looking-at-done-regexp head) | |
3681 (setq txt nil) | |
3682 (setq txt (org-format-agenda-item | |
3683 (format "In %3d d.: " diff) head)))) | |
3684 (setq txt org-agenda-no-heading-message)) | |
3685 (when txt | |
3686 (add-text-properties | |
3687 0 (length txt) | |
3688 (append | |
3689 (list 'org-marker (org-agenda-new-marker pos) | |
3690 'priority (+ (- 10 diff) (org-get-priority txt)) | |
3691 'face (cond ((<= diff 0) 'org-warning-face) | |
3692 ((<= diff 5) 'font-lock-function-name-face) | |
3693 (t nil))) | |
3694 props) | |
3695 txt) | |
3696 (push txt ee))))) | |
3697 ee)) | |
3698 | |
3699 (defun org-agenda-get-scheduled () | |
3700 "Return the scheduled information for agenda display." | |
3701 (let* ((props (list 'face 'org-scheduled-previously-face | |
3702 'mouse-face 'highlight | |
3703 'keymap org-agenda-keymap | |
3704 'help-echo | |
3705 (format "mouse-2 or RET jump to org file %s" | |
3706 (abbreviate-file-name (buffer-file-name))))) | |
3707 (regexp org-scheduled-time-regexp) | |
3708 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar | |
3709 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar | |
3710 d2 diff marker pos | |
3711 ee txt head) | |
3712 (goto-char (point-min)) | |
3713 (while (re-search-forward regexp nil t) | |
3714 (setq d2 (time-to-days | |
3715 (org-time-string-to-time (match-string 1))) | |
3716 pos (point) | |
3717 diff (- d2 d1)) | |
3718 ;; When to show a scheduled item in the calendar: | |
3719 ;; If it is on or past the date. | |
3720 (if (and (< diff 0) todayp) | |
3721 (save-excursion | |
3722 (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) | |
3723 (progn | |
3724 (goto-char (match-end 0)) | |
3725 (setq head (buffer-substring-no-properties | |
3726 (point) | |
3727 (progn (skip-chars-forward "^\r\n") (point)))) | |
3728 (if (string-match org-looking-at-done-regexp head) | |
3729 (setq txt nil) | |
3730 (setq txt (org-format-agenda-item | |
3731 (format "Sched.%2dx: " (- 1 diff)) head)))) | |
3732 (setq txt org-agenda-no-heading-message)) | |
3733 (when txt | |
3734 (setq marker (org-agenda-new-marker pos)) | |
3735 (add-text-properties | |
3736 0 (length txt) | |
3737 (append (list 'org-marker marker | |
3738 'priority (+ (- 5 diff) (org-get-priority txt))) | |
3739 props) txt) | |
3740 (push txt ee))))) | |
3741 ee)) | |
3742 | |
3743 (defun org-agenda-get-blocks () | |
3744 "Return the date-range information for agenda display." | |
3745 (let* ((props (list 'face nil | |
3746 'mouse-face 'highlight | |
3747 'keymap org-agenda-keymap | |
3748 'help-echo | |
3749 (format "mouse-2 or RET jump to org file %s" | |
3750 (abbreviate-file-name (buffer-file-name))))) | |
3751 (regexp org-tr-regexp) | |
3752 (d0 (calendar-absolute-from-gregorian date)) | |
3753 marker ee txt d1 d2 s1 s2) | |
3754 (goto-char (point-min)) | |
3755 (while (re-search-forward regexp nil t) | |
3756 (setq s1 (match-string 1) | |
3757 s2 (match-string 2) | |
3758 d1 (time-to-days (org-time-string-to-time s1)) | |
3759 d2 (time-to-days (org-time-string-to-time s2))) | |
3760 (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) | |
3761 ;; Only allow days between the limits, because the normal | |
3762 ;; date stamps will catch the limits. | |
3763 (save-excursion | |
3764 (setq marker (org-agenda-new-marker (point))) | |
3765 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) | |
3766 (progn | |
3767 (goto-char (match-end 1)) | |
3768 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") | |
3769 (setq txt (org-format-agenda-item | |
3770 (format "(%d/%d): " | |
3771 (1+ (- d0 d1)) (1+ (- d2 d1))) | |
3772 (match-string 1)))) | |
3773 (setq txt org-agenda-no-heading-message)) | |
3774 (add-text-properties | |
3775 0 (length txt) (append (list 'org-marker marker | |
3776 'priority (org-get-priority txt)) | |
3777 props) | |
3778 txt) | |
3779 (push txt ee))) | |
3780 (outline-next-heading)) | |
3781 ;; Sort the entries by expiration date. | |
3782 (nreverse ee))) | |
3783 | |
3784 | |
3785 (defun org-format-agenda-item (prefix txt) | |
3786 "Format TXT to be inserted into the agenda buffer. | |
3787 In particular, this indents the lins and adds a category." | |
3788 (let ((cat (or org-category | |
3789 (file-name-sans-extension | |
3790 (file-name-nondirectory (buffer-file-name))))) | |
3791 time rtn) | |
3792 (if (symbolp cat) (setq cat (symbol-name cat))) | |
3793 (setq rtn (format " %-10s %s%s" (concat cat ":") prefix txt)) | |
3794 (add-text-properties | |
3795 0 2 (list 'category (downcase cat) | |
3796 'prefix-length (- (length rtn) (length txt)) | |
3797 'time-of-day (org-get-time-of-day rtn)) | |
3798 rtn) | |
3799 rtn)) | |
3800 | |
3801 ;; FIXME: Should this be restricted to beginning of string? | |
3802 (defun org-get-time-of-day (s) | |
3803 "Check string S for a time of day." | |
3804 (save-match-data | |
3805 (when (and | |
3806 (string-match | |
3807 "\\<\\([012][0-9]\\)\\(:\\([0-6][0-9]\\)\\)?\\([AaPp][Mm]\\)?\\>" s) | |
3808 (or (match-beginning 2) (match-beginning 4))) | |
3809 (+ (* 100 (+ (string-to-number (match-string 1 s)) | |
3810 (if (and (match-beginning 4) | |
3811 (equal (downcase (match-string 4 s)) "pm")) | |
3812 12 0))) | |
3813 (if (match-beginning 3) | |
3814 (string-to-number (match-string 3 s)) | |
3815 0))))) | |
3816 | |
3817 (defun org-finalize-agenda-entries (list) | |
3818 "Sort and concatenate the agenda items." | |
3819 (mapconcat 'identity (sort list 'org-entries-lessp) "\n")) | |
3820 | |
3821 (defsubst org-cmp-priority (a b) | |
3822 "Compare the priorities of string a and b." | |
3823 (let ((pa (or (get-text-property 1 'priority a) 0)) | |
3824 (pb (or (get-text-property 1 'priority b) 0))) | |
3825 (cond ((> pa pb) +1) | |
3826 ((< pa pb) -1) | |
3827 (t nil)))) | |
3828 | |
3829 (defsubst org-cmp-category (a b) | |
3830 "Compare the string values of categories of strings a and b." | |
3831 (let ((ca (or (get-text-property 1 'category a) "")) | |
3832 (cb (or (get-text-property 1 'category b) ""))) | |
3833 (cond ((string-lessp ca cb) -1) | |
3834 ((string-lessp cb ca) +1) | |
3835 (t nil)))) | |
3836 | |
3837 (defsubst org-cmp-time (a b) | |
3838 "Compare the time-of-day values of strings a and b." | |
3839 (let* ((def (if org-sort-agenda-notime-is-late 2401 -1)) | |
3840 (ta (or (get-text-property 1 'time-of-day a) def)) | |
3841 (tb (or (get-text-property 1 'time-of-day b) def))) | |
3842 (cond ((< ta tb) -1) | |
3843 ((< tb ta) +1) | |
3844 (t nil)))) | |
3845 | |
3846 (defun org-entries-lessp (a b) | |
3847 "Predicate for sorting agenda entries." | |
3848 (let* ((time-up (org-cmp-time a b)) | |
3849 (time-down (if time-up (- time-up) nil)) | |
3850 (priority-up (org-cmp-priority a b)) | |
3851 (priority-down (if priority-up (- priority-up) nil)) | |
3852 (category-up (org-cmp-category a b)) | |
3853 (category-down (if category-up (- category-up) nil)) | |
3854 (category-keep (if category-up +1 nil))) ; FIXME +1 or -1? | |
3855 (cdr (assoc | |
3856 (eval (cons 'or org-agenda-sorting-strategy)) | |
3857 '((-1 . t) (1 . nil) (nil . nil)))))) | |
3858 | |
3859 (defun org-agenda-show-priority () | |
3860 "Show the priority of the current item. | |
3861 This priority is composed of the main priority given with the [#A] cookies, | |
3862 and by additional input from the age of a schedules or deadline entry." | |
3863 (interactive) | |
3864 (let* ((pri (get-text-property (point-at-bol) 'priority))) | |
3865 (message "Priority is %d" (if pri pri -1000)))) | |
3866 | |
3867 | |
3868 (defun org-agenda-goto () | |
3869 "Go to the Org-mode file which contains the item at point." | |
3870 (interactive) | |
3871 (let* ((marker (or (get-text-property (point) 'org-marker) | |
3872 (org-agenda-error))) | |
3873 (buffer (marker-buffer marker)) | |
3874 (pos (marker-position marker))) | |
3875 (switch-to-buffer-other-window buffer) | |
3876 (widen) | |
3877 (goto-char pos) | |
3878 (org-show-hidden-entry) | |
3879 (save-excursion | |
3880 (and (outline-next-heading) | |
3881 (org-flag-heading nil))))) ; show the next heading | |
3882 | |
3883 (defun org-agenda-switch-to () | |
3884 "Go to the Org-mode file which contains the item at point." | |
3885 (interactive) | |
3886 (let* ((marker (or (get-text-property (point) 'org-marker) | |
3887 (org-agenda-error))) | |
3888 (buffer (marker-buffer marker)) | |
3889 (pos (marker-position marker))) | |
3890 (switch-to-buffer buffer) | |
3891 (delete-other-windows) | |
3892 (widen) | |
3893 (goto-char pos) | |
3894 (org-show-hidden-entry) | |
3895 (save-excursion | |
3896 (and (outline-next-heading) | |
3897 (org-flag-heading nil))))) ; show the next heading | |
3898 | |
3899 (defun org-agenda-goto-mouse (ev) | |
3900 "Go to the Org-mode file which contains the deadline at the mouse click." | |
3901 (interactive "e") | |
3902 (mouse-set-point ev) | |
3903 (org-agenda-goto)) | |
3904 | |
3905 (defun org-agenda-show () | |
3906 "Display the Org-mode file which contains the item at point." | |
3907 (interactive) | |
3908 (let ((win (selected-window))) | |
3909 (org-agenda-goto) | |
3910 (select-window win))) | |
3911 | |
3912 (defun org-agenda-recenter (arg) | |
3913 "Display the Org-mode file which contains the item at point and recenter." | |
3914 (interactive "P") | |
3915 (let ((win (selected-window))) | |
3916 (org-agenda-goto) | |
3917 (recenter arg) | |
3918 (select-window win))) | |
3919 | |
3920 (defun org-agenda-show-mouse (ev) | |
3921 "Display the Org-mode file which contains the deadline at the mouse click." | |
3922 (interactive "e") | |
3923 (mouse-set-point ev) | |
3924 (org-agenda-show)) | |
3925 | |
3926 (defun org-agenda-error () | |
3927 (error "Command not allowed in this line.")) | |
3928 | |
3929 (defun org-agenda-todo () | |
3930 "Cycle TODO state of line at point, also in Org-mode file." | |
3931 (interactive) | |
3932 (let* ((props (text-properties-at (point))) | |
3933 (col (current-column)) | |
3934 (marker (or (get-text-property (point) 'org-marker) | |
3935 (org-agenda-error))) | |
3936 (pl (get-text-property (point-at-bol) 'prefix-length)) | |
3937 (buffer (marker-buffer marker)) | |
3938 (pos (marker-position marker)) | |
3939 (buffer-read-only nil) | |
3940 newhead) | |
3941 (save-excursion | |
3942 (set-buffer buffer) | |
3943 (widen) | |
3944 (goto-char pos) | |
3945 (org-show-hidden-entry) | |
3946 (save-excursion | |
3947 (and (outline-next-heading) | |
3948 (org-flag-heading nil))) ; show the next heading | |
3949 (org-todo) | |
3950 (setq newhead (org-get-heading))) | |
3951 (beginning-of-line 1) | |
3952 (move-to-column pl) | |
3953 (if (looking-at ".*") | |
3954 (progn | |
3955 (replace-match newhead t t) | |
3956 (move-to-column col) | |
3957 (add-text-properties (point-at-bol) (point-at-eol) props) | |
3958 (beginning-of-line 1)) | |
3959 (error "Line update did not work")))) | |
3960 | |
3961 (defun org-agenda-priority-up () | |
3962 "Increase the priority of line at point, also in Org-mode file." | |
3963 (interactive) | |
3964 (org-agenda-priority 'up)) | |
3965 | |
3966 (defun org-agenda-priority-down () | |
3967 "Decrease the priority of line at point, also in Org-mode file." | |
3968 (interactive) | |
3969 (org-agenda-priority 'down)) | |
3970 | |
3971 (defun org-agenda-priority (&optional force-direction) | |
3972 "Set the priority of line at point, also in Org-mode file." | |
3973 (interactive) | |
3974 (let* ((props (text-properties-at (point))) | |
3975 (col (current-column)) | |
3976 (marker (or (get-text-property (point) 'org-marker) | |
3977 (org-agenda-error))) | |
3978 (pl (get-text-property (point-at-bol) 'prefix-length)) | |
3979 (buffer (marker-buffer marker)) | |
3980 (pos (marker-position marker)) | |
3981 (buffer-read-only nil) | |
3982 newhead) | |
3983 (save-excursion | |
3984 (set-buffer buffer) | |
3985 (widen) | |
3986 (goto-char pos) | |
3987 (org-show-hidden-entry) | |
3988 (save-excursion | |
3989 (and (outline-next-heading) | |
3990 (org-flag-heading nil))) ; show the next heading | |
3991 (funcall 'org-priority force-direction) | |
3992 (setq newhead (org-get-heading))) | |
3993 (beginning-of-line 1) | |
3994 (move-to-column pl) | |
3995 (if (looking-at ".*") | |
3996 (progn | |
3997 (replace-match (concat newhead) t t) | |
3998 (move-to-column col) | |
3999 (add-text-properties (point-at-bol) (point-at-eol) props) | |
4000 (beginning-of-line 1)) | |
4001 (error "Line update did not work")))) | |
4002 | |
4003 (defun org-agenda-date-later (arg &optional what) | |
4004 "Change the date of this item to one day later." | |
4005 (interactive "p") | |
4006 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4007 (org-agenda-error))) | |
4008 (buffer (marker-buffer marker)) | |
4009 (pos (marker-position marker))) | |
4010 (save-excursion | |
4011 (set-buffer buffer) | |
4012 (widen) | |
4013 (goto-char pos) | |
4014 (if (not (org-at-timestamp-p)) | |
4015 (error "Cannot find time stamp")) | |
4016 (org-timestamp-change arg (or what 'day)) | |
4017 (message "Time stamp changed to %s" org-last-changed-timestamp)))) | |
4018 | |
4019 (defun org-agenda-date-earlier (arg &optional what) | |
4020 "Change the date of this item to one day earlier." | |
4021 (interactive "p") | |
4022 (org-agenda-date-later (- arg) what)) | |
4023 | |
4024 (defun org-agenda-date-today (arg) | |
4025 "Change the date of this item to one day later." | |
4026 (interactive "p") | |
4027 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4028 (org-agenda-error))) | |
4029 (buffer (marker-buffer marker)) | |
4030 (pos (marker-position marker))) | |
4031 (save-excursion | |
4032 (set-buffer buffer) | |
4033 (widen) | |
4034 (goto-char pos) | |
4035 (if (not (org-at-timestamp-p)) | |
4036 (error "Cannot find time stamp")) | |
4037 (org-time-stamp nil) | |
4038 (message "Time stamp changed to %s" org-last-changed-timestamp)))) | |
4039 | |
4040 (defun org-get-heading () | |
4041 "Return the heading of the current entry, without the stars." | |
4042 (save-excursion | |
4043 (if (and (re-search-backward "[\r\n]\\*" nil t) | |
4044 (looking-at "[\r\n]\\*+[ \t]+\\(.*\\)")) | |
4045 (match-string 1) | |
4046 ""))) | |
4047 | |
4048 (defun org-agenda-diary-entry (arg) | |
4049 "Make a diary entry, like the `i' command from the calendar. | |
4050 All the standard commands work: block, weekly etc" | |
4051 (interactive "P") | |
4052 (require 'diary-lib) | |
4053 (let* ((char (progn | |
4054 (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") | |
4055 (read-char-exclusive))) | |
4056 (cmd (cdr (assoc char | |
4057 '((?d . insert-diary-entry) | |
4058 (?w . insert-weekly-diary-entry) | |
4059 (?m . insert-monthly-diary-entry) | |
4060 (?y . insert-yearly-diary-entry) | |
4061 (?a . insert-anniversary-diary-entry) | |
4062 (?b . insert-block-diary-entry) | |
4063 (?c . insert-cyclic-diary-entry))))) | |
4064 (oldf (symbol-function 'calendar-cursor-to-date)) | |
4065 (point (point)) | |
4066 (mark (or (mark t) (point)))) | |
4067 (unless cmd | |
4068 (error "No command associated with <%c>" char)) | |
4069 (unless (and (get-text-property point 'day) | |
4070 (or (not (equal ?b char)) | |
4071 (get-text-property mark 'day))) | |
4072 (error "Don't know which date to use for diary entry")) | |
4073 ;; We implememnt this by hacking the `calendar-cursor-to-date' function | |
4074 ;; and the `calendar-mark-ring' variable. Saves a lot of code. | |
4075 (let ((calendar-mark-ring | |
4076 (list (calendar-gregorian-from-absolute | |
4077 (or (get-text-property mark 'day) | |
4078 (get-text-property point 'day)))))) | |
4079 (unwind-protect | |
4080 (progn | |
4081 (fset 'calendar-cursor-to-date | |
4082 (lambda (&optional error) | |
4083 (calendar-gregorian-from-absolute | |
4084 (get-text-property point 'day)))) | |
4085 (call-interactively cmd)) | |
4086 (fset 'calendar-cursor-to-date oldf))))) | |
4087 | |
4088 ;;; Link Stuff | |
4089 | |
4090 (defun org-find-file-at-mouse (ev) | |
4091 "Open file link or URL at mouse." | |
4092 (interactive "e") | |
4093 (mouse-set-point ev) | |
4094 (org-open-at-point 'in-emacs)) | |
4095 | |
4096 (defun org-open-at-mouse (ev) | |
4097 "Open file link or URL at mouse." | |
4098 (interactive "e") | |
4099 (mouse-set-point ev) | |
4100 (org-open-at-point)) | |
4101 | |
4102 (defun org-open-at-point (&optional in-emacs) | |
4103 "Open link at or after point. | |
4104 If there is no link at point, this function will search forward up to | |
4105 the end of the current subtree. | |
4106 Normally, files will be opened by an appropriate application. If the | |
4107 optional argument IN-EMACS is non-nil, Emacs will visit the file." | |
4108 (interactive "P") | |
4109 (if (org-at-timestamp-p) | |
4110 (org-agenda nil (time-to-days (org-time-string-to-time | |
4111 (substring (match-string 1) 0 10))) | |
4112 1) | |
4113 (let (type path line (pos (point))) | |
4114 (save-excursion | |
4115 (skip-chars-backward | |
4116 (if org-allow-space-in-links "^\t\n\r" "^ \t\n\r")) | |
4117 (if (re-search-forward | |
4118 org-link-regexp | |
4119 (save-excursion | |
4120 (condition-case nil | |
4121 (progn (outline-end-of-subtree) (max pos (point))) | |
4122 (error (end-of-line 1) (point)))) | |
4123 t) | |
4124 (setq type (match-string 1) | |
4125 path (match-string 2))) | |
4126 (unless path | |
4127 (error "No link found.")) | |
4128 ;; Remove any trailing spaces in path | |
4129 (if (string-match " +\\'" path) | |
4130 (setq path (replace-match "" t t path))) | |
4131 | |
4132 (cond | |
4133 | |
4134 ((string= type "file") | |
4135 (if (string-match ":\\([0-9]+\\)\\'" path) | |
4136 (setq line (string-to-number (match-string 1 path)) | |
4137 path (substring path 0 (match-beginning 0)))) | |
4138 (org-open-file path in-emacs line)) | |
4139 | |
4140 ((string= type "news") | |
4141 (org-follow-gnus-link path)) | |
4142 | |
4143 ((string= type "bbdb") | |
4144 (org-follow-bbdb-link path)) | |
4145 | |
4146 ((string= type "gnus") | |
4147 (let (group article) | |
4148 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
4149 (error "Error in Gnus link")) | |
4150 (setq group (match-string 1 path) | |
4151 article (match-string 3 path)) | |
4152 (org-follow-gnus-link group article))) | |
4153 | |
4154 ((string= type "vm") | |
4155 (let (folder article) | |
4156 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
4157 (error "Error in VM link")) | |
4158 (setq folder (match-string 1 path) | |
4159 article (match-string 3 path)) | |
4160 ;; in-emacs is the prefix arg, will be interpreted as read-only | |
4161 (org-follow-vm-link folder article in-emacs))) | |
4162 | |
4163 ((string= type "wl") | |
4164 (let (folder article) | |
4165 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
4166 (error "Error in Wanderlust link")) | |
4167 (setq folder (match-string 1 path) | |
4168 article (match-string 3 path)) | |
4169 (org-follow-wl-link folder article))) | |
4170 | |
4171 ((string= type "rmail") | |
4172 (let (folder article) | |
4173 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
4174 (error "Error in RMAIL link")) | |
4175 (setq folder (match-string 1 path) | |
4176 article (match-string 3 path)) | |
4177 (org-follow-rmail-link folder article))) | |
4178 | |
4179 ((string= type "shell") | |
4180 (let ((cmd path)) | |
4181 (if (or (not org-confirm-shell-links) | |
4182 (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd))) | |
4183 (shell-command cmd) | |
4184 (error "Abort")))) | |
4185 | |
4186 (t | |
4187 (browse-url-at-point))))))) | |
4188 | |
4189 (defun org-follow-bbdb-link (name) | |
4190 "Follow a BBDB link to NAME." | |
4191 (require 'bbdb) | |
4192 ;; First try an exact match | |
4193 (bbdb-name (concat "\\`" name "\\'") nil) | |
4194 (if (= 0 (buffer-size (get-buffer "*BBDB*"))) | |
4195 ;; No exact match - try partial match | |
4196 (bbdb-name name nil))) | |
4197 | |
4198 (defun org-follow-gnus-link (&optional group article) | |
4199 "Follow a Gnus link to GROUP and ARTICLE." | |
4200 (require 'gnus) | |
4201 (funcall (cdr (assq 'gnus org-link-frame-setup))) | |
4202 (if group (gnus-fetch-group group)) | |
4203 (if article | |
4204 (or (gnus-summary-goto-article article nil 'force) | |
4205 (if (fboundp 'gnus-summary-insert-cached-articles) | |
4206 (progn | |
4207 (gnus-summary-insert-cached-articles) | |
4208 (gnus-summary-goto-article article nil 'force)) | |
4209 (message "Message could not be found."))))) | |
4210 ;; (if article (gnus-summary-goto-article article nil 'force))) | |
4211 | |
4212 (defun org-follow-vm-link (&optional folder article readonly) | |
4213 "Follow a VM link to FOLDER and ARTICLE." | |
4214 (require 'vm) | |
4215 (if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder) | |
4216 ;; ange-ftp or efs or tramp access | |
4217 (let ((user (or (match-string 1 folder) (user-login-name))) | |
4218 (host (match-string 2 folder)) | |
4219 (file (match-string 3 folder))) | |
4220 (cond | |
4221 ((featurep 'tramp) | |
4222 ;; use tramp to access the file | |
4223 (if org-xemacs-p | |
4224 (setq folder (format "[%s@%s]%s" user host file)) | |
4225 (setq folder (format "/%s@%s:%s" user host file)))) | |
4226 (t | |
4227 ;; use ange-ftp or efs | |
4228 (require (if org-xemacs-p 'efs 'ange-ftp)) | |
4229 (setq folder (format "/%s@%s:%s" user host file)))))) | |
4230 (when folder | |
4231 (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly) | |
4232 (sit-for 0.1) | |
4233 (when article | |
4234 (vm-select-folder-buffer) | |
4235 (widen) | |
4236 (let ((case-fold-search t)) | |
4237 (goto-char (point-min)) | |
4238 (if (not (re-search-forward | |
4239 (concat "^" "message-id: *" (regexp-quote article)))) | |
4240 (error "Could not find the specified message in this folder")) | |
4241 (vm-isearch-update) | |
4242 (vm-isearch-narrow) | |
4243 (vm-beginning-of-message) | |
4244 (vm-summarize))))) | |
4245 | |
4246 (defun org-follow-wl-link (folder article) | |
4247 "Follow a Wanderlust link to FOLDER and ARTICLE." | |
4248 (wl-summary-goto-folder-subr folder 'no-sync t nil t) | |
4249 (if article (wl-summary-jump-to-msg-by-message-id article)) | |
4250 (wl-summary-redisplay)) | |
4251 | |
4252 (defun org-follow-rmail-link (folder article) | |
4253 "Follow an RMAIL link to FOLDER and ARTICLE." | |
4254 (let (message-number) | |
4255 (save-excursion | |
4256 (save-window-excursion | |
4257 (rmail (if (string= folder "RMAIL") rmail-file-name folder)) | |
4258 (setq message-number | |
4259 (save-restriction | |
4260 (widen) | |
4261 (goto-char (point-max)) | |
4262 (if (re-search-backward | |
4263 (concat "^Message-ID:\\s-+" (regexp-quote | |
4264 (or article ""))) | |
4265 nil t) | |
4266 (rmail-what-message)))))) | |
4267 (if message-number | |
4268 (progn | |
4269 (rmail (if (string= folder "RMAIL") rmail-file-name folder)) | |
4270 (rmail-show-message message-number) | |
4271 message-number) | |
4272 (error "Message not found")))) | |
4273 | |
4274 (defun org-open-file (path &optional in-emacs line) | |
4275 "Open the file at PATH. | |
4276 First, this expands any special file name abbreviations. Then the | |
4277 configuration variable `org-file-apps' is checked if it contains an | |
4278 entry for this file type, and if yes, the corresponding command is launched. | |
4279 If no application is found, Emacs simply visits the file. | |
4280 With optional argument IN-EMACS, Emacs will visit the file. | |
4281 If the file does not exist, an error is thrown." | |
4282 (let* ((file (convert-standard-filename (org-expand-file-name path))) | |
4283 (dfile (downcase file)) | |
4284 ext cmd apps) | |
4285 (if (and (not (file-exists-p file)) | |
4286 (not org-open-non-existing-files)) | |
4287 (error "No such file: %s" file)) | |
4288 (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) | |
4289 (setq ext (match-string 1 dfile)) | |
4290 (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) | |
4291 (setq ext (match-string 1 dfile)))) | |
4292 (setq apps (append org-file-apps (org-default-apps))) | |
4293 (if in-emacs | |
4294 (setq cmd 'emacs) | |
4295 (setq cmd (or (cdr (assoc ext apps)) | |
4296 (cdr (assoc t apps))))) | |
4297 (cond | |
4298 ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) | |
4299 (setq cmd (format cmd file)) | |
4300 (save-window-excursion | |
4301 (shell-command (concat cmd " & &")))) | |
4302 ((or (stringp cmd) | |
4303 (eq cmd 'emacs)) | |
4304 (funcall (cdr (assq 'file org-link-frame-setup)) file) | |
4305 (if line (goto-line line))) | |
4306 ((consp cmd) | |
4307 (eval cmd)) | |
4308 (t (funcall (cdr (assq 'file org-link-frame-setup)) file))))) | |
4309 | |
4310 (defun org-default-apps () | |
4311 "Return the default applications for this operating system." | |
4312 (cond | |
4313 ((eq system-type 'darwin) | |
4314 org-file-apps-defaults-macosx) | |
4315 ((eq system-type 'windows-nt) | |
4316 org-file-apps-defaults-windowsnt) | |
4317 ((eq system-type 'linux) | |
4318 org-file-apps-defaults-linux) | |
4319 (t org-file-apps-defaults-linux))) | |
4320 | |
4321 (defun org-expand-file-name (path) | |
4322 "Replace special path abbreviations and expand the file name." | |
4323 (expand-file-name path)) | |
4324 | |
4325 | |
4326 (defvar org-insert-link-history nil | |
4327 "Minibuffer history for links inserted with `org-insert-link'.") | |
4328 | |
4329 (defvar org-stored-links nil | |
4330 "Contains the links stored with `org-store-link'.") | |
4331 | |
4332 ;;;###autoload | |
4333 (defun org-store-link (arg) | |
4334 "\\<org-mode-map>Store an org-link to the current location. | |
4335 This link can later be inserted into an org-buffer with | |
4336 \\[org-insert-link]. | |
4337 For some link types, a prefix arg is interpreted: | |
4338 For links to usenet articles, arg negates `org-usenet-links-prefer-google'. | |
4339 For file links, arg negates `org-line-numbers-in-file-links'." | |
4340 (interactive "P") | |
4341 (let (link cpltxt) | |
4342 (cond | |
4343 | |
4344 ((eq major-mode 'bbdb-mode) | |
4345 (setq link (concat "bbdb:" | |
4346 (bbdb-record-name (bbdb-current-record))))) | |
4347 | |
4348 ((eq major-mode 'calendar-mode) | |
4349 (let ((cd (calendar-cursor-to-date))) | |
4350 (setq link | |
4351 (format-time-string | |
4352 (car org-time-stamp-formats) | |
4353 (apply 'encode-time | |
4354 (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) | |
4355 nil nil nil)))))) | |
4356 | |
4357 ((or (eq major-mode 'vm-summary-mode) | |
4358 (eq major-mode 'vm-presentation-mode)) | |
4359 (and (eq major-mode 'vm-presentation-mode) (vm-summarize)) | |
4360 (vm-follow-summary-cursor) | |
4361 (save-excursion | |
4362 (vm-select-folder-buffer) | |
4363 (let* ((message (car vm-message-pointer)) | |
4364 (folder (buffer-file-name)) | |
4365 (subject (vm-su-subject message)) | |
4366 (author (vm-su-full-name message)) | |
4367 (address (vm-su-from message)) | |
4368 (message-id (vm-su-message-id message))) | |
4369 (setq folder (abbreviate-file-name folder)) | |
4370 (if (string-match (concat "^" (regexp-quote vm-folder-directory)) | |
4371 folder) | |
4372 (setq folder (replace-match "" t t folder))) | |
4373 (setq cpltxt (concat author " on: " subject)) | |
4374 (setq link (concat cpltxt "\n " "vm:" folder | |
4375 "#" message-id))))) | |
4376 | |
4377 ((eq major-mode 'wl-summary-mode) | |
4378 (let* ((msgnum (wl-summary-message-number)) | |
4379 (message-id (elmo-message-field wl-summary-buffer-elmo-folder | |
4380 msgnum 'message-id)) | |
4381 (wl-message-entity (elmo-msgdb-overview-get-entity | |
4382 msgnum (wl-summary-buffer-msgdb))) | |
4383 (author (wl-summary-line-from)) ; FIXME: how to get author name? | |
4384 (subject "???")) ; FIXME: How to get subject of email? | |
4385 (setq cpltxt (concat author " on: " subject)) | |
4386 (setq link (concat cpltxt "\n " "wl:" wl-summary-buffer-folder-name | |
4387 "#" message-id)))) | |
4388 | |
4389 ((eq major-mode 'rmail-mode) | |
4390 (save-excursion | |
4391 (save-restriction | |
4392 (rmail-narrow-to-non-pruned-header) | |
4393 (let ((folder (buffer-file-name)) | |
4394 (message-id (mail-fetch-field "message-id")) | |
4395 (author (mail-fetch-field "from")) | |
4396 (subject (mail-fetch-field "subject"))) | |
4397 (setq cpltxt (concat author " on: " subject)) | |
4398 (setq link (concat cpltxt "\n " "rmail:" folder | |
4399 "#" message-id)))))) | |
4400 | |
4401 ((eq major-mode 'gnus-group-mode) | |
4402 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus | |
4403 (gnus-group-group-name)) ; version | |
4404 ((fboundp 'gnus-group-name) | |
4405 (gnus-group-name)) | |
4406 (t "???")))) | |
4407 (if (org-xor arg org-usenet-links-prefer-google) | |
4408 (setq link (format "http://groups.google.com/groups?group=%s" | |
4409 group)) | |
4410 (setq link (concat "gnus:" group))))) | |
4411 | |
4412 ((or (eq major-mode 'gnus-summary-mode) | |
4413 (eq major-mode 'gnus-article-mode)) | |
4414 (gnus-article-show-summary) | |
4415 (gnus-summary-beginning-of-article) | |
4416 (let* ((group (car gnus-article-current)) | |
4417 (article (cdr gnus-article-current)) | |
4418 (header (gnus-summary-article-header article)) | |
4419 (author (mail-header-from header)) | |
4420 (message-id (mail-header-id header)) | |
4421 (date (mail-header-date header)) | |
4422 (subject (gnus-summary-subject-string))) | |
4423 (setq cpltxt (concat author " on: " subject)) | |
4424 (if (org-xor arg org-usenet-links-prefer-google) | |
4425 (setq link | |
4426 (concat | |
4427 cpltxt "\n " | |
4428 (format "http://groups.google.com/groups?as_umsgid=%s" | |
4429 (org-fixup-message-id-for-http message-id)))) | |
4430 (setq link (concat cpltxt "\n" "gnus:" group | |
4431 "#" (number-to-string article)))))) | |
4432 | |
4433 ((eq major-mode 'w3-mode) | |
4434 (setq link (url-view-url t))) | |
4435 ((eq major-mode 'w3m-mode) | |
4436 (setq link w3m-current-url)) | |
4437 | |
4438 ((buffer-file-name) | |
4439 ;; Just link to this file here. | |
4440 (setq link (concat "file:" | |
4441 (abbreviate-file-name (buffer-file-name)))) | |
4442 ;; Add the line number? | |
4443 (if (org-xor org-line-numbers-in-file-links arg) | |
4444 (setq link | |
4445 (concat link | |
4446 ":" (int-to-string | |
4447 (+ (if (bolp) 1 0) (count-lines | |
4448 (point-min) (point)))))))) | |
4449 ((interactive-p) | |
4450 (error "Cannot link to a buffer which is not visiting a file")) | |
4451 (t (setq link nil))) | |
4452 | |
4453 (if (and (interactive-p) link) | |
4454 (progn | |
4455 (setq org-stored-links | |
4456 (cons (cons (or cpltxt link) link) org-stored-links)) | |
4457 (message "Stored: %s" (or cpltxt link))) | |
4458 link))) | |
4459 | |
4460 (defun org-xor (a b) | |
4461 "Exclusive or." | |
4462 (or (and a (not b)) | |
4463 (and b (not a)))) | |
4464 | |
4465 (defun org-get-header (header) | |
4466 "Find a header field in the current buffer." | |
4467 (save-excursion | |
4468 (goto-char (point-min)) | |
4469 (let ((case-fold-search t) s) | |
4470 (cond | |
4471 ((eq header 'from) | |
4472 (if (re-search-forward "^From:\\s-+\\(.*\\)" nil t) | |
4473 (setq s (match-string 1))) | |
4474 (while (string-match "\"" s) | |
4475 (setq s (replace-match "" t t s))) | |
4476 (if (string-match "[<(].*" s) | |
4477 (setq s (replace-match "" t t s)))) | |
4478 ((eq header 'message-id) | |
4479 (if (re-search-forward "^message-id:\\s-+\\(.*\\)" nil t) | |
4480 (setq s (match-string 1)))) | |
4481 ((eq header 'subject) | |
4482 (if (re-search-forward "^subject:\\s-+\\(.*\\)" nil t) | |
4483 (setq s (match-string 1))))) | |
4484 (if (string-match "\\`[ \t\]+" s) (setq s (replace-match "" t t s))) | |
4485 (if (string-match "[ \t\]+\\'" s) (setq s (replace-match "" t t s))) | |
4486 s))) | |
4487 | |
4488 | |
4489 (defun org-fixup-message-id-for-http (s) | |
4490 "Replace special characters in a message id, so that it can be used | |
4491 in an http query." | |
4492 (while (string-match "<" s) | |
4493 (setq s (replace-match "%3C" t t s))) | |
4494 (while (string-match ">" s) | |
4495 (setq s (replace-match "%3E" t t s))) | |
4496 (while (string-match "@" s) | |
4497 (setq s (replace-match "%40" t t s))) | |
4498 s) | |
4499 | |
4500 (defun org-insert-link (&optional complete-file) | |
4501 "Insert a link. At the prompt, enter the link. | |
4502 | |
4503 Completion can be used to select a link previously stored with | |
4504 `org-store-link'. When the empty string is entered (i.e. if you just | |
4505 press RET at the prompt), the link defaults to the most recently | |
4506 stored link. | |
4507 | |
4508 With a C-u prefix, prompts for a file to link to. The file name can be | |
4509 selected using completion. The path to the file will be relative to | |
4510 the current directory if the file is in the current directory or a | |
4511 subdirectory. Otherwise, the link will be the absolute path as | |
4512 completed in the minibuffer (i.e. normally ~/path/to/file). | |
4513 | |
4514 With two C-u prefixes, enforce an absolute path even if the file | |
4515 is in the current directory or below." | |
4516 (interactive "P") | |
4517 (let ((link (if complete-file | |
4518 (read-file-name "File: ") | |
4519 (completing-read | |
4520 "Link: " org-stored-links nil nil nil | |
4521 org-insert-link-history | |
4522 (or (car (car org-stored-links)))))) | |
4523 linktxt matched) | |
4524 (if (or (not link) (equal link "")) | |
4525 (error "No links available")) | |
4526 (if complete-file | |
4527 (let ((pwd (file-name-as-directory (expand-file-name ".")))) | |
4528 (cond | |
4529 ((equal complete-file '(16)) | |
4530 (insert "file:" (abbreviate-file-name (expand-file-name link)))) | |
4531 ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") | |
4532 (expand-file-name link)) | |
4533 (insert "file:" (match-string 1 (expand-file-name link)))) | |
4534 (t (insert "file:" link)))) | |
4535 (setq linktxt (cdr (assoc link org-stored-links))) | |
4536 (if (not org-keep-stored-link-after-insertion) | |
4537 (setq org-stored-links (delq (assoc link org-stored-links) | |
4538 org-stored-links))) | |
4539 (let ((lines (org-split-string (or linktxt link) "\n"))) | |
4540 (insert (car lines)) | |
4541 (setq matched (string-match org-link-regexp (car lines))) | |
4542 (setq lines (cdr lines)) | |
4543 (while lines | |
4544 (insert "\n") | |
4545 (if (save-excursion | |
4546 (beginning-of-line 0) | |
4547 (looking-at "[ \t]+\\S-")) | |
4548 (indent-relative)) | |
4549 (setq matched (or matched | |
4550 (string-match org-link-regexp (car lines)))) | |
4551 (insert (car lines)) | |
4552 (setq lines (cdr lines)))) | |
4553 (unless matched | |
4554 (error "Add link type: http(s),ftp,mailto,file,news,bbdb,vm,wl,rmail,gnus, or shell"))))) | |
4555 | |
4556 ;;; Hooks for remember.el | |
4557 ;;;###autoload | |
4558 (defun org-remember-annotation () | |
4559 "Return a link to the current location as an annotation for remember.el. | |
4560 If you are using Org-mode files as target for data storage with | |
4561 remember.el, then the annotations should include a link compatible with the | |
4562 conventions in Org-mode. This function returns such a link." | |
4563 (org-store-link nil)) | |
4564 | |
4565 (defconst org-remember-help | |
4566 "Select a destination location for the note. | |
4567 UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store | |
4568 RET at beg-of-buf -> Append to file as level 2 headline | |
4569 RET on headline -> Store as sublevel entry to current headline | |
4570 <left>/<right> -> before/after current headline, same headings level") | |
4571 | |
4572 ;;;###autoload | |
4573 (defun org-remember-handler () | |
4574 "Store stuff from remember.el into an org file. | |
4575 First prompts for an org file. If the user just presses return, the value | |
4576 of `org-default-notes-file' is used. | |
4577 Then the command offers the headings tree of the selected file in order to | |
4578 file the text at a specific location. | |
4579 You can either immediately press RET to get the note appended to the | |
4580 file. Or you can use vertical cursor motion and visibility cycling (TAB) to | |
4581 find a better place. Then press RET or <left> or <right> in insert the note. | |
4582 | |
4583 Key Cursor position Note gets inserted | |
4584 ----------------------------------------------------------------------------- | |
4585 RET buffer-start as level 2 heading at end of file | |
4586 RET on headline as sublevel of the heading at cursor | |
4587 RET no heading at cursor position, level taken from context. | |
4588 Or use prefix arg to specify level manually. | |
4589 <left> on headline as same level, before current heading | |
4590 <right> on headline as same level, after current heading | |
4591 | |
4592 So the fastest way to store the note is to press RET RET to append it to | |
4593 the default file. This way your current train of thought is not | |
4594 interrupted, in accordance with the principles of remember.el. But with | |
4595 little extra effort, you can push it directly to the correct location. | |
4596 | |
4597 Before being stored away, the function ensures that the text has a | |
4598 headline, i.e. a first line that starts with a \"*\". If not, a headline | |
4599 is constructed from the current date and some additional data. | |
4600 | |
4601 If the variable `org-adapt-indentation' is non-nil, the entire text is | |
4602 also indented so that it starts in the same column as the headline | |
4603 \(i.e. after the stars). | |
4604 | |
4605 See also the variable `org-reverse-note-order'." | |
4606 (catch 'quit | |
4607 (let* ((txt (buffer-substring (point-min) (point-max))) | |
4608 (fastp current-prefix-arg) | |
4609 (file (if fastp org-default-notes-file (org-get-org-file))) | |
4610 (visiting (find-buffer-visiting file)) | |
4611 (org-startup-with-deadline-check nil) | |
4612 (org-startup-folded nil) | |
4613 spos level indent reversed) | |
4614 ;; Modify text so that it becomes a nice subtree which can be inserted | |
4615 ;; into an org tree. | |
4616 (let* ((lines (split-string txt "\n")) | |
4617 (first (car lines)) | |
4618 (lines (cdr lines))) | |
4619 (if (string-match "^\\*+" first) | |
4620 ;; Is already a headline | |
4621 (setq indent (make-string (- (match-end 0) (match-beginning 0) | |
4622 -1) ?\ )) | |
4623 ;; We need to add a headline: Use time and first buffer line | |
4624 (setq lines (cons first lines) | |
4625 first (concat "* " (current-time-string) | |
4626 " (" (remember-buffer-desc) ")") | |
4627 indent " ")) | |
4628 (if org-adapt-indentation | |
4629 (setq lines (mapcar (lambda (x) (concat indent x)) lines))) | |
4630 (setq txt (concat first "\n" | |
4631 (mapconcat 'identity lines "\n")))) | |
4632 ;; Find the file | |
4633 (if (not visiting) | |
4634 (find-file-noselect file)) | |
4635 (save-excursion | |
4636 (set-buffer (get-file-buffer file)) | |
4637 (setq reversed (org-notes-order-reversed-p)) | |
4638 (save-restriction | |
4639 (save-excursion | |
4640 (widen) | |
4641 ;; Ask the User for a location | |
4642 (setq spos (if fastp 1 (org-get-location | |
4643 (current-buffer) | |
4644 org-remember-help))) | |
4645 (if (not spos) (throw 'quit nil)) ; return nil to show we did | |
4646 ; not handle this note | |
4647 (goto-char spos) | |
4648 (cond ((bobp) | |
4649 ;; Put it at the start or end, as level 2 | |
4650 (save-restriction | |
4651 (widen) | |
4652 (goto-char (if reversed (point-min) (point-max))) | |
4653 (if (not (bolp)) (newline)) | |
4654 (org-paste-subtree (or current-prefix-arg 2) txt))) | |
4655 ((and (org-on-heading-p nil) (not current-prefix-arg)) | |
4656 ;; Put it below this entry, at the beg/end of the subtree | |
4657 (org-back-to-heading) | |
4658 (setq level (outline-level)) | |
4659 (if reversed | |
4660 (outline-end-of-heading) | |
4661 (outline-end-of-subtree)) | |
4662 (if (not (bolp)) (newline)) | |
4663 (beginning-of-line 1) | |
4664 (org-paste-subtree (1+ level) txt)) | |
4665 (t | |
4666 ;; Put it right there, with automatic level determined by | |
4667 ;; org-paste-subtree or from prefix arg | |
4668 (org-paste-subtree current-prefix-arg txt))) | |
4669 (when remember-save-after-remembering | |
4670 (save-buffer) | |
4671 (if (not visiting) (kill-buffer (current-buffer))))))))) | |
4672 t) ;; return t to indicate that we took care of this note. | |
4673 | |
4674 (defun org-get-org-file () | |
4675 "Read a filename, with default directory `org-directory'." | |
4676 (let ((default (or org-default-notes-file remember-data-file))) | |
4677 (read-file-name (format "File name [%s]: " default) | |
4678 (file-name-as-directory org-directory) | |
4679 default))) | |
4680 | |
4681 (defun org-notes-order-reversed-p () | |
4682 "Check if the current file should receive notes in reversed order." | |
4683 (cond | |
4684 ((not org-reverse-note-order) nil) | |
4685 ((eq t org-reverse-note-order) t) | |
4686 ((not (listp org-reverse-note-order)) nil) | |
4687 (t (catch 'exit | |
4688 (let ((all org-reverse-note-order) | |
4689 entry) | |
4690 (while (setq entry (pop all)) | |
4691 (if (string-match (car entry) (buffer-file-name)) | |
4692 (throw 'exit (cdr entry)))) | |
4693 nil))))) | |
4694 | |
4695 ;;; Tables | |
4696 | |
4697 ;; Watch out: Here we are talking about two different kind of tables. | |
4698 ;; Most of the code is for the tables created with the Org-mode table editor. | |
4699 ;; Sometimes, we talk about tables created and edited with the table.el | |
4700 ;; Emacs package. We call the former org-type tables, and the latter | |
4701 ;; table.el-type tables. | |
4702 | |
4703 ;; We use a before-change function to check if a table might need | |
4704 ;; an update. | |
4705 (defvar org-table-may-need-update t | |
4706 "Indicates of a table might need an update. | |
4707 This variable is set by `org-before-change-function'. `org-table-align' | |
4708 sets it back to nil.") | |
4709 | |
4710 (defun org-before-change-function (beg end) | |
4711 "Every change indicates that a table might need an update." | |
4712 (setq org-table-may-need-update t)) | |
4713 | |
4714 (defconst org-table-line-regexp "^[ \t]*|" | |
4715 "Detects an org-type table line.") | |
4716 (defconst org-table-dataline-regexp "^[ \t]*|[^-]" | |
4717 "Detects an org-type table line.") | |
4718 (defconst org-table-hline-regexp "^[ \t]*|-" | |
4719 "Detects an org-type table hline.") | |
4720 (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" | |
4721 "Detects a table-type table hline.") | |
4722 (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" | |
4723 "Detects an org-type or table-type table") | |
4724 (defconst org-table-border-regexp "^[ \t]*[^| \t]" | |
4725 "Searching from within a table (any type) this finds the first line | |
4726 outside the table.") | |
4727 (defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" | |
4728 "Searching from within a table (any type) this finds the first line | |
4729 outside the table.") | |
4730 | |
4731 (defun org-table-create-with-table.el () | |
4732 "Use the table.el package to insert a new table. | |
4733 If there is already a table at point, convert between Org-mode tables | |
4734 and table.el tables." | |
4735 (interactive) | |
4736 (require 'table) | |
4737 (cond | |
4738 ((org-at-table.el-p) | |
4739 (if (y-or-n-p "Convert table to Org-mode table? ") | |
4740 (org-table-convert))) | |
4741 ((org-at-table-p) | |
4742 (if (y-or-n-p "Convert table to table.el table? ") | |
4743 (org-table-convert))) | |
4744 (t (call-interactively 'table-insert)))) | |
4745 | |
4746 (defun org-table-create (&optional size) | |
4747 "Query for a size and insert a table skeleton. | |
4748 SIZE is a string Columns x Rows like for example \"3x2\"." | |
4749 (interactive "P") | |
4750 (unless size | |
4751 (setq size (read-string | |
4752 (concat "Table size Columns x Rows [e.g. " | |
4753 org-table-default-size "]: ") | |
4754 "" nil org-table-default-size))) | |
4755 | |
4756 (let* ((pos (point)) | |
4757 (indent (make-string (current-column) ?\ )) | |
4758 (split (org-split-string size " *x *")) | |
4759 (rows (string-to-number (nth 1 split))) | |
4760 (columns (string-to-number (car split))) | |
4761 (line (concat (apply 'concat indent "|" (make-list columns " |")) | |
4762 "\n"))) | |
4763 (if (string-match "^[ \t]*$" (buffer-substring-no-properties | |
4764 (point-at-bol) (point))) | |
4765 (beginning-of-line 1) | |
4766 (newline)) | |
4767 (mapcar (lambda (x) (insert line)) (make-list rows t)) | |
4768 (goto-char pos) | |
4769 (if (> rows 1) | |
4770 ;; Insert a hline after the first row. | |
4771 (progn | |
4772 (end-of-line 1) | |
4773 (insert "\n|-") | |
4774 (goto-char pos))) | |
4775 (org-table-align))) | |
4776 | |
4777 (defun org-table-convert-region (beg0 end0 nspace) | |
4778 "Convert region to a table. | |
4779 The region goes from BEG0 to END0, but these borders will be moved | |
4780 slightly, to make sure a beginning of line in the first line is included. | |
4781 When NSPACE is non-nil, it indicates the minimum number of spaces that | |
4782 separate columns (default: just one space)" | |
4783 (let* ((beg (min beg0 end0)) | |
4784 (end (max beg0 end0)) | |
4785 (tabsep t) | |
4786 re) | |
4787 (goto-char beg) | |
4788 (beginning-of-line 1) | |
4789 (setq beg (move-marker (make-marker) (point))) | |
4790 (goto-char end) | |
4791 (if (bolp) (backward-char 1) (end-of-line 1)) | |
4792 (setq end (move-marker (make-marker) (point))) | |
4793 ;; Lets see if this is tab-separated material. If every nonempty line | |
4794 ;; contains a tab, we will assume that it is tab-separated material | |
4795 (if nspace | |
4796 (setq tabsep nil) | |
4797 (goto-char beg) | |
4798 (and (re-search-forward "^[^\n\t]+$" end t) (setq tabsep nil))) | |
4799 (if nspace (setq tabsep nil)) | |
4800 (if tabsep | |
4801 (setq re "^\\|\t") | |
4802 (setq re (format "^ *\\| *\t *\\| \\{%d,\\}" | |
4803 (max 1 (prefix-numeric-value nspace))))) | |
4804 (goto-char beg) | |
4805 (while (re-search-forward re end t) | |
4806 (replace-match "|" t t)) | |
4807 (goto-char beg) | |
4808 (insert " ") | |
4809 (org-table-align))) | |
4810 | |
4811 (defun org-table-import (file arg) | |
4812 "Import FILE as a table. | |
4813 The file is assumed to be tab-separated. Such files can be produced by most | |
4814 spreadsheet and database applications. If no tabs (at least one per line) | |
4815 are found, lines will be split on whitespace into fields." | |
4816 (interactive "f\nP") | |
4817 (or (bolp) (newline)) | |
4818 (let ((beg (point)) | |
4819 (pm (point-max))) | |
4820 (insert-file-contents file) | |
4821 (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg))) | |
4822 | |
4823 (defun org-table-export () | |
4824 "Export table as a tab-separated file. | |
4825 Such a file can be imported into a spreadsheet program like Excel." | |
4826 (interactive) | |
4827 (let* ((beg (org-table-begin)) | |
4828 (end (org-table-end)) | |
4829 (table (buffer-substring beg end)) | |
4830 (file (read-file-name "Export table to: ")) | |
4831 buf) | |
4832 (unless (or (not (file-exists-p file)) | |
4833 (y-or-n-p (format "Overwrite file %s? " file))) | |
4834 (error "Abort")) | |
4835 (save-excursion | |
4836 (find-file file) | |
4837 (setq buf (current-buffer)) | |
4838 (erase-buffer) | |
4839 (fundamental-mode) | |
4840 (insert table) | |
4841 (goto-char (point-min)) | |
4842 (while (re-search-forward "^[ \t]*|[ \t]*" nil t) | |
4843 (replace-match "" t t) | |
4844 (end-of-line 1)) | |
4845 (goto-char (point-min)) | |
4846 (while (re-search-forward "[ \t]*|[ \t]*$" nil t) | |
4847 (replace-match "" t t) | |
4848 (goto-char (min (1+ (point)) (point-max)))) | |
4849 (goto-char (point-min)) | |
4850 (while (re-search-forward "^-[-+]*$" nil t) | |
4851 (replace-match "") | |
4852 (if (looking-at "\n") | |
4853 (delete-char 1))) | |
4854 (goto-char (point-min)) | |
4855 (while (re-search-forward "[ \t]*|[ \t]*" nil t) | |
4856 (replace-match "\t" t t)) | |
4857 (save-buffer)) | |
4858 (kill-buffer buf))) | |
4859 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4860 (defvar org-table-aligned-begin-marker (make-marker) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4861 "Marker at the beginning of the table last aligned. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4862 Used to check if cursor still is in that table, to minimize realignment.") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4863 (defvar org-table-aligned-end-marker (make-marker) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4864 "Marker at the end of the table last aligned. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4865 Used to check if cursor still is in that table, to minimize realignment.") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4866 (defvar org-table-last-alignment nil |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4867 "List of flags for flushright alignment, from the last re-algnment. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4868 This is being used to correctly align a single field after TAB or RET.") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4869 ;; FIXME: The following is currently not used. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4870 (defvar org-table-last-column-widths nil |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4871 "List of max width of ffields in each column. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4872 This is being used to correctly align a single field after TAB or RET.") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4873 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4874 |
58792 | 4875 (defun org-table-align (&optional arg) |
4876 "Align the table at point by aligning all vertical bars." | |
4877 (interactive "P") | |
4878 (let* ( | |
4879 ;; Limits of table | |
4880 (beg (org-table-begin)) | |
4881 (end (org-table-end)) | |
4882 ;; Current cursor position | |
4883 (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) | |
4884 (colpos (org-table-current-column)) | |
4885 (winstart (window-start)) | |
4886 text lines (new "") lengths l typenums ty fields maxfields i | |
4887 column | |
4888 (indent "") cnt frac | |
4889 rfmt hfmt | |
4890 (spaces (if (org-in-invisibility-spec-p '(org-table)) | |
4891 org-table-spaces-around-invisible-separators | |
4892 org-table-spaces-around-separators)) | |
4893 (sp1 (car spaces)) | |
4894 (sp2 (cdr spaces)) | |
4895 (rfmt1 (concat | |
4896 (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) | |
4897 (hfmt1 (concat | |
4898 (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) | |
4899 emptystrings) | |
4900 (untabify beg end) | |
4901 ;; (message "Aligning table...") | |
4902 ;; Get the rows | |
4903 (setq lines (org-split-string | |
4904 (buffer-substring-no-properties beg end) "\n")) | |
4905 ;; Store the indentation of the first line | |
4906 (if (string-match "^ *" (car lines)) | |
4907 (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) | |
4908 ;; Mark the hlines | |
4909 (setq lines (mapcar (lambda (l) (if (string-match "^ *|-" l) nil l)) | |
4910 lines)) | |
4911 ;; Get the data fields | |
4912 (setq fields (mapcar | |
4913 (lambda (l) | |
4914 (org-split-string l " *| *")) | |
4915 (delq nil (copy-sequence lines)))) | |
4916 ;; How many fields in the longest line? | |
4917 (condition-case nil | |
4918 (setq maxfields (apply 'max (mapcar 'length fields))) | |
4919 (error | |
4920 (kill-region beg end) | |
4921 (org-table-create org-table-default-size) | |
4922 (error "Empty table - created default table"))) | |
4923 ;; A list of empty string to fill any short rows on output | |
4924 (setq emptystrings (make-list maxfields "")) | |
4925 ;; Get the maximum length of a field and the most common datatype | |
4926 ;; for each column | |
4927 (setq i -1) | |
4928 (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns | |
4929 (setq column (mapcar (lambda (x) (or (nth i x) "")) fields)) | |
4930 ;; maximum length | |
4931 (push (apply 'max 1 (mapcar 'length column)) lengths) | |
4932 ;; compute the fraction stepwise, ignoring empty fields | |
4933 (setq cnt 0 frac 0.0) | |
4934 (mapcar | |
4935 (lambda (x) | |
4936 (if (equal x "") | |
4937 nil | |
4938 (setq frac ( / (+ (* frac cnt) | |
4939 (if (string-match org-table-number-regexp x) 1 0)) | |
4940 (setq cnt (1+ cnt)))))) | |
4941 column) | |
4942 (push (>= frac org-table-number-fraction) typenums)) | |
4943 (setq lengths (nreverse lengths) | |
4944 typenums (nreverse typenums)) | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4945 (setq org-table-last-alignment typenums |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4946 org-table-last-column-widths lengths) |
58792 | 4947 ;; Compute the formats needed for output of the table |
4948 (setq rfmt (concat indent "|") hfmt (concat indent "|")) | |
4949 (while (setq l (pop lengths)) | |
4950 (setq ty (if (pop typenums) "" "-")) ; number types flushright | |
4951 (setq rfmt (concat rfmt (format rfmt1 ty l)) | |
4952 hfmt (concat hfmt (format hfmt1 (make-string l ?-))))) | |
4953 (setq rfmt (concat rfmt "\n") | |
4954 hfmt (concat (substring hfmt 0 -1) "|\n")) | |
4955 ;; Produce the new table | |
4956 (while lines | |
4957 (setq l (pop lines)) | |
4958 (if l | |
4959 (setq new (concat new (apply 'format rfmt | |
4960 (append (pop fields) emptystrings)))) | |
4961 (setq new (concat new hfmt)))) | |
4962 ;; Replace the old one | |
4963 (delete-region beg end) | |
4964 (move-marker end nil) | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4965 (move-marker org-table-aligned-begin-marker (point)) |
58792 | 4966 (insert new) |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
4967 (move-marker org-table-aligned-end-marker (point)) |
58792 | 4968 ;; Try to move to the old location (approximately) |
4969 (goto-line linepos) | |
4970 (set-window-start (selected-window) winstart 'noforce) | |
4971 (org-table-goto-column colpos) | |
4972 (setq org-table-may-need-update nil) | |
4973 (if (org-in-invisibility-spec-p '(org-table)) | |
4974 (org-table-add-invisible-to-vertical-lines)) | |
4975 )) | |
4976 | |
4977 (defun org-table-begin (&optional table-type) | |
4978 "Find the beginning of the table and return its position. | |
4979 With argument TABLE-TYPE, go to the beginning of a table.el-type table." | |
4980 (save-excursion | |
4981 (if (not (re-search-backward | |
4982 (if table-type org-table-any-border-regexp | |
4983 org-table-border-regexp) | |
4984 nil t)) | |
4985 (error "Can't find beginning of table") | |
4986 (goto-char (match-beginning 0)) | |
4987 (beginning-of-line 2) | |
4988 (point)))) | |
4989 | |
4990 (defun org-table-end (&optional table-type) | |
4991 "Find the end of the table and return its position. | |
4992 With argument TABLE-TYPE, go to the end of a table.el-type table." | |
4993 (save-excursion | |
4994 (if (not (re-search-forward | |
4995 (if table-type org-table-any-border-regexp | |
4996 org-table-border-regexp) | |
4997 nil t)) | |
4998 (goto-char (point-max)) | |
4999 (goto-char (match-beginning 0))) | |
5000 (point-marker))) | |
5001 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5002 (defun org-table-justify-field-maybe () |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5003 "Justify the current field, text to left, number to right." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5004 (cond |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5005 (org-table-may-need-update) ; Realignment will happen anyway, don't bother |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5006 ((org-at-table-hline-p) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5007 ;; This is pretty stupid, but I don't know how to deal with hlines |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5008 (setq org-table-may-need-update t)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5009 ((or (not (equal (marker-buffer org-table-aligned-begin-marker) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5010 (current-buffer))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5011 (< (point) org-table-aligned-begin-marker) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5012 (>= (point) org-table-aligned-end-marker)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5013 ;; This is not the same table, force a full re-align |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5014 (setq org-table-may-need-update t)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5015 (t ;; realign the current field, based on previous full realign |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5016 (let* ((pos (point)) s org-table-may-need-update |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5017 (col (org-table-current-column)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5018 (num (nth (1- col) org-table-last-alignment)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5019 l f) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5020 (when (> col 0) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5021 (skip-chars-backward "^|\n") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5022 (if (looking-at " *\\([^|\n]*?\\) *|") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5023 (progn |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5024 (setq s (match-string 1) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5025 l (max 1 (- (match-end 0) (match-beginning 0) 3))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5026 (setq f (format (if num " %%%ds |" " %%-%ds |") l)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5027 (replace-match (format f s t t))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5028 (setq org-table-may-need-update t)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5029 (goto-char pos)))))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5030 |
58792 | 5031 (defun org-table-next-field (&optional arg) |
5032 "Go to the next field in the current table. | |
5033 Before doing so, re-align the table if necessary." | |
5034 (interactive "P") | |
5035 (if (and org-table-automatic-realign | |
5036 org-table-may-need-update) | |
5037 (org-table-align)) | |
5038 (if (org-at-table-hline-p) | |
5039 (end-of-line 1)) | |
5040 (condition-case nil | |
5041 (progn | |
5042 (re-search-forward "|" (org-table-end)) | |
5043 (if (looking-at "[ \t]*$") | |
5044 (re-search-forward "|" (org-table-end))) | |
5045 (if (looking-at "-") | |
5046 (progn | |
5047 (beginning-of-line 0) | |
5048 (org-table-insert-row 'below)) | |
5049 (if (looking-at " ") (forward-char 1)))) | |
5050 (error | |
5051 (org-table-insert-row 'below)))) | |
5052 | |
5053 (defun org-table-previous-field (&optional arg) | |
5054 "Go to the previous field in the table. | |
5055 Before doing so, re-align the table if necessary." | |
5056 (interactive "P") | |
5057 (if (and org-table-automatic-realign | |
5058 org-table-may-need-update) | |
5059 (org-table-align)) | |
5060 (if (org-at-table-hline-p) | |
5061 (end-of-line 1)) | |
5062 (re-search-backward "|" (org-table-begin)) | |
5063 (re-search-backward "|" (org-table-begin)) | |
5064 (while (looking-at "|\\(-\\|[ \t]*$\\)") | |
5065 (re-search-backward "|" (org-table-begin))) | |
5066 (if (looking-at "| ?") | |
5067 (goto-char (match-end 0)))) | |
5068 | |
5069 (defun org-table-next-row (&optional arg) | |
5070 "Go to the next row (same column) in the current table. | |
5071 Before doing so, re-align the table if necessary." | |
5072 (interactive "P") | |
5073 (if (or (looking-at "[ \t]*$") | |
5074 (save-excursion (skip-chars-backward " \t") (bolp))) | |
5075 (newline) | |
5076 (if (and org-table-automatic-realign | |
5077 org-table-may-need-update) | |
5078 (org-table-align)) | |
5079 (let ((col (org-table-current-column))) | |
5080 (beginning-of-line 2) | |
5081 (if (or (not (org-at-table-p)) | |
5082 (org-at-table-hline-p)) | |
5083 (progn | |
5084 (beginning-of-line 0) | |
5085 (org-table-insert-row 'below))) | |
5086 (org-table-goto-column col) | |
5087 (skip-chars-backward "^|\n\r") | |
5088 (if (looking-at " ") (forward-char 1))))) | |
5089 | |
5090 (defun org-table-copy-from-above (n) | |
5091 "Copy into the current column the nearest non-empty field from above. | |
5092 With prefix argument N, take the Nth non-empty field." | |
5093 (interactive "p") | |
5094 (let ((colpos (org-table-current-column)) | |
5095 (beg (org-table-begin)) | |
5096 txt) | |
5097 (org-table-check-inside-data-field) | |
5098 (if (save-excursion | |
5099 (setq txt | |
5100 (catch 'exit | |
5101 (while (progn (beginning-of-line 1) | |
5102 (re-search-backward org-table-dataline-regexp | |
5103 beg t)) | |
5104 (org-table-goto-column colpos t) | |
5105 (if (and (looking-at | |
5106 "|[ \t]*\\([^| \t][^|]*[^| \t]\\)[ \t]*|") | |
5107 (= (setq n (1- n)) 0)) | |
5108 (throw 'exit (match-string 1))))))) | |
5109 (progn | |
5110 (insert txt) | |
5111 (org-table-align)) | |
5112 (error "No non-empty field found")))) | |
5113 | |
5114 (defun org-table-check-inside-data-field () | |
5115 "Is point inside a table data field? | |
5116 I.e. not on a hline or before the first or after the last column?" | |
5117 (if (or (not (org-at-table-p)) | |
5118 (= (org-table-current-column) 0) | |
5119 (org-at-table-hline-p) | |
5120 (looking-at "[ \t]*$")) | |
5121 (error "Not in table data field"))) | |
5122 | |
5123 (defun org-table-blank-field () | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5124 "Blank the current table field or active region." |
58792 | 5125 (interactive) |
5126 (org-table-check-inside-data-field) | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5127 (if (and (interactive-p) (org-region-active-p)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5128 (let (org-table-clip) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5129 (org-table-cut-region)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5130 (skip-chars-backward "^|") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5131 (backward-char 1) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5132 (if (looking-at "|[^|]+") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5133 (let* ((pos (match-beginning 0)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5134 (match (match-string 0)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5135 (len (length match))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5136 (replace-match (concat "|" (make-string (1- len) ?\ ))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5137 (goto-char (+ 2 pos)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5138 (substring match 1))))) |
58792 | 5139 |
5140 (defun org-table-get-field (&optional n replace) | |
5141 "Return the value of the field in column N of current row. | |
5142 N defaults to current field. | |
5143 If REPLACE is a string, replace field with this value. The return value | |
5144 is always the old value." | |
5145 (and n (org-table-goto-column n)) | |
5146 (skip-chars-backward "^|") | |
5147 (backward-char 1) | |
5148 (if (looking-at "|[^|\r\n]*") | |
5149 (let* ((pos (match-beginning 0)) | |
5150 (len (length (match-string 0))) | |
5151 (val (buffer-substring (1+ pos) (match-end 0)))) | |
5152 (if replace | |
5153 (replace-match (concat "|" replace))) | |
5154 (goto-char (+ 2 pos)) | |
5155 val))) | |
5156 | |
5157 (defun org-table-current-column () | |
5158 "Find out which column we are in. | |
5159 When called interactively, column is also displayed in echo area." | |
5160 (interactive) | |
5161 (if (interactive-p) (org-table-check-inside-data-field)) | |
5162 (save-excursion | |
5163 (let ((cnt 0) (pos (point))) | |
5164 (beginning-of-line 1) | |
5165 (while (search-forward "|" pos t) | |
5166 (setq cnt (1+ cnt))) | |
5167 (if (interactive-p) (message "This is table column %d" cnt)) | |
5168 cnt))) | |
5169 | |
5170 (defun org-table-goto-column (n &optional on-delim force) | |
5171 "Move the cursor to the Nth column in the current table line. | |
5172 With optional argument ON-DELIM, stop with point before the left delimiter | |
5173 of the field. | |
5174 If there are less than N fields, just go to after the last delimiter. | |
5175 However, when FORCE is non-nil, create new columns if necessary." | |
5176 (let ((pos (point-at-eol))) | |
5177 (beginning-of-line 1) | |
5178 (when (> n 0) | |
5179 (while (and (> (setq n (1- n)) -1) | |
5180 (or (search-forward "|" pos t) | |
5181 (and force | |
5182 (progn (end-of-line 1) | |
5183 (skip-chars-backward "^|") | |
5184 (insert " |") | |
5185 (bachward-char 2) t))))) | |
5186 (when (and force (not (looking-at ".*|"))) | |
5187 (save-excursion (end-of-line 1) (insert "|"))) | |
5188 (if on-delim | |
5189 (backward-char 1) | |
5190 (if (looking-at " ") (forward-char 1)))))) | |
5191 | |
5192 (defun org-at-table-p (&optional table-type) | |
5193 "Return t if the cursor is inside an org-type table." | |
5194 (if org-enable-table-editor | |
5195 (save-excursion | |
5196 (beginning-of-line 1) | |
5197 (looking-at (if table-type org-table-any-line-regexp | |
5198 org-table-line-regexp))) | |
5199 nil)) | |
5200 | |
5201 (defun org-table-recognize-table.el () | |
5202 "If there is a table.el table nearby, recognize it and move into it." | |
5203 (if org-table-tab-recognizes-table.el | |
5204 (if (org-at-table.el-p) | |
5205 (progn | |
5206 (beginning-of-line 1) | |
5207 (if (looking-at org-table-dataline-regexp) | |
5208 nil | |
5209 (if (looking-at org-table1-hline-regexp) | |
5210 (progn | |
5211 (beginning-of-line 2) | |
5212 (if (looking-at org-table-any-border-regexp) | |
5213 (beginning-of-line -1))))) | |
5214 (if (re-search-forward "|" (org-table-end t) t) | |
5215 (progn | |
5216 (require 'table) | |
5217 (if (table--at-cell-p (point)) | |
5218 t | |
5219 (message "recognizing table.el table...") | |
5220 (table-recognize-table) | |
5221 (message "recognizing table.el table...done"))) | |
5222 (error "This should not happen...")) | |
5223 t) | |
5224 nil) | |
5225 nil)) | |
5226 | |
5227 (defun org-at-table.el-p () | |
5228 "Return t if the cursor is inside a table.el-type table." | |
5229 (save-excursion | |
5230 (if (org-at-table-p 'any) | |
5231 (progn | |
5232 (goto-char (org-table-begin 'any)) | |
5233 (looking-at org-table1-hline-regexp)) | |
5234 nil))) | |
5235 | |
5236 (defun org-at-table-hline-p () | |
5237 "Return t if the cursor is inside a hline in a table." | |
5238 (if org-enable-table-editor | |
5239 (save-excursion | |
5240 (beginning-of-line 1) | |
5241 (looking-at org-table-hline-regexp)) | |
5242 nil)) | |
5243 | |
5244 (defun org-table-insert-column (&optional arg) | |
5245 "Insert a new column into the table." | |
5246 (interactive "P") | |
5247 (if (not (org-at-table-p)) | |
5248 (error "Not at a table")) | |
5249 (org-table-find-dataline) | |
5250 (let* ((col (max 1 (org-table-current-column))) | |
5251 (beg (org-table-begin)) | |
5252 (end (org-table-end)) | |
5253 ;; Current cursor position | |
5254 (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) | |
5255 (colpos col)) | |
5256 (goto-char beg) | |
5257 (while (< (point) end) | |
5258 (if (org-at-table-hline-p) | |
5259 nil | |
5260 (org-table-goto-column col t) | |
5261 (insert "| ")) | |
5262 (beginning-of-line 2)) | |
5263 (move-marker end nil) | |
5264 (goto-line linepos) | |
5265 (org-table-goto-column colpos)) | |
5266 (org-table-align)) | |
5267 | |
5268 (defun org-table-find-dataline () | |
5269 "Find a dataline in the current table, which is needed for column commands." | |
5270 (if (and (org-at-table-p) | |
5271 (not (org-at-table-hline-p))) | |
5272 t | |
5273 (let ((col (current-column)) | |
5274 (end (org-table-end))) | |
5275 (move-to-column col) | |
5276 (while (and (< (point) end) | |
5277 (or (not (= (current-column) col)) | |
5278 (org-at-table-hline-p))) | |
5279 (beginning-of-line 2) | |
5280 (move-to-column col)) | |
5281 (if (and (org-at-table-p) | |
5282 (not (org-at-table-hline-p))) | |
5283 t | |
5284 (error | |
5285 "Please position cursor in a data line for column operations"))))) | |
5286 | |
5287 (defun org-table-delete-column (&optional arg) | |
5288 "Insert a new column into the table." | |
5289 (interactive "P") | |
5290 (if (not (org-at-table-p)) | |
5291 (error "Not at a table")) | |
5292 (org-table-find-dataline) | |
5293 (org-table-check-inside-data-field) | |
5294 (let* ((col (org-table-current-column)) | |
5295 (beg (org-table-begin)) | |
5296 (end (org-table-end)) | |
5297 ;; Current cursor position | |
5298 (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) | |
5299 (colpos col)) | |
5300 (goto-char beg) | |
5301 (while (< (point) end) | |
5302 (if (org-at-table-hline-p) | |
5303 nil | |
5304 (org-table-goto-column col t) | |
5305 (and (looking-at "|[^|\n]+|") | |
5306 (replace-match "|"))) | |
5307 (beginning-of-line 2)) | |
5308 (move-marker end nil) | |
5309 (goto-line linepos) | |
5310 (org-table-goto-column colpos)) | |
5311 (org-table-align)) | |
5312 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5313 (defun org-table-move-column-right () |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5314 "Move column to the right." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5315 (interactive) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5316 (org-table-move-column nil)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5317 (defun org-table-move-column-left () |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5318 "Move column to the left." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5319 (interactive) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5320 (org-table-move-column 'left)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5321 |
58792 | 5322 (defun org-table-move-column (&optional left) |
5323 "Move the current column to the right. With arg LEFT, move to the left." | |
5324 (interactive "P") | |
5325 (if (not (org-at-table-p)) | |
5326 (error "Not at a table")) | |
5327 (org-table-find-dataline) | |
5328 (org-table-check-inside-data-field) | |
5329 (let* ((col (org-table-current-column)) | |
5330 (col1 (if left (1- col) col)) | |
5331 (beg (org-table-begin)) | |
5332 (end (org-table-end)) | |
5333 ;; Current cursor position | |
5334 (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) | |
5335 (colpos (if left (1- col) (1+ col)))) | |
5336 (if (and left (= col 1)) | |
5337 (error "Cannot move column further left")) | |
5338 (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) | |
5339 (error "Cannot move column further right")) | |
5340 (goto-char beg) | |
5341 (while (< (point) end) | |
5342 (if (org-at-table-hline-p) | |
5343 nil | |
5344 (org-table-goto-column col1 t) | |
5345 (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") | |
5346 (replace-match "|\\2|\\1|"))) | |
5347 (beginning-of-line 2)) | |
5348 (move-marker end nil) | |
5349 (goto-line linepos) | |
5350 (org-table-goto-column colpos)) | |
5351 (org-table-align)) | |
5352 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5353 (defun org-table-move-row-down () |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5354 "Move table row down." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5355 (interactive) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5356 (org-table-move-row nil)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5357 (defun org-table-move-row-up () |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5358 "Move table row down." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5359 (interactive) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5360 (org-table-move-row 'up)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5361 |
58792 | 5362 (defun org-table-move-row (&optional up) |
5363 "Move the current table line down. With arg UP, move it up." | |
5364 (interactive "P") | |
5365 (let ((col (current-column)) | |
5366 (pos (point)) | |
5367 (tonew (if up 0 2)) | |
5368 txt) | |
5369 (beginning-of-line tonew) | |
5370 (if (not (org-at-table-p)) | |
5371 (progn | |
5372 (goto-char pos) | |
5373 (error "Cannot move row further."))) | |
5374 (goto-char pos) | |
5375 (beginning-of-line 1) | |
5376 (setq pos (point)) | |
5377 (setq txt (buffer-substring (point) (1+ (point-at-eol)))) | |
5378 (delete-region (point) (1+ (point-at-eol))) | |
5379 (beginning-of-line tonew) | |
5380 (insert txt) | |
5381 (beginning-of-line 0) | |
5382 (move-to-column col))) | |
5383 | |
5384 (defun org-table-insert-row (&optional arg) | |
5385 "Insert a new row above the current line into the table. | |
5386 With prefix ARG, insert below the current line." | |
5387 (interactive "P") | |
5388 (if (not (org-at-table-p)) | |
5389 (error "Not at a table")) | |
5390 (let ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) | |
5391 (if (string-match "^[ \t]*|-" line) | |
5392 (setq line (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) line)) | |
5393 (setq line (mapcar (lambda (x) (if (equal x ?|) ?| ?\ )) line))) | |
5394 (beginning-of-line (if arg 2 1)) | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5395 (let (org-table-may-need-update) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5396 (apply 'insert-before-markers line) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5397 (insert-before-markers "\n")) |
58792 | 5398 (beginning-of-line 0) |
5399 (re-search-forward "| ?" (point-at-eol) t) | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5400 (and org-table-may-need-update (org-table-align)))) |
58792 | 5401 |
5402 (defun org-table-insert-hline (&optional arg) | |
5403 "Insert a horizontal-line below the current line into the table. | |
5404 With prefix ARG, insert above the current line." | |
5405 (interactive "P") | |
5406 (if (not (org-at-table-p)) | |
5407 (error "Not at a table")) | |
5408 (let ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol))) | |
5409 (col (current-column)) | |
5410 start) | |
5411 (if (string-match "^[ \t]*|-" line) | |
5412 (setq line | |
5413 (mapcar (lambda (x) (if (member x '(?| ?+)) | |
5414 (prog1 (if start ?+ ?|) (setq start t)) | |
5415 (if start ?- ?\ ))) | |
5416 line)) | |
5417 (setq line | |
5418 (mapcar (lambda (x) (if (equal x ?|) | |
5419 (prog1 (if start ?+ ?|) (setq start t)) | |
5420 (if start ?- ?\ ))) | |
5421 line))) | |
5422 (beginning-of-line (if arg 1 2)) | |
5423 (apply 'insert line) | |
5424 (if (equal (char-before (point)) ?+) | |
5425 (progn (backward-delete-char 1) (insert "|"))) | |
5426 (insert "\n") | |
5427 (beginning-of-line 0) | |
5428 (move-to-column col))) | |
5429 | |
5430 (defun org-table-kill-row (&optional arg) | |
5431 "Delete the current row or horizontal line from the table." | |
5432 (interactive "P") | |
5433 (if (not (org-at-table-p)) | |
5434 (error "Not at a table")) | |
5435 (let ((col (current-column))) | |
5436 (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) | |
5437 (if (not (org-at-table-p)) (beginning-of-line 0)) | |
5438 (move-to-column col))) | |
5439 | |
5440 | |
5441 (defun org-table-cut-region (&optional arg) | |
5442 "Copy region in table to the clipboard and blank all relevant fields." | |
5443 (interactive "P") | |
5444 (org-table-copy-region 'cut)) | |
5445 | |
5446 (defvar org-table-clip nil | |
5447 "Clipboard for table regions") | |
5448 | |
5449 (defun org-table-copy-region (&optional cut) | |
5450 "Copy rectangular region in table to clipboard. | |
5451 A special clibbooard is used which can only be accessed | |
5452 with `org-table-paste-rectangle'" | |
5453 (interactive "P") | |
5454 (unless (org-region-active-p) (error "No active region")) | |
5455 (let* ((beg (region-beginning)) | |
5456 (end (region-end)) | |
5457 l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 | |
5458 region cols | |
5459 (rpl (if cut " " nil))) | |
5460 (goto-char beg) | |
5461 (org-table-check-inside-data-field) | |
5462 (setq l01 (count-lines (point-min) (point)) | |
5463 c01 (org-table-current-column)) | |
5464 (goto-char end) | |
5465 (org-table-check-inside-data-field) | |
5466 (setq l02 (count-lines (point-min) (point)) | |
5467 c02 (org-table-current-column)) | |
5468 (setq l1 (min l01 l02) l2 (max l01 l02) | |
5469 c1 (min c01 c02) c2 (max c01 c02)) | |
5470 (catch 'exit | |
5471 (while t | |
5472 (catch 'nextline | |
5473 (if (> l1 l2) (throw 'exit t)) | |
5474 (goto-line l1) | |
5475 (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1)))) | |
5476 (setq cols nil ic1 c1 ic2 c2) | |
5477 (while (< ic1 (1+ ic2)) | |
5478 (push (org-table-get-field ic1 rpl) cols) | |
5479 (setq ic1 (1+ ic1))) | |
5480 (push (nreverse cols) region) | |
5481 (setq l1 (1+ l1))))) | |
5482 (setq org-table-clip (nreverse region)) | |
5483 (if cut (org-table-align)))) | |
5484 | |
5485 (defun org-table-paste-rectangle (&optional arg) | |
5486 "Paste a rectangluar region into a table. | |
5487 The upper right corner ends up in the current field. All involved fields | |
5488 will be overwritten. If the rectangle does not fit into the present table, | |
5489 the table is enlarged as needed. The process ignores horizontal separator | |
5490 lines." | |
5491 (interactive "P") | |
5492 (unless (and org-table-clip (listp org-table-clip)) | |
5493 (error "First cut/copy a region to paste!")) | |
5494 (org-table-check-inside-data-field) | |
5495 (let* ((clip org-table-clip) | |
5496 (line (count-lines (point-min) (point))) | |
5497 (col (org-table-current-column)) | |
5498 (l line) | |
5499 (org-enable-table-editor t) | |
5500 (org-table-automatic-realign nil) | |
5501 c cols field) | |
5502 (while (setq cols (pop clip)) | |
5503 (while (org-at-table-hline-p) (beginning-of-line 2)) | |
5504 (if (not (org-at-table-p)) | |
5505 (progn (end-of-line 0) (org-table-next-field))) | |
5506 (setq c col) | |
5507 (while (setq field (pop cols)) | |
5508 (org-table-goto-column c nil 'force) | |
5509 (org-table-get-field nil field) | |
5510 (setq c (1+ c))) | |
5511 (beginning-of-line 2)) | |
5512 (goto-line line) | |
5513 (org-table-goto-column col) | |
5514 (org-table-align))) | |
5515 | |
5516 (defun org-table-convert () | |
5517 "Convert from org-mode table to table.el and back. | |
5518 Obviously, this only works within limits. When an Org-mode table is | |
5519 converted to table.el, all horizontal separator lines get lost, because | |
5520 table.el uses these as cell boundaries and has no notion of horizontal lines. | |
5521 A table.el table can be converted to an Org-mode table only if it does not | |
5522 do row or column spanning. Multiline cells will become multiple cells. | |
5523 Beware, Org-mode does not test if the table can be successfully converted - it | |
5524 blindly applies a recipe that works for simple tables." | |
5525 (interactive) | |
5526 (require 'table) | |
5527 (if (org-at-table.el-p) | |
5528 ;; convert to Org-mode table | |
5529 (let ((beg (move-marker (make-marker) (org-table-begin t))) | |
5530 (end (move-marker (make-marker) (org-table-end t)))) | |
5531 (table-unrecognize-region beg end) | |
5532 (goto-char beg) | |
5533 (while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t) | |
5534 (replace-match "")) | |
5535 (goto-char beg)) | |
5536 (if (org-at-table-p) | |
5537 ;; convert to table.el table | |
5538 (let ((beg (move-marker (make-marker) (org-table-begin))) | |
5539 (end (move-marker (make-marker) (org-table-end)))) | |
5540 ;; first, get rid of all horizontal lines | |
5541 (goto-char beg) | |
5542 (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t) | |
5543 (replace-match "")) | |
5544 ;; insert a hline before first | |
5545 (goto-char beg) | |
5546 (org-table-insert-hline 'above) | |
5547 ;; insert a hline after each line | |
5548 (while (progn (beginning-of-line 2) (< (point) end)) | |
5549 (org-table-insert-hline)) | |
5550 (goto-char beg) | |
5551 (setq end (move-marker end (org-table-end))) | |
5552 ;; replace "+" at beginning and ending of hlines | |
5553 (while (re-search-forward "^\\([ \t]*\\)|-" end t) | |
5554 (replace-match "\\1+-")) | |
5555 (goto-char beg) | |
5556 (while (re-search-forward "-|[ \t]*$" end t) | |
5557 (replace-match "-+")) | |
5558 (goto-char beg))))) | |
5559 | |
5560 (defun org-table-wrap-region (arg) | |
5561 "Wrap several fields in a column like a paragraph. | |
5562 This is useful if you'd like to spread the contents of a field over several | |
5563 lines, in order to keep the table compact. | |
5564 | |
5565 If there is an active region, and both point and mark are in the same column, | |
5566 the text in the column is wrapped to minimum width for the given number of | |
5567 lines. Generally, this makes the table more compact. A prefix ARG may be | |
5568 used to change the number of desired lines. For example, `C-2 C-c C-q' | |
5569 formats the selected text to two lines. If the region was longer than 2 | |
5570 lines, the remaining lines remain empty. A negative prefix argument reduces | |
5571 the current number of lines by that amount. The wrapped text is pasted back | |
5572 into the table. If you formatted it to more lines than it was before, fields | |
5573 further down in the table get overwritten - so you might need to make space in | |
5574 the table first. | |
5575 | |
5576 If there is no region, the current field is split at the cursor position and | |
5577 the text fragment to the right of the cursor is prepended to the field one | |
5578 line down. | |
5579 | |
5580 If there is no region, but you specify a prefix ARG, the current field gets | |
5581 blank, and the content is appended to the field above." | |
5582 (interactive "P") | |
5583 (org-table-check-inside-data-field) | |
5584 (if (org-region-active-p) | |
5585 ;; There is a region: fill as a paragraph | |
5586 (let ((beg (region-beginning)) | |
5587 nlines) | |
5588 (org-table-cut-region) | |
5589 (if (> (length (car org-table-clip)) 1) | |
5590 (error "Region must be limited to single columm")) | |
5591 (setq nlines (if arg | |
5592 (if (< arg 1) | |
5593 (+ (length org-table-clip) arg) | |
5594 arg) | |
5595 (length org-table-clip))) | |
5596 (setq org-table-clip | |
5597 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") | |
5598 nil nlines))) | |
5599 (goto-char beg) | |
5600 (org-table-paste-rectangle)) | |
5601 ;; No region, split the current field at point | |
5602 (if arg | |
5603 ;; combine with field above | |
5604 (let ((s (org-table-blank-field)) | |
5605 (col (org-table-current-column))) | |
5606 (beginning-of-line 0) | |
5607 (while (org-at-table-hline-p) (beginning-of-line 0)) | |
5608 (org-table-goto-column col) | |
5609 (skip-chars-forward "^|") | |
5610 (skip-chars-backward " ") | |
5611 (insert " " (org-trim s)) | |
5612 (org-table-align)) | |
5613 ;; split field | |
5614 (when (looking-at "\\([^|]+\\)+|") | |
5615 (let ((s (match-string 1))) | |
5616 (replace-match " |") | |
5617 (goto-char (match-beginning 0)) | |
5618 (org-table-next-row) | |
5619 (insert (org-trim s) " ") | |
5620 (org-table-align)))))) | |
5621 | |
5622 (defun org-trim (s) | |
5623 "Remove whitespace at beginning and end of string." | |
5624 (if (string-match "^[ \t]+" s) (setq s (replace-match "" t t s))) | |
5625 (if (string-match "[ \t]+$" s) (setq s (replace-match "" t t s)))) | |
5626 | |
5627 (defun org-wrap (string &optional width lines) | |
5628 "Wrap string to either a number of lines, or a with in characters. | |
5629 If WIDTH is non-nil, the string is wrapped to that width, however many lines | |
5630 that costs. If there is a work longer than WIDTH, the text is actually | |
5631 wrapped to the length of that word. | |
5632 IF WIDTH is nil and LINES is non-nil, the string is forced into at mot that | |
5633 many lines, whatever width that takes. | |
5634 The return value is a list of lines, without newlines at the end." | |
5635 (let* ((words (org-split-string string "[ \t\n]+")) | |
5636 (maxword (apply 'max (mapcar 'length words))) | |
5637 (black (apply '+ (mapcar 'length words))) | |
5638 (total (+ black (length words))) | |
5639 w ll) | |
5640 (cond (width | |
5641 (org-do-wrap words (max maxword width))) | |
5642 (lines | |
5643 (setq w maxword) | |
5644 (setq ll (org-do-wrap words maxword)) | |
5645 (if (<= (length ll) lines) | |
5646 ll | |
5647 (setq ll words) | |
5648 (while (> (length ll) lines) | |
5649 (setq w (1+ w)) | |
5650 (setq ll (org-do-wrap words w))) | |
5651 ll)) | |
5652 (t (error "Cannot wrap this"))))) | |
5653 | |
5654 | |
5655 (defun org-do-wrap (words width) | |
5656 "Creates lines of maximum width WIDTH (in characters) from word list WORDS." | |
5657 (let (lines line) | |
5658 (while words | |
5659 (setq line (pop words)) | |
5660 (while (and words (< (+ (length line) (length (car words))) width)) | |
5661 (setq line (concat line " " (pop words)))) | |
5662 (setq lines (push line lines))) | |
5663 (nreverse lines))) | |
5664 | |
5665 ;; FIXME: I think I can make this more efficient | |
5666 (defun org-split-string (string &optional separators) | |
5667 "Splits STRING into substrings at SEPARATORS. | |
5668 No empty strings are returned if there are matches at the beginning | |
5669 and end of string." | |
5670 (let ((rexp (or separators "[ \f\t\n\r\v]+")) | |
5671 (start 0) | |
5672 notfirst | |
5673 (list nil)) | |
5674 (while (and (string-match rexp string | |
5675 (if (and notfirst | |
5676 (= start (match-beginning 0)) | |
5677 (< start (length string))) | |
5678 (1+ start) start)) | |
5679 (< (match-beginning 0) (length string))) | |
5680 (setq notfirst t) | |
5681 (or (eq (match-beginning 0) 0) | |
5682 (and (eq (match-beginning 0) (match-end 0)) | |
5683 (eq (match-beginning 0) start)) | |
5684 (setq list | |
5685 (cons (substring string start (match-beginning 0)) | |
5686 list))) | |
5687 (setq start (match-end 0))) | |
5688 (or (eq start (length string)) | |
5689 (setq list | |
5690 (cons (substring string start) | |
5691 list))) | |
5692 (nreverse list))) | |
5693 | |
5694 (defun org-table-add-invisible-to-vertical-lines () | |
5695 "Add an `invisible' property to vertical lines of current table." | |
5696 (interactive) | |
5697 (let* ((beg (org-table-begin)) | |
5698 (end (org-table-end)) | |
5699 (end1)) | |
5700 (save-excursion | |
5701 (goto-char beg) | |
5702 (while (< (point) end) | |
5703 (setq end1 (point-at-eol)) | |
5704 (if (looking-at org-table-dataline-regexp) | |
5705 (while (re-search-forward "|" end1 t) | |
5706 (add-text-properties (1- (point)) (point) | |
5707 '(invisible org-table))) | |
5708 (while (re-search-forward "[+|]" end1 t) | |
5709 (add-text-properties (1- (point)) (point) | |
5710 '(invisible org-table)))) | |
5711 (beginning-of-line 2))))) | |
5712 | |
5713 (defun org-table-toggle-vline-visibility (&optional arg) | |
5714 "Toggle the visibility of table vertical lines. | |
5715 The effect is immediate and on all tables in the file. | |
5716 With prefix ARG, make lines invisible when ARG if positive, make lines | |
5717 visible when ARG is not positive" | |
5718 (interactive "P") | |
5719 (let ((action (cond | |
5720 ((and arg (> (prefix-numeric-value arg) 0)) 'on) | |
5721 ((and arg (< (prefix-numeric-value arg) 1)) 'off) | |
5722 (t (if (org-in-invisibility-spec-p '(org-table)) | |
5723 'off | |
5724 'on))))) | |
5725 (if (eq action 'off) | |
5726 (progn | |
5727 (org-remove-from-invisibility-spec '(org-table)) | |
5728 (org-table-map-tables 'org-table-align) | |
5729 (message "Vertical table lines visible") | |
5730 (if (org-at-table-p) | |
5731 (org-table-align))) | |
5732 (org-add-to-invisibility-spec '(org-table)) | |
5733 (org-table-map-tables 'org-table-align) | |
5734 (message "Vertical table lines invisible")) | |
5735 (redraw-frame (selected-frame)))) | |
5736 | |
5737 (defun org-table-map-tables (function) | |
5738 "Apply FUNCTION to the start of all tables in the buffer." | |
5739 (save-excursion | |
5740 (save-restriction | |
5741 (widen) | |
5742 (goto-char (point-min)) | |
5743 (while (re-search-forward org-table-any-line-regexp nil t) | |
5744 (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) | |
5745 (beginning-of-line 1) | |
5746 (if (looking-at org-table-line-regexp) | |
5747 (save-excursion (funcall function))) | |
5748 (re-search-forward org-table-any-border-regexp nil 1))))) | |
5749 | |
5750 (defun org-table-sum () | |
5751 "Sum numbers in region of current table column. | |
5752 The result will be displayed in the echo area, and will be available | |
5753 as kill to be inserted with \\[yank]. | |
5754 | |
5755 If there is an active region, it is interpreted as a rectangle and all | |
5756 numbers in that rectangle will be summed. If there is no active | |
5757 region and point is located in a table column, sum all numbers in that | |
5758 column. | |
5759 | |
5760 If at least on number looks like a time HH:MM or HH:MM:SS, all other | |
5761 numbers are assumed to be times as well (in decimal hours) and the | |
5762 numbers are added as such." | |
5763 (interactive) | |
5764 (save-excursion | |
5765 (let (beg end col (timecnt 0) diff h m s) | |
5766 (if (org-region-active-p) | |
5767 (setq beg (region-beginning) end (region-end)) | |
5768 (setq col (org-table-current-column)) | |
5769 (goto-char (org-table-begin)) | |
5770 (unless (re-search-forward "^[ \t]*|[^-]" nil t) | |
5771 (error "No table data")) | |
5772 (org-table-goto-column col) | |
5773 (skip-chars-backward "^|") | |
5774 (setq beg (point)) | |
5775 (goto-char (org-table-end)) | |
5776 (unless (re-search-backward "^[ \t]*|[^-]" nil t) | |
5777 (error "No table data")) | |
5778 (org-table-goto-column col) | |
5779 (skip-chars-forward "^|") | |
5780 (setq end (point))) | |
5781 (let* ((l1 (progn (goto-char beg) | |
5782 (+ (if (bolp) 1 0) (count-lines (point-min) (point))))) | |
5783 (l2 (progn (goto-char end) | |
5784 (+ (if (bolp) 1 0) (count-lines (point-min) (point))))) | |
5785 (items (if (= l1 l2) | |
5786 (split-string (buffer-substring beg end)) | |
5787 (split-string | |
5788 (mapconcat 'identity (extract-rectangle beg end) " ")))) | |
5789 (numbers (delq nil (mapcar 'org-table-get-number-for-summing | |
5790 items))) | |
5791 (res (apply '+ numbers)) | |
5792 (sres (if (= timecnt 0) | |
5793 (format "%g" res) | |
5794 (setq diff (* 3600 res) | |
5795 h (floor (/ diff 3600)) diff (mod diff 3600) | |
5796 m (floor (/ diff 60)) diff (mod diff 60) | |
5797 s diff) | |
5798 (format "%d:%02d:%02d" h m s)))) | |
5799 (kill-new sres) | |
5800 (message (substitute-command-keys | |
5801 (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" | |
5802 (length numbers) sres))))))) | |
5803 | |
5804 (defun org-table-get-number-for-summing (s) | |
5805 (let (n) | |
5806 (if (string-match "^ *|? *" s) | |
5807 (setq s (replace-match "" nil nil s))) | |
5808 (if (string-match " *|? *$" s) | |
5809 (setq s (replace-match "" nil nil s))) | |
5810 (setq n (string-to-number s)) | |
5811 (cond | |
5812 ((and (string-match "0" s) | |
5813 (string-match "\\`[-+ \t0.edED]+\\'" s)) 0) | |
5814 ((string-match "\\`[ \t]+\\'" s) nil) | |
5815 ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s) | |
5816 (let ((h (string-to-number (or (match-string 1 s) "0"))) | |
5817 (m (string-to-number (or (match-string 2 s) "0"))) | |
5818 (s (string-to-number (or (match-string 4 s) "0")))) | |
5819 (if (boundp 'timecnt) (setq timecnt (1+ timecnt))) | |
5820 (* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) | |
5821 ((equal n 0) nil) | |
5822 (t n)))) | |
5823 | |
5824 (defvar org-table-current-formula nil) | |
5825 (defvar org-table-formula-history nil) | |
5826 (defun org-table-get-formula (current) | |
5827 (if (and current (not (equal "" org-table-current-formula))) | |
5828 org-table-current-formula | |
5829 (setq org-table-current-formula | |
5830 (read-string | |
5831 "Formula [last]: " "" 'org-table-formula-history | |
5832 org-table-current-formula)))) | |
5833 | |
5834 (defun org-this-word () | |
5835 ;; Get the current word | |
5836 (save-excursion | |
5837 (let ((beg (progn (skip-chars-backward "^ \t\n") (point))) | |
5838 (end (progn (skip-chars-forward "^ \t\n") (point)))) | |
5839 (buffer-substring-no-properties beg end)))) | |
5840 | |
5841 (defun org-table-eval-formula (&optional ndown) | |
5842 "Replace the table field value at the cursor by the result of a calculation. | |
5843 | |
5844 This function makes use of Dave Gillespie's calc package, arguably the most | |
5845 exciting program ever written for GNU Emacs. So you need to have calc | |
5846 installed in order to use this function. | |
5847 | |
5848 In a table, this command replaces the value in the current field with the | |
5849 result of a formula. While nowhere near the computation options of a | |
5850 spreadsheet program, this is still very useful. Note that there is no | |
5851 automatic updating of a calculated field, nor will the field remember the | |
5852 formula. The command needs to be applied again after changing input | |
5853 fields. | |
5854 | |
5855 When called, the command first prompts for a formula, which is read in the | |
5856 minibuffer. Previously entered formulae are available through the history | |
5857 list, and the last used formula is the default, reachable by simply | |
5858 pressing RET. | |
5859 | |
5860 The formula can be any algebraic expression understood by the calc package. | |
5861 Before evaluation, variable substitution takes place: \"$\" is replaced by | |
5862 the field the cursor is currently in, and $1..$n reference the fields in | |
5863 the current row. Values from a *different* row can *not* be referenced | |
5864 here, so the command supports only horizontal computing. The formula can | |
5865 contain an optional printf format specifier after a semicolon, to reformat | |
5866 the result. | |
5867 | |
5868 A few examples for formulae: | |
5869 $1+$2 Sum of first and second field | |
5870 $1+$2;%f.2 Same, and format result to two digits after dec.point | |
5871 exp($2)+exp($1) Math functions can be used | |
5872 $;%f.1 Reformat current cell to 1 digit after dec.point | |
5873 ($3-32)*5/9 degrees F -> C conversion | |
5874 | |
5875 When called with a raw C-u prefix, the formula is applied to the current | |
5876 field, and to the same same column in all following rows, until reaching a | |
5877 horizontal line or the end of the table. When the command is called with a | |
5878 numeric prefix argument (like M-3 or C-7 or C-u 24), the formula is applied | |
5879 to the current row, and to the following n-1 rows (but not beyond a | |
5880 separator line)." | |
5881 (interactive "P") | |
5882 (setq ndown (if (equal ndown '(4)) 10000 (prefix-numeric-value ndown))) | |
5883 (require 'calc) | |
5884 (org-table-check-inside-data-field) | |
5885 (let* (fields | |
5886 (org-table-automatic-realign nil) | |
5887 (down (> ndown 1)) | |
5888 (formula (org-table-get-formula nil)) | |
5889 (n0 (org-table-current-column)) | |
5890 n form fmt x ev) | |
5891 (if (string-match ";" formula) | |
5892 (let ((tmp (org-split-string formula ";"))) | |
5893 (setq formula (car tmp) fmt (nth 1 tmp)))) | |
5894 (while (> ndown 0) | |
5895 (setq fields (org-split-string | |
5896 (concat " " (buffer-substring | |
5897 (point-at-bol) (point-at-eol))) "|")) | |
5898 (setq ndown (1- ndown)) | |
5899 (setq form (copy-sequence formula)) | |
5900 (while (string-match "\\$\\([0-9]+\\)?" form) | |
5901 (setq n (if (match-beginning 1) | |
5902 (string-to-int (match-string 1 form)) | |
5903 n0) | |
5904 x (nth n fields)) | |
5905 (unless x (error "Illegal field specifier \"%s\"" | |
5906 (match-string 0 form))) | |
5907 (if (equal (string-to-number x) 0) (setq x "0")) | |
5908 (setq form (replace-match x t t form))) | |
5909 (setq ev (calc-eval (list form) 'num)) | |
5910 (if (listp ev) | |
5911 (error "Illegal expression: %s (%s at %d)" form (nth 1 ev) (car ev))) | |
5912 (org-table-blank-field) | |
5913 (if fmt | |
5914 (insert (format fmt (string-to-number ev))) | |
5915 (insert ev)) | |
5916 (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) | |
5917 (call-interactively 'org-return) | |
5918 (setq ndown 0))) | |
5919 (org-table-align))) | |
5920 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5921 ;;; The orgtbl minor mode |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5922 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5923 ;; Define a minor mode which can be used in other modes in order to |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5924 ;; integrate the org-mode table editor. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5925 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5926 ;; This is really a hack, because the org-mode table editor uses several |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5927 ;; keys which normally belong to the major mode, for example the TAB and |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5928 ;; RET keys. Here is how it works: The minor mode defines all the keys |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5929 ;; necessary to operate the table editor, but wraps the commands into a |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5930 ;; function which tests if the cursor is currently inside a table. If that |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5931 ;; is the case, the table editor command is executed. However, when any of |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5932 ;; those keys is used outside a table, the function uses `key-binding' to |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5933 ;; look up if the key has an associated command in another currently active |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5934 ;; keymap (minor modes, major mode, global), and executes that command. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5935 ;; There might be problems if any of the keys used by the table editor is |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5936 ;; otherwise used as a prefix key. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5937 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5938 ;; Another challenge is that the key binding for TAB can be tab or \C-i, |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5939 ;; likewise the binding for RET can be return or \C-m. Orgtbl-mode |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5940 ;; addresses this by checking explicitly for both bindings. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5941 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5942 ;; The optimized version (see variable `orgtbl-optimized') takes over |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5943 ;; all keys which are bound to `self-insert-command' in the *global map*. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5944 ;; Some modes bind other commands to simple characters, for example |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5945 ;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5946 ;; active, this binding is ignored inside tables and replaced with a |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5947 ;; modified self-insert. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5948 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5949 (defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5950 "Non-nil means, use the optimized table editor version for orgtbl-mode. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5951 In the optimized version, the table editor takes over all simple keys that |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5952 normally just insert a character. In tables, the characters are inserted |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5953 in a way to minimize disturbing the table structure (i.e. in overwrite mode |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5954 for empty fields). Outside tables, the correct binding of the keys is |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5955 restored. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5956 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5957 The default for this option is t if the optimized version is also used in |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5958 Org-mode. See the variable `org-enable-table-editor' for details. Changing |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5959 this variable requires a restart of Emacs to become effective." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5960 :group 'org-table |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5961 :type 'boolean) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5962 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5963 (defvar orgtbl-mode nil |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5964 "Variable controlling orgtbl-mode, a minor mode enabling the org-mode |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5965 table editor iin arbitrary modes.") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5966 (make-variable-buffer-local 'orgtbl-mode) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5967 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5968 (defvar orgtbl-mode-map (make-sparse-keymap) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5969 "Keymap for orgtbl-mode.") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5970 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5971 ;;;###autoload |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5972 (defun turn-on-orgtbl () |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5973 "Unconditionally turn on orgtbl-mode." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5974 (orgtbl-mode 1)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5975 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5976 ;;;###autoload |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5977 (defun orgtbl-mode (&optional arg) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5978 "The org-mode table editor as a minor mode for use in other modes." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5979 (interactive) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5980 (setq orgtbl-mode |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5981 (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5982 (if orgtbl-mode |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5983 (progn |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5984 (set (make-local-variable (quote org-table-may-need-update)) t) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5985 (make-local-hook (quote before-change-functions)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5986 (add-hook 'before-change-functions 'org-before-change-function |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5987 nil 'local) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5988 (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5989 auto-fill-inhibit-regexp) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5990 (set (make-local-variable 'auto-fill-inhibit-regexp) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5991 (if auto-fill-inhibit-regexp |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5992 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5993 "[ \t]*|")) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5994 (easy-menu-add orgtbl-mode-menu) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5995 (run-hooks (quote orgtbl-mode-hook))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5996 (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5997 (remove-hook 'before-change-functions 'org-before-change-function t) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5998 (easy-menu-remove orgtbl-mode-menu) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
5999 (force-mode-line-update 'all))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6000 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6001 ;; Install it as a minor mode. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6002 (put 'orgtbl-mode :included t) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6003 (put 'orgtbl-mode :menu-tag "Org Table Mode") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6004 (add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6005 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6006 (defun orgtbl-make-binding (fun &rest keys) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6007 "Create a function for binding in the table minor mode." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6008 (list 'lambda '(arg) '(interactive "p") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6009 (list 'if |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6010 '(org-at-table-p) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6011 (list 'call-interactively (list 'quote fun)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6012 (list 'let '(orgtbl-mode) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6013 (list 'call-interactively |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6014 (append '(or) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6015 (mapcar (lambda (k) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6016 (list 'key-binding k)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6017 keys) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6018 '('orgtbl-error))))))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6019 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6020 (defun orgtbl-error () |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6021 "Error when there is no default binding for a table key." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6022 (interactive) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6023 (error "This key is has no function outside tables")) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6024 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6025 ;; Keybindings for the minor mode |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6026 (let ((bindings |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6027 '(([(meta shift left)] org-table-delete-column) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6028 ([(meta left)] org-table-move-column-left) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6029 ([(meta right)] org-table-move-column-right) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6030 ([(meta shift right)] org-table-insert-column) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6031 ([(meta shift up)] org-table-kill-row) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6032 ([(meta shift down)] org-table-insert-row) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6033 ([(meta up)] org-table-move-row-up) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6034 ([(meta down)] org-table-move-row-down) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6035 ("\C-c\C-w" org-table-cut-region) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6036 ("\C-c\M-w" org-table-copy-region) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6037 ("\C-c\C-y" org-table-paste-rectangle) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6038 ("\C-c-" org-table-insert-hline) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6039 ([(shift tab)] org-table-previous-field) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6040 ("\C-c\C-c" org-table-align) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6041 ([(return)] org-table-next-row) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6042 ([(shift return)] org-table-copy-from-above) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6043 ([(meta return)] org-table-wrap-region) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6044 ("\C-c\C-q" org-table-wrap-region) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6045 ("\C-c?" org-table-current-column) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6046 ("\C-c " org-table-blank-field) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6047 ("\C-c+" org-table-sum) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6048 ("\C-c|" org-table-toggle-vline-visibility) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6049 ("\C-c=" org-table-eval-formula))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6050 elt key fun cmd) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6051 (while (setq elt (pop bindings)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6052 (setq key (car elt) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6053 fun (nth 1 elt) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6054 cmd (orgtbl-make-binding fun key)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6055 (define-key orgtbl-mode-map key cmd))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6056 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6057 ;; Special treatment needed for TAB and RET |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6058 ;(define-key orgtbl-mode-map [(return)] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6059 ; (orgtbl-make-binding 'org-table-next-row [(return)] "\C-m")) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6060 ;(define-key orgtbl-mode-map "\C-m" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6061 ; (orgtbl-make-binding 'org-table-next-row "\C-m" [(return)])) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6062 ;(define-key orgtbl-mode-map [(tab)] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6063 ; (orgtbl-make-binding 'org-table-next-field [(tab)] "\C-i")) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6064 ;(define-key orgtbl-mode-map "\C-i" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6065 ; (orgtbl-make-binding 'org-table-next-field "\C-i" [(tab)])) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6066 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6067 (define-key orgtbl-mode-map [(return)] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6068 (orgtbl-make-binding 'orgtbl-ret [(return)] "\C-m")) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6069 (define-key orgtbl-mode-map "\C-m" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6070 (orgtbl-make-binding 'orgtbl-ret "\C-m" [(return)])) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6071 (define-key orgtbl-mode-map [(tab)] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6072 (orgtbl-make-binding 'orgtbl-tab [(tab)] "\C-i")) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6073 (define-key orgtbl-mode-map "\C-i" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6074 (orgtbl-make-binding 'orgtbl-tab "\C-i" [(tab)])) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6075 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6076 (when orgtbl-optimized |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6077 ;; If the user wants maximum table support, we need to hijack |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6078 ;; some standard editing functions |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6079 (substitute-key-definition 'self-insert-command 'orgtbl-self-insert-command |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6080 orgtbl-mode-map global-map) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6081 (substitute-key-definition 'delete-char 'orgtbl-delete-char |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6082 orgtbl-mode-map global-map) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6083 (substitute-key-definition 'delete-backward-char 'orgtbl-delete-backward-char |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6084 orgtbl-mode-map global-map) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6085 (define-key org-mode-map "|" 'self-insert-command)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6086 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6087 (defun orgtbl-tab () |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6088 "Justification and field motion for orgtbl-mode." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6089 (interactive) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6090 (org-table-justify-field-maybe) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6091 (org-table-next-field)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6092 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6093 (defun orgtbl-ret () |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6094 "Justification and field motion for orgtbl-mode." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6095 (interactive) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6096 (org-table-justify-field-maybe) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6097 (org-table-next-row)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6098 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6099 (defun orgtbl-self-insert-command (N) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6100 "Like `self-insert-command', use overwrite-mode for whitespace in tables. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6101 If the cursor is in a table looking at whitespace, the whitespace is |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6102 overwritten, and the table is not marked as requiring realignment." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6103 (interactive "p") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6104 (if (and (org-at-table-p) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6105 (eq N 1) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6106 (looking-at "[^|\n]* +|")) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6107 (let (org-table-may-need-update (pos (point))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6108 (goto-char (1- (match-end 0))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6109 (delete-backward-char 1) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6110 (goto-char (match-beginning 0)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6111 (self-insert-command N)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6112 (setq org-table-may-need-update t) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6113 (let (orgtbl-mode) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6114 (call-interactively (key-binding (vector last-input-event)))))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6115 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6116 (defun orgtbl-delete-backward-char (N) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6117 "Like `delete-backward-char', insert whitespace at field end in tables. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6118 When deleting backwards, in tables this function will insert whitespace in |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6119 front of the next \"|\" separator, to keep the table aligned. The table will |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6120 still be marked for re-alignment, because a narrow field may lead to a |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6121 reduced column width." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6122 (interactive "p") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6123 (if (and (org-at-table-p) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6124 (eq N 1) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6125 (looking-at ".*?|")) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6126 (let ((pos (point))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6127 (backward-delete-char N) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6128 (skip-chars-forward "^|") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6129 (insert " ") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6130 (goto-char (1- pos))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6131 (message "%s" last-input-event) (sit-for 1) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6132 (delete-backward-char N))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6133 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6134 (defun orgtbl-delete-char (N) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6135 "Like `delete-char', but insert whitespace at field end in tables. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6136 When deleting characters, in tables this function will insert whitespace in |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6137 front of the next \"|\" separator, to keep the table aligned. The table |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6138 will still be marked for re-alignment, because a narrow field may lead to |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6139 a reduced column width." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6140 (interactive "p") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6141 (if (and (org-at-table-p) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6142 (eq N 1)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6143 (if (looking-at ".*?|") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6144 (let ((pos (point))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6145 (replace-match (concat |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6146 (substring (match-string 0) 1 -1) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6147 " |")) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6148 (goto-char pos))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6149 (delete-char N))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6150 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6151 (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6152 '("Tbl" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6153 ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6154 ["Next field" org-cycle :active (org-at-table-p) :keys "TAB"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6155 ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6156 ["Next row" org-return :active (org-at-table-p) :keys "RET"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6157 "--" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6158 ["Blank field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6159 ["Copy field from above" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6160 org-table-copy-from-above :active (org-at-table-p) :keys "S-RET"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6161 "--" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6162 ("Column" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6163 ["Move column left" org-metaleft :active (org-at-table-p) :keys "M-<left>"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6164 ["Move column right" org-metaright :active (org-at-table-p) :keys "M-<right>"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6165 ["Delete column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6166 ["Insert column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"]) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6167 ("Row" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6168 ["Move row up" org-metaup :active (org-at-table-p) :keys "M-<up>"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6169 ["Move row down" org-metadown :active (org-at-table-p) :keys "M-<down>"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6170 ["Delete row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6171 ["Insert row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6172 "--" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6173 ["Insert hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"]) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6174 ("Rectangle" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6175 ["Copy rectangle" org-copy-special :active (org-at-table-p) :keys "C-c M-w"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6176 ["Cut rectangle" org-cut-special :active (org-at-table-p) :keys "C-c C-w"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6177 ["Paste rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-y"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6178 ["Fill rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"]) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6179 "--" |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6180 ["Which column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6181 ["Sum column/rectangle" org-table-sum |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6182 :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6183 ["Eval formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6184 )) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6185 |
58792 | 6186 ;;; Exporting |
6187 | |
6188 (defconst org-level-max 20) | |
6189 | |
6190 (defun org-export-find-first-heading-line (list) | |
6191 "Remove all lines from LIST which are before the first headline." | |
6192 (let ((orig-list list) | |
6193 (re (concat "^" outline-regexp))) | |
6194 (while (and list | |
6195 (not (string-match re (car list)))) | |
6196 (pop list)) | |
6197 (or list orig-list))) | |
6198 | |
6199 (defun org-skip-comments (lines) | |
6200 "Skip lines starting with \"#\" and subtrees starting with COMMENT." | |
6201 (let ((re1 (concat "^\\(\\*+\\)[ \t]+" org-comment-string)) | |
6202 (re2 "^\\(\\*+\\)[ \t\n\r]") | |
6203 rtn line level) | |
6204 (while (setq line (pop lines)) | |
6205 (cond | |
6206 ((and (string-match re1 line) | |
6207 (setq level (- (match-end 1) (match-beginning 1)))) | |
6208 ;; Beginning of a COMMENT subtree. Skip it. | |
6209 (while (and (setq line (pop lines)) | |
6210 (or (not (string-match re2 line)) | |
6211 (> (- (match-end 1) (match-beginning 1)) level)))) | |
6212 (setq lines (cons line lines))) | |
6213 ((string-match "^#" line) | |
6214 ;; an ordinary comment line | |
6215 ) | |
6216 (t (setq rtn (cons line rtn))))) | |
6217 (nreverse rtn))) | |
6218 | |
6219 ;; ASCII | |
6220 | |
6221 (defconst org-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) | |
6222 "Characters for underlining headings in ASCII export.") | |
6223 | |
6224 (defconst org-html-entities | |
6225 '(("nbsp") | |
6226 ("iexcl") | |
6227 ("cent") | |
6228 ("pound") | |
6229 ("curren") | |
6230 ("yen") | |
6231 ("brvbar") | |
6232 ("sect") | |
6233 ("uml") | |
6234 ("copy") | |
6235 ("ordf") | |
6236 ("laquo") | |
6237 ("not") | |
6238 ("shy") | |
6239 ("reg") | |
6240 ("macr") | |
6241 ("deg") | |
6242 ("plusmn") | |
6243 ("sup2") | |
6244 ("sup3") | |
6245 ("acute") | |
6246 ("micro") | |
6247 ("para") | |
6248 ("middot") | |
6249 ("odot"."o") | |
6250 ("star"."*") | |
6251 ("cedil") | |
6252 ("sup1") | |
6253 ("ordm") | |
6254 ("raquo") | |
6255 ("frac14") | |
6256 ("frac12") | |
6257 ("frac34") | |
6258 ("iquest") | |
6259 ("Agrave") | |
6260 ("Aacute") | |
6261 ("Acirc") | |
6262 ("Atilde") | |
6263 ("Auml") | |
6264 ("Aring") ("AA"."Å") | |
6265 ("AElig") | |
6266 ("Ccedil") | |
6267 ("Egrave") | |
6268 ("Eacute") | |
6269 ("Ecirc") | |
6270 ("Euml") | |
6271 ("Igrave") | |
6272 ("Iacute") | |
6273 ("Icirc") | |
6274 ("Iuml") | |
6275 ("ETH") | |
6276 ("Ntilde") | |
6277 ("Ograve") | |
6278 ("Oacute") | |
6279 ("Ocirc") | |
6280 ("Otilde") | |
6281 ("Ouml") | |
6282 ("times") | |
6283 ("Oslash") | |
6284 ("Ugrave") | |
6285 ("Uacute") | |
6286 ("Ucirc") | |
6287 ("Uuml") | |
6288 ("Yacute") | |
6289 ("THORN") | |
6290 ("szlig") | |
6291 ("agrave") | |
6292 ("aacute") | |
6293 ("acirc") | |
6294 ("atilde") | |
6295 ("auml") | |
6296 ("aring") | |
6297 ("aelig") | |
6298 ("ccedil") | |
6299 ("egrave") | |
6300 ("eacute") | |
6301 ("ecirc") | |
6302 ("euml") | |
6303 ("igrave") | |
6304 ("iacute") | |
6305 ("icirc") | |
6306 ("iuml") | |
6307 ("eth") | |
6308 ("ntilde") | |
6309 ("ograve") | |
6310 ("oacute") | |
6311 ("ocirc") | |
6312 ("otilde") | |
6313 ("ouml") | |
6314 ("divide") | |
6315 ("oslash") | |
6316 ("ugrave") | |
6317 ("uacute") | |
6318 ("ucirc") | |
6319 ("uuml") | |
6320 ("yacute") | |
6321 ("thorn") | |
6322 ("yuml") | |
6323 ("fnof") | |
6324 ("Alpha") | |
6325 ("Beta") | |
6326 ("Gamma") | |
6327 ("Delta") | |
6328 ("Epsilon") | |
6329 ("Zeta") | |
6330 ("Eta") | |
6331 ("Theta") | |
6332 ("Iota") | |
6333 ("Kappa") | |
6334 ("Lambda") | |
6335 ("Mu") | |
6336 ("Nu") | |
6337 ("Xi") | |
6338 ("Omicron") | |
6339 ("Pi") | |
6340 ("Rho") | |
6341 ("Sigma") | |
6342 ("Tau") | |
6343 ("Upsilon") | |
6344 ("Phi") | |
6345 ("Chi") | |
6346 ("Psi") | |
6347 ("Omega") | |
6348 ("alpha") | |
6349 ("beta") | |
6350 ("gamma") | |
6351 ("delta") | |
6352 ("epsilon") | |
6353 ("varepsilon"."ε") | |
6354 ("zeta") | |
6355 ("eta") | |
6356 ("theta") | |
6357 ("iota") | |
6358 ("kappa") | |
6359 ("lambda") | |
6360 ("mu") | |
6361 ("nu") | |
6362 ("xi") | |
6363 ("omicron") | |
6364 ("pi") | |
6365 ("rho") | |
6366 ("sigmaf") ("varsigma"."ς") | |
6367 ("sigma") | |
6368 ("tau") | |
6369 ("upsilon") | |
6370 ("phi") | |
6371 ("chi") | |
6372 ("psi") | |
6373 ("omega") | |
6374 ("thetasym") ("vartheta"."ϑ") | |
6375 ("upsih") | |
6376 ("piv") | |
6377 ("bull") ("bullet"."•") | |
6378 ("hellip") ("dots"."…") | |
6379 ("prime") | |
6380 ("Prime") | |
6381 ("oline") | |
6382 ("frasl") | |
6383 ("weierp") | |
6384 ("image") | |
6385 ("real") | |
6386 ("trade") | |
6387 ("alefsym") | |
6388 ("larr") ("leftarrow"."←") ("gets"."←") | |
6389 ("uarr") ("uparrow"."↑") | |
6390 ("rarr") ("to"."→") ("rightarrow"."→") | |
6391 ("darr")("downarrow"."↓") | |
6392 ("harr") ("leftrightarrow"."↔") | |
6393 ("crarr") ("hookleftarrow"."↵") ; has round hook, not quite CR | |
6394 ("lArr") ("Leftarrow"."⇐") | |
6395 ("uArr") ("Uparrow"."⇑") | |
6396 ("rArr") ("Rightarrow"."⇒") | |
6397 ("dArr") ("Downarrow"."⇓") | |
6398 ("hArr") ("Leftrightarrow"."⇔") | |
6399 ("forall") | |
6400 ("part") ("partial"."∂") | |
6401 ("exist") ("exists"."∃") | |
6402 ("empty") ("emptyset"."∅") | |
6403 ("nabla") | |
6404 ("isin") ("in"."∈") | |
6405 ("notin") | |
6406 ("ni") | |
6407 ("prod") | |
6408 ("sum") | |
6409 ("minus") | |
6410 ("lowast") ("ast"."∗") | |
6411 ("radic") | |
6412 ("prop") ("proptp"."∝") | |
6413 ("infin") ("infty"."∞") | |
6414 ("ang") ("angle"."∠") | |
6415 ("and") ("vee"."∧") | |
6416 ("or") ("wedge"."∨") | |
6417 ("cap") | |
6418 ("cup") | |
6419 ("int") | |
6420 ("there4") | |
6421 ("sim") | |
6422 ("cong") ("simeq"."≅") | |
6423 ("asymp")("approx"."≈") | |
6424 ("ne") ("neq"."≠") | |
6425 ("equiv") | |
6426 ("le") | |
6427 ("ge") | |
6428 ("sub") ("subset"."⊂") | |
6429 ("sup") ("supset"."⊃") | |
6430 ("nsub") | |
6431 ("sube") | |
6432 ("supe") | |
6433 ("oplus") | |
6434 ("otimes") | |
6435 ("perp") | |
6436 ("sdot") ("cdot"."⋅") | |
6437 ("lceil") | |
6438 ("rceil") | |
6439 ("lfloor") | |
6440 ("rfloor") | |
6441 ("lang") | |
6442 ("rang") | |
6443 ("loz") ("Diamond"."◊") | |
6444 ("spades") ("spadesuit"."♠") | |
6445 ("clubs") ("clubsuit"."♣") | |
6446 ("hearts") ("diamondsuit"."♥") | |
6447 ("diams") ("diamondsuit"."♦") | |
6448 ("quot") | |
6449 ("amp") | |
6450 ("lt") | |
6451 ("gt") | |
6452 ("OElig") | |
6453 ("oelig") | |
6454 ("Scaron") | |
6455 ("scaron") | |
6456 ("Yuml") | |
6457 ("circ") | |
6458 ("tilde") | |
6459 ("ensp") | |
6460 ("emsp") | |
6461 ("thinsp") | |
6462 ("zwnj") | |
6463 ("zwj") | |
6464 ("lrm") | |
6465 ("rlm") | |
6466 ("ndash") | |
6467 ("mdash") | |
6468 ("lsquo") | |
6469 ("rsquo") | |
6470 ("sbquo") | |
6471 ("ldquo") | |
6472 ("rdquo") | |
6473 ("bdquo") | |
6474 ("dagger") | |
6475 ("Dagger") | |
6476 ("permil") | |
6477 ("lsaquo") | |
6478 ("rsaquo") | |
6479 ("euro") | |
6480 | |
6481 ("arccos"."arccos") | |
6482 ("arcsin"."arcsin") | |
6483 ("arctan"."arctan") | |
6484 ("arg"."arg") | |
6485 ("cos"."cos") | |
6486 ("cosh"."cosh") | |
6487 ("cot"."cot") | |
6488 ("coth"."coth") | |
6489 ("csc"."csc") | |
6490 ("deg"."deg") | |
6491 ("det"."det") | |
6492 ("dim"."dim") | |
6493 ("exp"."exp") | |
6494 ("gcd"."gcd") | |
6495 ("hom"."hom") | |
6496 ("inf"."inf") | |
6497 ("ker"."ker") | |
6498 ("lg"."lg") | |
6499 ("lim"."lim") | |
6500 ("liminf"."liminf") | |
6501 ("limsup"."limsup") | |
6502 ("ln"."ln") | |
6503 ("log"."log") | |
6504 ("max"."max") | |
6505 ("min"."min") | |
6506 ("Pr"."Pr") | |
6507 ("sec"."sec") | |
6508 ("sin"."sin") | |
6509 ("sinh"."sinh") | |
6510 ("sup"."sup") | |
6511 ("tan"."tan") | |
6512 ("tanh"."tanh") | |
6513 ) | |
6514 "Entities for TeX->HTML translation. | |
6515 Entries can be like (\"ent\"), in which case \"\\ent\" will be translated to | |
6516 \"&ent;\". An entry can also be a dotted pair like (\"ent\".\"&other;\"). | |
6517 In that case, \"\\ent\" will be translated to \"&other;\". | |
6518 The list contains HTML entities for Latin-1, Greek and other symbols. | |
6519 It is supplemented by a number of commonly used TeX macros with appropriate | |
6520 translations.") | |
6521 | |
6522 (defun org-export-as-ascii (arg) | |
6523 "Export the outline as a pretty ASCII file. | |
6524 If there is an active region, export only the region. | |
6525 The prefix ARG specifies how many levels of the outline should become | |
6526 underlined headlines. The default is 3." | |
6527 (interactive "P") | |
6528 (setq-default org-todo-line-regexp org-todo-line-regexp) | |
6529 (let* ((region | |
6530 (buffer-substring | |
6531 (if (org-region-active-p) (region-beginning) (point-min)) | |
6532 (if (org-region-active-p) (region-end) (point-max)))) | |
6533 (lines (org-export-find-first-heading-line | |
6534 (org-skip-comments (org-split-string region "[\r\n]")))) | |
6535 (org-startup-with-deadline-check nil) | |
6536 (level 0) line txt | |
6537 (umax nil) | |
6538 (case-fold-search nil) | |
6539 (filename (concat (file-name-sans-extension (buffer-file-name)) | |
6540 ".txt")) | |
6541 (buffer (find-file-noselect filename)) | |
6542 (levels-open (make-vector org-level-max nil)) | |
6543 (date (format-time-string "%Y/%m/%d" (current-time))) | |
6544 (time (format-time-string "%X" (current-time))) | |
6545 (author user-full-name) | |
6546 (title (buffer-name)) | |
6547 (options nil) | |
6548 (email user-mail-address) | |
6549 (language org-export-default-language) | |
6550 (text nil) | |
6551 (last-level 1) | |
6552 (todo nil) | |
6553 (lang-words nil)) | |
6554 | |
6555 (org-init-section-numbers) | |
6556 | |
6557 (find-file-noselect filename) | |
6558 | |
6559 ;; Search for the export key lines | |
6560 (org-parse-key-lines) | |
6561 | |
6562 (setq lang-words (or (assoc language org-export-language-setup) | |
6563 (assoc "en" org-export-language-setup))) | |
6564 (if org-export-ascii-show-new-buffer | |
6565 (switch-to-buffer-other-window buffer) | |
6566 (set-buffer buffer)) | |
6567 (erase-buffer) | |
6568 (fundamental-mode) | |
6569 (if options (org-parse-export-options options)) | |
6570 (setq umax (if arg (prefix-numeric-value arg) | |
6571 org-export-headline-levels)) | |
6572 | |
6573 ;; File header | |
6574 (if title (org-insert-centered title ?=)) | |
6575 (insert "\n") | |
6576 (if (or author email) | |
6577 (insert (concat (nth 1 lang-words) ": " (or author "") | |
6578 (if email (concat " <" email ">") "") | |
6579 "\n"))) | |
6580 (if (and date time) | |
6581 (insert (concat (nth 2 lang-words) ": " date " " time "\n"))) | |
6582 (if text (insert (concat (org-html-expand-for-ascii text) "\n\n"))) | |
6583 | |
6584 (insert "\n\n") | |
6585 | |
6586 (if org-export-with-toc | |
6587 (progn | |
6588 (insert (nth 3 lang-words) "\n" | |
6589 (make-string (length (nth 3 lang-words)) ?=) "\n") | |
6590 (mapcar '(lambda (line) | |
6591 (if (string-match org-todo-line-regexp | |
6592 line) | |
6593 ;; This is a headline | |
6594 (progn | |
6595 (setq level (- (match-end 1) (match-beginning 1)) | |
6596 txt (match-string 3 line) | |
6597 todo | |
6598 (or (and (match-beginning 2) | |
6599 (not (equal (match-string 2 line) | |
6600 org-done-string))) | |
6601 ; TODO, not DONE | |
6602 (and (= level umax) | |
6603 (org-search-todo-below | |
6604 line lines level)))) | |
6605 (setq txt (org-html-expand-for-ascii txt)) | |
6606 | |
6607 (if org-export-with-section-numbers | |
6608 (setq txt (concat (org-section-number level) | |
6609 " " txt))) | |
6610 (if (<= level umax) | |
6611 (progn | |
6612 (insert | |
6613 (make-string (* (1- level) 4) ?\ ) | |
6614 (format (if todo "%s (*)\n" "%s\n") txt)) | |
6615 (setq last-level level)) | |
6616 )))) | |
6617 lines))) | |
6618 | |
6619 (org-init-section-numbers) | |
6620 (while (setq line (pop lines)) | |
6621 ;; Remove the quoted HTML tags. | |
6622 (setq line (org-html-expand-for-ascii line)) | |
6623 (cond | |
6624 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) | |
6625 ;; a Headline | |
6626 (setq level (- (match-end 1) (match-beginning 1)) | |
6627 txt (match-string 2 line)) | |
6628 (org-ascii-level-start level txt umax)) | |
6629 (t (insert line "\n")))) | |
6630 (normal-mode) | |
6631 (save-buffer) | |
6632 (goto-char (point-min)))) | |
6633 | |
6634 (defun org-search-todo-below (line lines level) | |
6635 "Search the subtree below LINE for any TODO entries." | |
6636 (let ((rest (cdr (memq line lines))) | |
6637 (re org-todo-line-regexp) | |
6638 line lv todo) | |
6639 (catch 'exit | |
6640 (while (setq line (pop rest)) | |
6641 (if (string-match re line) | |
6642 (progn | |
6643 (setq lv (- (match-end 1) (match-beginning 1)) | |
6644 todo (and (match-beginning 2) | |
6645 (not (equal (match-string 2 line) | |
6646 org-done-string)))) | |
6647 ; TODO, not DONE | |
6648 (if (<= lv level) (throw 'exit nil)) | |
6649 (if todo (throw 'exit t)))))))) | |
6650 | |
6651 ;; FIXME: Try to handle <b> and <i> as faces via text properties. | |
6652 ;; FIXME: Can I implement *bold*,/italic/ and _underline_ for AXCII export? | |
6653 (defun org-html-expand-for-ascii (line) | |
6654 "Handle quoted HTML for ASCII export." | |
6655 (if org-export-html-expand | |
6656 (while (string-match "@<[^<>\n]*>" line) | |
6657 ;; We just remove the tags for now. | |
6658 (setq line (replace-match "" nil nil line)))) | |
6659 line) | |
6660 | |
6661 (defun org-insert-centered (s &optional underline) | |
6662 "Insert the string S centered and underline it with character UNDERLINE." | |
6663 (let ((ind (max (/ (- 80 (length s)) 2) 0))) | |
6664 (insert (make-string ind ?\ ) s "\n") | |
6665 (if underline | |
6666 (insert (make-string ind ?\ ) | |
6667 (make-string (length s) underline) | |
6668 "\n")))) | |
6669 | |
6670 (defun org-ascii-level-start (level title umax) | |
6671 "Insert a new level in ASCII export." | |
6672 (let (char) | |
6673 (if (> level umax) | |
6674 (insert (make-string (* 2 (- level umax 1)) ?\ ) "* " title "\n") | |
6675 (if (or (not (equal (char-before) ?\n)) | |
6676 (not (equal (char-before (1- (point))) ?\n))) | |
6677 (insert "\n")) | |
6678 (setq char (nth (- umax level) (reverse org-ascii-underline))) | |
6679 (if org-export-with-section-numbers | |
6680 (setq title (concat (org-section-number level) " " title))) | |
6681 (insert title "\n" (make-string (length title) char) "\n")))) | |
6682 | |
6683 ;; HTML | |
6684 | |
6685 (defun org-get-current-options () | |
6686 "Return a string with current options as keyword options. | |
6687 Does include HTML export options as well as TODO and CATEGORY stuff." | |
6688 (format | |
6689 "#+TITLE: %s | |
6690 #+AUTHOR: %s | |
6691 #+EMAIL: %s | |
6692 #+LANGUAGE: %s | |
6693 #+TEXT: Some descriptive text to be emitted. Several lines OK. | |
6694 #+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s *:%s TeX:%s | |
6695 #+CATEGORY: %s | |
6696 #+SEQ_TODO: %s | |
6697 #+TYP_TODO: %s | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6698 #+STARTUP: %s %s |
58792 | 6699 " |
6700 (buffer-name) (user-full-name) user-mail-address org-export-default-language | |
6701 org-export-headline-levels | |
6702 org-export-with-section-numbers | |
6703 org-export-with-toc | |
6704 org-export-preserve-breaks | |
6705 org-export-html-expand | |
6706 org-export-with-fixed-width | |
6707 org-export-with-tables | |
6708 org-export-with-sub-superscripts | |
6709 org-export-with-emphasize | |
6710 org-export-with-TeX-macros | |
6711 (file-name-nondirectory (buffer-file-name)) | |
6712 (if (equal org-todo-interpretation 'sequence) | |
6713 (mapconcat 'identity org-todo-keywords " ") | |
6714 "TODO FEEDBACK VERIFY DONE") | |
6715 (if (equal org-todo-interpretation 'type) | |
6716 (mapconcat 'identity org-todo-keywords " ") | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6717 "Me Jason Marie DONE") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6718 (if org-startup-folded "fold" "nofold") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6719 (if org-startup-with-deadline-check "dlcheck" "nodlcheck") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
6720 )) |
58792 | 6721 |
6722 (defun org-insert-export-options-template () | |
6723 "Insert into the buffer a template with information for exporting." | |
6724 (interactive) | |
6725 (if (not (bolp)) (newline)) | |
6726 (let ((s (org-get-current-options))) | |
6727 (and (string-match "#\\+CATEGORY" s) | |
6728 (setq s (substring s 0 (match-beginning 0)))) | |
6729 (insert s))) | |
6730 | |
6731 (defun org-toggle-fixed-width-section (arg) | |
6732 "Toggle the fixed-width indicator at the beginning of lines in the region. | |
6733 If there is no active region, only acts on the current line. | |
6734 If the first non-white character in the first line of the region is a | |
6735 vertical bar \"|\", then the command removes the bar from all lines in | |
6736 the region. If the first character is not a bar, the command adds a | |
6737 bar to all lines, in the column given by the beginning of the region. | |
6738 | |
6739 If there is a numerical prefix ARG, create ARG new lines starting with \"|\"." | |
6740 (interactive "P") | |
6741 (let* ((cc 0) | |
6742 (regionp (org-region-active-p)) | |
6743 (beg (if regionp (region-beginning) (point))) | |
6744 (end (if regionp (region-end))) | |
6745 (nlines (or arg (if (and beg end) (count-lines beg end) 1))) | |
6746 (re "[ \t]*\\(:\\)") | |
6747 off) | |
6748 (save-excursion | |
6749 (goto-char beg) | |
6750 (setq cc (current-column)) | |
6751 (beginning-of-line 1) | |
6752 (setq off (looking-at re)) | |
6753 (while (> nlines 0) | |
6754 (setq nlines (1- nlines)) | |
6755 (beginning-of-line 1) | |
6756 (cond | |
6757 (arg | |
6758 (move-to-column cc t) | |
6759 (insert ":\n") | |
6760 (forward-line -1)) | |
6761 ((and off (looking-at re)) | |
6762 (replace-match "" t t nil 1)) | |
6763 ((not off) (move-to-column cc t) (insert ":"))) | |
6764 (forward-line 1))))) | |
6765 | |
6766 (defun org-export-as-html-and-open (arg) | |
6767 "Export the outline as HTML and immediately open it with a browser. | |
6768 If there is an active region, export only the region. | |
6769 The prefix ARG specifies how many levels of the outline should become | |
6770 headlines. The default is 3. Lower levels will become bulleted lists." | |
6771 (interactive "P") | |
6772 (org-export-as-html arg 'hidden) | |
6773 (org-open-file (buffer-file-name))) | |
6774 | |
6775 (defun org-export-as-html-batch () | |
6776 "Call org-export-as-html, may be used in batch processing as | |
6777 emacs --batch | |
6778 --load=$HOME/lib/emacs/org.el | |
6779 --eval \"(setq org-export-headline-levels 2)\" | |
6780 --visit=MyFile --funcall org-export-as-html-batch" | |
6781 (org-export-as-html org-export-headline-levels 'hidden)) | |
6782 | |
6783 (defun org-export-as-html (arg &optional hidden) | |
6784 "Export the outline as a pretty HTML file. | |
6785 If there is an active region, export only the region. | |
6786 The prefix ARG specifies how many levels of the outline should become | |
6787 headlines. The default is 3. Lower levels will become bulleted lists." | |
6788 (interactive "P") | |
6789 (setq-default org-todo-line-regexp org-todo-line-regexp) | |
6790 (setq-default org-deadline-line-regexp org-deadline-line-regexp) | |
6791 (setq-default org-done-string org-done-string) | |
6792 (let* ((region-p (org-region-active-p)) | |
6793 (region | |
6794 (buffer-substring | |
6795 (if region-p (region-beginning) (point-min)) | |
6796 (if region-p (region-end) (point-max)))) | |
6797 (all_lines | |
6798 (org-skip-comments (org-split-string region "[\r\n]"))) | |
6799 (lines (org-export-find-first-heading-line all_lines)) | |
6800 (level 0) (line "") (origline "") txt todo | |
6801 (last-level 1) | |
6802 (umax nil) | |
6803 (filename (concat (file-name-sans-extension (buffer-file-name)) | |
6804 ".html")) | |
6805 (buffer (find-file-noselect filename)) | |
6806 (levels-open (make-vector org-level-max nil)) | |
6807 (date (format-time-string "%Y/%m/%d" (current-time))) | |
6808 (time (format-time-string "%X" (current-time))) | |
6809 (author user-full-name) | |
6810 (title (buffer-name)) | |
6811 (options nil) | |
6812 (email user-mail-address) | |
6813 (language org-export-default-language) | |
6814 (text nil) | |
6815 (lang-words nil) | |
6816 (head-count 0) cnt | |
6817 table-open type | |
6818 table-buffer table-orig-buffer | |
6819 ) | |
6820 (message "Exporting...") | |
6821 | |
6822 (org-init-section-numbers) | |
6823 | |
6824 ;; Search for the export key lines | |
6825 (org-parse-key-lines) | |
6826 (setq lang-words (or (assoc language org-export-language-setup) | |
6827 (assoc "en" org-export-language-setup))) | |
6828 | |
6829 ;; Switch to the output buffer | |
6830 (if (or hidden (not org-export-html-show-new-buffer)) | |
6831 (set-buffer buffer) | |
6832 (switch-to-buffer-other-window buffer)) | |
6833 (erase-buffer) | |
6834 (fundamental-mode) | |
6835 (let ((case-fold-search nil)) | |
6836 (if options (org-parse-export-options options)) | |
6837 (setq umax (if arg (prefix-numeric-value arg) | |
6838 org-export-headline-levels)) | |
6839 | |
6840 ;; File header | |
6841 (insert (format | |
6842 "<html lang=\"%s\"><head> | |
6843 <title>%s</title> | |
6844 <meta http-equiv=\"Content-Type\" content=\"text/html\"> | |
6845 <meta name=generator content=\"Org-mode\"> | |
6846 <meta name=generated content=\"%s %s\"> | |
6847 <meta name=author content=\"%s\"> | |
6848 </head><body> | |
6849 " | |
6850 language (org-html-expand title) date time author)) | |
6851 (if title (insert (concat "<H1 align=\"center\">" | |
6852 (org-html-expand title) "</H1>\n"))) | |
6853 (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) | |
6854 (if email (insert (concat "<a href=\"mailto:" email "\"><" | |
6855 email "></a>\n"))) | |
6856 (if (or author email) (insert "<br>\n")) | |
6857 (if (and date time) (insert (concat (nth 2 lang-words) ": " | |
6858 date " " time "<br>\n"))) | |
6859 (if text (insert (concat "<p>\n" (org-html-expand text)))) | |
6860 (if org-export-with-toc | |
6861 (progn | |
6862 (insert (format "<H2>%s</H2>\n" (nth 3 lang-words))) | |
6863 (insert "<ul>\n") | |
6864 (mapcar '(lambda (line) | |
6865 (if (string-match org-todo-line-regexp line) | |
6866 ;; This is a headline | |
6867 (progn | |
6868 (setq level (- (match-end 1) (match-beginning 1)) | |
6869 txt (save-match-data | |
6870 (org-html-expand | |
6871 (match-string 3 line))) | |
6872 todo | |
6873 (or (and (match-beginning 2) | |
6874 (not (equal (match-string 2 line) | |
6875 org-done-string))) | |
6876 ; TODO, not DONE | |
6877 (and (= level umax) | |
6878 (org-search-todo-below | |
6879 line lines level)))) | |
6880 (if org-export-with-section-numbers | |
6881 (setq txt (concat (org-section-number level) | |
6882 " " txt))) | |
6883 (if (<= level umax) | |
6884 (progn | |
6885 (setq head-count (+ head-count 1)) | |
6886 (if (> level last-level) | |
6887 (progn | |
6888 (setq cnt (- level last-level)) | |
6889 (while (>= (setq cnt (1- cnt)) 0) | |
6890 (insert "<ul>")) | |
6891 (insert "\n"))) | |
6892 (if (< level last-level) | |
6893 (progn | |
6894 (setq cnt (- last-level level)) | |
6895 (while (>= (setq cnt (1- cnt)) 0) | |
6896 (insert "</ul>")) | |
6897 (insert "\n"))) | |
6898 (insert | |
6899 (format | |
6900 (if todo | |
6901 "<li><a href=\"#sec-%d\"><span style='color:red'>%s</span></a></li>\n" | |
6902 "<li><a href=\"#sec-%d\">%s</a></li>\n") | |
6903 head-count txt)) | |
6904 (setq last-level level)) | |
6905 )))) | |
6906 lines) | |
6907 (while (> last-level 0) | |
6908 (setq last-level (1- last-level)) | |
6909 (insert "</ul>\n")) | |
6910 )) | |
6911 (setq head-count 0) | |
6912 (org-init-section-numbers) | |
6913 | |
6914 (while (setq line (pop lines) origline line) | |
6915 ;; replace "<" and ">" by "<" and ">" | |
6916 ;; handle @<..> HTML tags (replace "@>..<" by "<..>") | |
6917 (setq line (org-html-expand line)) | |
6918 | |
6919 ;; Verbatim lines | |
6920 (if (and org-export-with-fixed-width | |
6921 (string-match "^[ \t]*:\\(.*\\)" line)) | |
6922 (progn | |
6923 (let ((l (match-string 1 line))) | |
6924 (while (string-match " " l) | |
6925 (setq l (replace-match " " t t l))) | |
6926 (insert "\n<span style='font-family:Courier'>" | |
6927 l "</span>" | |
6928 (if (and lines | |
6929 (not (string-match "^[ \t]+\\(:.*\\)" | |
6930 (car lines)))) | |
6931 "<br>\n" "\n")))) | |
6932 | |
6933 (when (string-match org-link-regexp line) | |
6934 (setq type (match-string 1 line)) | |
6935 (cond | |
6936 ((member type '("http" "https" "ftp" "mailto" "news")) | |
6937 ;; standard URL | |
6938 (setq line (replace-match | |
6939 "<a href=\"\\1:\\2\"><\\1:\\2></a>" | |
6940 nil nil line))) | |
6941 ((string= type "file") | |
6942 ;; FILE link | |
6943 | |
6944 (let* ((filename (match-string 2 line)) | |
6945 (file-is-image-p | |
6946 (save-match-data | |
6947 (string-match (org-image-file-name-regexp) filename)))) | |
6948 (setq line (replace-match | |
6949 (if (and org-export-html-inline-images | |
6950 file-is-image-p) | |
6951 "<img src=\"\\2\"/>" | |
6952 "<a href=\"\\2\">\\1:\\2</a>") | |
6953 nil nil line)))) | |
6954 | |
6955 ((member type '("bbdb" "vm" "wl" "rmail" "gnus" "shell")) | |
6956 (setq line (replace-match | |
6957 "<i><\\1:\\2></i>" nil nil line))))) | |
6958 | |
6959 ;; TODO items | |
6960 (if (and (string-match org-todo-line-regexp line) | |
6961 (match-beginning 2)) | |
6962 (if (equal (match-string 2 line) org-done-string) | |
6963 (setq line (replace-match | |
6964 "<span style='color:green'>\\2</span>" | |
6965 nil nil line 2)) | |
6966 (setq line (replace-match "<span style='color:red'>\\2</span>" | |
6967 nil nil line 2)))) | |
6968 | |
6969 ;; DEADLINES | |
6970 (if (string-match org-deadline-line-regexp line) | |
6971 (progn | |
6972 (if (save-match-data | |
6973 (string-match "<a href" | |
6974 (substring line 0 (match-beginning 0)))) | |
6975 nil ; Don't do the replacement - it is inside a link | |
6976 (setq line (replace-match "<span style='color:red'>\\&</span>" | |
6977 nil nil line 1))))) | |
6978 | |
6979 (cond | |
6980 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) | |
6981 ;; This is a headline | |
6982 (setq level (- (match-end 1) (match-beginning 1)) | |
6983 txt (match-string 2 line)) | |
6984 (if (<= level umax) (setq head-count (+ head-count 1))) | |
6985 (org-html-level-start level txt umax | |
6986 (and org-export-with-toc (<= level umax)) | |
6987 head-count)) | |
6988 | |
6989 ((and org-export-with-tables | |
6990 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) | |
6991 (if (not table-open) | |
6992 ;; New table starts | |
6993 (setq table-open t table-buffer nil table-orig-buffer nil)) | |
6994 ;; Accumulate lines | |
6995 (setq table-buffer (cons line table-buffer) | |
6996 table-orig-buffer (cons origline table-orig-buffer)) | |
6997 (when (or (not lines) | |
6998 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" | |
6999 (car lines)))) | |
7000 (setq table-open nil | |
7001 table-buffer (nreverse table-buffer) | |
7002 table-orig-buffer (nreverse table-orig-buffer)) | |
7003 (insert (org-format-table-html table-buffer table-orig-buffer)))) | |
7004 (t | |
7005 ;; Normal lines | |
7006 ;; Lines starting with "-", and empty lines make new paragraph. | |
7007 (if (string-match "^ *-\\|^[ \t]*$" line) (insert "<p>")) | |
7008 (insert line (if org-export-preserve-breaks "<br>\n" "\n")))) | |
7009 )) | |
7010 (if org-export-html-with-timestamp | |
7011 (insert org-export-html-html-helper-timestamp)) | |
7012 (insert "</body>\n</html>\n") | |
7013 (normal-mode) | |
7014 (save-buffer) | |
7015 (goto-char (point-min))))) | |
7016 | |
7017 (defun org-format-table-html (lines olines) | |
7018 "Find out which HTML converter to use and return the HTML code." | |
7019 (if (string-match "^[ \t]*|" (car lines)) | |
7020 ;; A normal org table | |
7021 (org-format-org-table-html lines) | |
7022 ;; Table made by table.el - test for spanning | |
7023 (let* ((hlines (delq nil (mapcar | |
7024 (lambda (x) | |
7025 (if (string-match "^[ \t]*\\+-" x) x | |
7026 nil)) | |
7027 lines))) | |
7028 (first (car hlines)) | |
7029 (ll (and (string-match "\\S-+" first) | |
7030 (match-string 0 first))) | |
7031 (re (concat "^[ \t]*" (regexp-quote ll))) | |
7032 (spanning (delq nil (mapcar (lambda (x) (not (string-match re x))) | |
7033 hlines)))) | |
7034 (if (and (not spanning) | |
7035 (not org-export-prefer-native-exporter-for-tables)) | |
7036 ;; We can use my own converter with HTML conversions | |
7037 (org-format-table-table-html lines) | |
7038 ;; Need to use the code generator in table.el, with the original text. | |
7039 (org-format-table-table-html-using-table-generate-source olines))))) | |
7040 | |
7041 (defun org-format-org-table-html (lines) | |
7042 "Format a table into html." | |
7043 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) | |
7044 (setq lines (nreverse lines)) | |
7045 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) | |
7046 (setq lines (nreverse lines)) | |
7047 (let ((head (and org-export-highlight-first-table-line | |
7048 (delq nil (mapcar | |
7049 (lambda (x) (string-match "^[ \t]*|-" x)) | |
7050 lines)))) | |
7051 lastline line fields html empty) | |
7052 (setq html (concat org-export-html-table-tag "\n")) | |
7053 (while (setq lastline line | |
7054 line (pop lines)) | |
7055 (setq empty " ") | |
7056 (catch 'next-line | |
7057 (if (string-match "^[ \t]*|-" line) | |
7058 (if lastline | |
7059 ;; A hline: simulate an empty table row instead. | |
7060 (setq line (org-fake-empty-table-line lastline) | |
7061 head nil | |
7062 empty "") | |
7063 ;; Ignore this line | |
7064 (throw 'next-line t))) | |
7065 ;; Break the line into fields | |
7066 (setq fields (org-split-string line "[ \t]*|[ \t]*")) | |
7067 (setq html (concat | |
7068 html | |
7069 "<tr>" | |
7070 (mapconcat (lambda (x) | |
7071 (if (equal x "") (setq x empty)) | |
7072 (if head | |
7073 (concat "<th>" x "</th>") | |
7074 (concat "<td valign=\"top\">" x "</td>"))) | |
7075 fields "") | |
7076 "</tr>\n")))) | |
7077 (setq html (concat html "</table>\n")) | |
7078 html)) | |
7079 | |
7080 (defun org-fake-empty-table-line (line) | |
7081 "Replace everything except \"|\" with spaces." | |
7082 (let ((i (length line)) | |
7083 (newstr (copy-sequence line))) | |
7084 (while (> i 0) | |
7085 (setq i (1- i)) | |
7086 (if (not (eq (aref newstr i) ?|)) | |
7087 (aset newstr i ?\ ))) | |
7088 newstr)) | |
7089 | |
7090 (defun org-format-table-table-html (lines) | |
7091 "Format a table generated by table.el into html. | |
7092 This conversion does *not* use `table-generate-source' from table.el. | |
7093 This has the advantage that Org-mode's HTML conversions can be used. | |
7094 But it has the disadvantage, that no cell- or row-spanning is allowed." | |
7095 (let (line field-buffer | |
7096 (head org-export-highlight-first-table-line) | |
7097 fields html empty) | |
7098 (setq html (concat org-export-html-table-tag "\n")) | |
7099 (while (setq line (pop lines)) | |
7100 (setq empty " ") | |
7101 (catch 'next-line | |
7102 (if (string-match "^[ \t]*\\+-" line) | |
7103 (progn | |
7104 (if field-buffer | |
7105 (progn | |
7106 (setq html (concat | |
7107 html | |
7108 "<tr>" | |
7109 (mapconcat | |
7110 (lambda (x) | |
7111 (if (equal x "") (setq x empty)) | |
7112 (if head | |
7113 (concat "<th valign=\"top\">" x | |
7114 "</th>\n") | |
7115 (concat "<td valign=\"top\">" x | |
7116 "</td>\n"))) | |
7117 field-buffer "\n") | |
7118 "</tr>\n")) | |
7119 (setq head nil) | |
7120 (setq field-buffer nil))) | |
7121 ;; Ignore this line | |
7122 (throw 'next-line t))) | |
7123 ;; Break the line into fields and store the fields | |
7124 (setq fields (org-split-string line "[ \t]*|[ \t]*")) | |
7125 (if field-buffer | |
7126 (setq field-buffer (mapcar | |
7127 (lambda (x) | |
7128 (concat x "<br>" (pop fields))) | |
7129 field-buffer)) | |
7130 (setq field-buffer fields)))) | |
7131 (setq html (concat html "</table>\n")) | |
7132 html)) | |
7133 | |
7134 (defun org-format-table-table-html-using-table-generate-source (lines) | |
7135 "Format a table into html, using `table-generate-source' from table.el. | |
7136 This has the advantage that cell- or row-spanning is allowed. | |
7137 But it has the disadvantage, that Org-mode's HTML conversions cannot be used." | |
7138 (require 'table) | |
7139 (save-excursion | |
7140 (set-buffer (get-buffer-create " org-tmp1 ")) | |
7141 (erase-buffer) | |
7142 (insert (mapconcat 'identity lines "\n")) | |
7143 (goto-char (point-min)) | |
7144 (if (not (re-search-forward "|[^+]" nil t)) | |
7145 (error "Error processing table.")) | |
7146 (table-recognize-table) | |
7147 (save-excursion | |
7148 (set-buffer (get-buffer-create " org-tmp2 ")) | |
7149 (erase-buffer)) | |
7150 (table-generate-source 'html " org-tmp2 ") | |
7151 (set-buffer " org-tmp2 ") | |
7152 (buffer-substring (point-min) (point-max)))) | |
7153 | |
7154 (defun org-html-expand (string) | |
7155 "Prepare STRING for HTML export. Applies all active conversions." | |
7156 ;; First check if there is a link in the line - if yes, apply conversions | |
7157 ;; only before the start of the link. | |
7158 (let* ((m (string-match org-link-regexp string)) | |
7159 (s (if m (substring string 0 m) string)) | |
7160 (r (if m (substring string m) ""))) | |
7161 ;; convert < to < and > to > | |
7162 (while (string-match "<" s) | |
7163 (setq s (replace-match "<" nil nil s))) | |
7164 (while (string-match ">" s) | |
7165 (setq s (replace-match ">" nil nil s))) | |
7166 (if org-export-html-expand | |
7167 (while (string-match "@<\\([^&]*\\)>" s) | |
7168 (setq s (replace-match "<\\1>" nil nil s)))) | |
7169 (if org-export-with-emphasize | |
7170 (setq s (org-export-html-convert-emphasize s))) | |
7171 (if org-export-with-sub-superscripts | |
7172 (setq s (org-export-html-convert-sub-super s))) | |
7173 (if org-export-with-TeX-macros | |
7174 (let ((start 0) wd ass) | |
7175 (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start)) | |
7176 (setq wd (match-string 1 s)) | |
7177 (if (setq ass (assoc wd org-html-entities)) | |
7178 (setq s (replace-match (or (cdr ass) | |
7179 (concat "&" (car ass) ";")) | |
7180 t t s)) | |
7181 (setq start (+ start (length wd))))))) | |
7182 (concat s r))) | |
7183 | |
7184 (defun org-create-multibrace-regexp (left right n) | |
7185 "Create a regular expression which will match a balanced sexp. | |
7186 Opening delimiter is LEFT, and closing delimiter is RIGHT, both given | |
7187 as single character strings. | |
7188 The regexp returned will match the entire expression including the | |
7189 delimiters. It will also define a single group which contains the | |
7190 match except for the outermost delimiters. The maximum depth of | |
7191 stacked delimiters is N. Escaping delimiters is not possible." | |
7192 (let* ((nothing (concat "[^" "\\" left "\\" right "]*?")) | |
7193 (or "\\|") | |
7194 (re nothing) | |
7195 (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) | |
7196 (while (> n 1) | |
7197 (setq n (1- n) | |
7198 re (concat re or next) | |
7199 next (concat "\\(?:" nothing left next right "\\)+" nothing))) | |
7200 (concat left "\\(" re "\\)" right))) | |
7201 | |
7202 (defvar org-match-substring-regexp | |
7203 (concat | |
7204 "\\([^\\]\\)\\([_^]\\)\\(" | |
7205 "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" | |
7206 "\\|" | |
7207 "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" | |
7208 "\\|" | |
7209 "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") | |
7210 "The regular expression matching a sub- or superscript.") | |
7211 | |
7212 (defun org-export-html-convert-sub-super (string) | |
7213 "Convert sub- and superscripts in STRING to HTML." | |
7214 (let (key c) | |
7215 (while (string-match org-match-substring-regexp string) | |
7216 (setq key (if (string= (match-string 2 string) "_") "sub" "sup")) | |
7217 (setq c (or (match-string 8 string) | |
7218 (match-string 6 string) | |
7219 (match-string 5 string))) | |
7220 (setq string (replace-match | |
7221 (concat (match-string 1 string) | |
7222 "<" key ">" c "</" key ">") | |
7223 t t string))) | |
7224 (while (string-match "\\\\\\([_^]\\)" string) | |
7225 (setq string (replace-match (match-string 1 string) t t string)))) | |
7226 string) | |
7227 | |
7228 (defun org-export-html-convert-emphasize (string) | |
7229 (while (string-match | |
7230 "\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" | |
7231 string) | |
7232 (setq string (replace-match | |
7233 (concat "<b>" (match-string 3 string) "</b>") | |
7234 t t string 2))) | |
7235 (while (string-match | |
7236 "\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" | |
7237 string) | |
7238 (setq string (replace-match | |
7239 (concat "<i>" (match-string 3 string) "</i>") | |
7240 t t string 2))) | |
7241 (while (string-match | |
7242 "\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" | |
7243 string) | |
7244 (setq string (replace-match | |
7245 (concat "<u>" (match-string 3 string) "</u>") | |
7246 t t string 2))) | |
7247 string) | |
7248 | |
7249 (defun org-parse-key-lines () | |
7250 "Find the special key lines with the information for exporters." | |
7251 (save-excursion | |
7252 (goto-char 0) | |
7253 (let ((re (org-make-options-regexp | |
7254 '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) | |
7255 key) | |
7256 (while (re-search-forward re nil t) | |
7257 (setq key (match-string 1)) | |
7258 (cond ((string-equal key "TITLE") | |
7259 (setq title (match-string 2))) | |
7260 ((string-equal key "AUTHOR") | |
7261 (setq author (match-string 2))) | |
7262 ((string-equal key "EMAIL") | |
7263 (setq email (match-string 2))) | |
7264 ((string-equal key "LANGUAGE") | |
7265 (setq language (match-string 2))) | |
7266 ((string-equal key "TEXT") | |
7267 (setq text (concat text "\n" (match-string 2)))) | |
7268 ((string-equal key "OPTIONS") | |
7269 (setq options (match-string 2)))))))) | |
7270 | |
7271 (defun org-parse-export-options (s) | |
7272 "Parse the export options line." | |
7273 (let ((op '(("H" . org-export-headline-levels) | |
7274 ("num" . org-export-with-section-numbers) | |
7275 ("toc" . org-export-with-toc) | |
7276 ("\\n" . org-export-preserve-breaks) | |
7277 ("@" . org-export-html-expand) | |
7278 (":" . org-export-with-fixed-width) | |
7279 ("|" . org-export-with-tables) | |
7280 ("^" . org-export-with-sub-superscripts) | |
7281 ("*" . org-export-with-emphasize) | |
7282 ("TeX" . org-export-with-TeX-macros))) | |
7283 o) | |
7284 (while (setq o (pop op)) | |
7285 (if (string-match (concat (regexp-quote (car o)) ":\\([^ \t\n\r;,.]*\\)") | |
7286 s) | |
7287 (set (make-local-variable (cdr o)) | |
7288 (car (read-from-string (match-string 1 s)))))))) | |
7289 | |
7290 (defun org-html-level-start (level title umax with-toc head-count) | |
7291 "Insert a new level in HTML export." | |
7292 (let ((l (1+ (max level umax)))) | |
7293 (while (<= l org-level-max) | |
7294 (if (aref levels-open (1- l)) | |
7295 (progn | |
7296 (org-html-level-close l) | |
7297 (aset levels-open (1- l) nil))) | |
7298 (setq l (1+ l))) | |
7299 (if (> level umax) | |
7300 (progn | |
7301 (if (aref levels-open (1- level)) | |
7302 (insert "<li>" title "<p>\n") | |
7303 (aset levels-open (1- level) t) | |
7304 (insert "<ul><li>" title "<p>\n"))) | |
7305 (if org-export-with-section-numbers | |
7306 (setq title (concat (org-section-number level) " " title))) | |
7307 (setq level (+ level 1)) | |
7308 (if with-toc | |
7309 (insert (format "\n<H%d><a name=\"sec-%d\">%s</a></H%d>\n" | |
7310 level head-count title level)) | |
7311 (insert (format "\n<H%d>%s</H%d>\n" level title level)))))) | |
7312 | |
7313 (defun org-html-level-close (level) | |
7314 "Terminate one level in HTML export." | |
7315 (insert "</ul>")) | |
7316 | |
7317 | |
7318 ;; Variable holding the vector with section numbers | |
7319 (defvar org-section-numbers (make-vector org-level-max 0)) | |
7320 | |
7321 (defun org-init-section-numbers () | |
7322 "Initialize the vector for the section numbers." | |
7323 (let* ((level -1) | |
7324 (numbers (nreverse (org-split-string "" "\\."))) | |
7325 (depth (1- (length org-section-numbers))) | |
7326 (i depth) number-string) | |
7327 (while (>= i 0) | |
7328 (if (> i level) | |
7329 (aset org-section-numbers i 0) | |
7330 (setq number-string (or (car numbers) "0")) | |
7331 (if (string-match "\\`[A-Z]\\'" number-string) | |
7332 (aset org-section-numbers i | |
7333 (- (string-to-char number-string) ?A -1)) | |
7334 (aset org-section-numbers i (string-to-int number-string))) | |
7335 (pop numbers)) | |
7336 (setq i (1- i))))) | |
7337 | |
7338 (defun org-section-number (&optional level) | |
7339 "Return a string with the current section number. | |
7340 When LEVEL is non-nil, increase section numbers on that level." | |
7341 (let* ((depth (1- (length org-section-numbers))) idx n (string "")) | |
7342 (when level | |
7343 (when (> level -1) | |
7344 (aset org-section-numbers | |
7345 level (1+ (aref org-section-numbers level)))) | |
7346 (setq idx (1+ level)) | |
7347 (while (<= idx depth) | |
7348 (if (not (= idx 1)) | |
7349 (aset org-section-numbers idx 0)) | |
7350 (setq idx (1+ idx)))) | |
7351 (setq idx 0) | |
7352 (while (<= idx depth) | |
7353 (setq n (aref org-section-numbers idx)) | |
7354 (setq string (concat string (if (not (string= string "")) "." "") | |
7355 (int-to-string n))) | |
7356 (setq idx (1+ idx))) | |
7357 (save-match-data | |
7358 (if (string-match "\\`\\([@0]\\.\\)+" string) | |
7359 (setq string (replace-match "" nil nil string))) | |
7360 (if (string-match "\\(\\.0\\)+\\'" string) | |
7361 (setq string (replace-match "" nil nil string)))) | |
7362 string)) | |
7363 | |
7364 | |
7365 ;;; Key bindings | |
7366 | |
7367 ;; - Bindings in Org-mode map are currently | |
7368 ;; 0123456789abcdefghijklmnopqrstuvwxyz!?@#$%^&-+*/=()_{}[]:;"|,.<>~`'\t the alphabet | |
7369 ;; abcd fgh j lmnopqrstuvwxyz ? # -+ /= [] ; |,.<> \t necessary bindings | |
7370 ;; e (?) useful from outline-mode | |
7371 ;; i k @ expendable from outline-mode | |
7372 ;; 0123456789 ! $%^& * ()_{} " ~`' free | |
7373 | |
7374 (define-key org-mode-map [(tab)] 'org-cycle) | |
7375 (define-key org-mode-map "\C-i" 'org-cycle) | |
7376 (define-key org-mode-map [(meta tab)] 'org-complete) | |
7377 (define-key org-mode-map "\M-\C-i" 'org-complete) | |
7378 (define-key org-mode-map [(meta shift left)] 'org-shiftmetaleft) | |
7379 (define-key org-mode-map [(meta left)] 'org-metaleft) | |
7380 (define-key org-mode-map [(meta shift right)] 'org-shiftmetaright) | |
7381 (define-key org-mode-map [(meta shift up)] 'org-shiftmetaup) | |
7382 (define-key org-mode-map [(meta shift down)] 'org-shiftmetadown) | |
7383 (define-key org-mode-map [(meta right)] 'org-metaright) | |
7384 (define-key org-mode-map [(meta up)] 'org-metaup) | |
7385 (define-key org-mode-map [(meta down)] 'org-metadown) | |
7386 ;(define-key org-mode-map "\C-c\C-h\C-w" 'org-cut-subtree) | |
7387 ;(define-key org-mode-map "\C-c\C-h\M-w" 'org-copy-subtree) | |
7388 ;(define-key org-mode-map "\C-c\C-h\C-y" 'org-paste-subtree) | |
7389 (define-key org-mode-map "\C-c\C-h\C-w" 'org-cut-special) | |
7390 (define-key org-mode-map "\C-c\C-h\M-w" 'org-copy-special) | |
7391 (define-key org-mode-map "\C-c\C-h\C-y" 'org-paste-special) | |
7392 (define-key org-mode-map "\C-c\C-j" 'org-goto) | |
7393 (define-key org-mode-map "\C-c\C-t" 'org-todo) | |
7394 (define-key org-mode-map "\C-c\C-s" 'org-schedule) | |
7395 (define-key org-mode-map "\C-c\C-d" 'org-deadline) | |
7396 (define-key org-mode-map "\C-c;" 'org-toggle-comment) | |
7397 (define-key org-mode-map "\C-c\C-v" 'org-show-todo-tree) | |
7398 (define-key org-mode-map "\C-c\C-w" 'org-check-deadlines) | |
7399 (define-key org-mode-map "\C-c/" 'org-occur) ; Minor-mode reserved | |
7400 (define-key org-mode-map "\C-c\C-m" 'org-insert-heading) | |
7401 (define-key org-mode-map "\M-\C-m" 'org-insert-heading) | |
7402 (define-key org-mode-map "\C-c\C-l" 'org-insert-link) | |
7403 (define-key org-mode-map "\C-c\C-o" 'org-open-at-point) | |
7404 (define-key org-mode-map "\C-c\C-z" 'org-time-stamp) ; Alternative binding | |
7405 (define-key org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved | |
7406 (define-key org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved | |
7407 (define-key org-mode-map "\C-c\C-y" 'org-evaluate-time-range) | |
7408 (define-key org-mode-map "\C-c>" 'org-goto-calendar) | |
7409 (define-key org-mode-map "\C-c<" 'org-date-from-calendar) | |
7410 (define-key org-mode-map "\C-c[" 'org-add-file) | |
7411 (define-key org-mode-map "\C-c]" 'org-remove-file) | |
7412 (define-key org-mode-map "\C-c\C-r" 'org-timeline) | |
7413 ;(define-key org-mode-map [(shift up)] 'org-timestamp-up) | |
7414 ;(define-key org-mode-map [(shift down)] 'org-timestamp-down) | |
7415 (define-key org-mode-map [(shift up)] 'org-shiftup) | |
7416 (define-key org-mode-map [(shift down)] 'org-shiftdown) | |
7417 (define-key org-mode-map [(shift left)] 'org-timestamp-down-day) | |
7418 (define-key org-mode-map [(shift right)] 'org-timestamp-up-day) | |
7419 (define-key org-mode-map "\C-c-" 'org-table-insert-hline) | |
7420 ;; The following line is e.g. necessary for German keyboards under Suse Linux | |
7421 (unless org-xemacs-p | |
7422 (define-key org-mode-map [S-iso-lefttab] 'org-shifttab)) | |
7423 (define-key org-mode-map [(shift tab)] 'org-shifttab) | |
7424 (define-key org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) | |
7425 (define-key org-mode-map [(return)] 'org-return) | |
7426 (define-key org-mode-map [(shift return)] 'org-table-copy-from-above) | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7427 (define-key org-mode-map [(meta return)] 'org-meta-return) |
58792 | 7428 (define-key org-mode-map [(control up)] 'org-move-line-up) |
7429 (define-key org-mode-map [(control down)] 'org-move-line-down) | |
7430 (define-key org-mode-map "\C-c?" 'org-table-current-column) | |
7431 (define-key org-mode-map "\C-c " 'org-table-blank-field) | |
7432 (define-key org-mode-map "\C-c+" 'org-table-sum) | |
7433 (define-key org-mode-map "\C-c|" 'org-table-toggle-vline-visibility) | |
7434 (define-key org-mode-map "\C-c=" 'org-table-eval-formula) | |
7435 (define-key org-mode-map "\C-c#" 'org-table-create-with-table.el) | |
7436 (define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) | |
7437 (define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii) | |
7438 (define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii) | |
7439 (define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template) | |
7440 (define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section) | |
7441 (define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) | |
7442 (define-key org-mode-map "\C-c\C-x\C-h" 'org-export-as-html-and-open) | |
7443 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7444 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7445 ;; FIXME: Do we really need to save match data in these commands? |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7446 ;; I would like to remove it in order to minimize impact. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7447 ;; Self-insert already does not preserve it. How much resources does this take??? |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7448 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7449 (defsubst org-table-p () |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7450 (if (and (eq major-mode 'org-mode) font-lock-mode) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7451 (eq (get-text-property (point) 'face) 'org-table-face) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7452 (save-match-data (org-at-table-p)))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7453 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7454 (defun org-self-insert-command (N) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7455 "Like `self-insert-command', use overwrite-mode for whitespace in tables. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7456 If the cursor is in a table looking at whitespace, the whitespace is |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7457 overwritten, and the table is not marked as requiring realignment." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7458 (interactive "p") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7459 (if (and (org-table-p) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7460 (eq N 1) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7461 (looking-at "[^|\n]* +|")) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7462 (let (org-table-may-need-update (pos (point))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7463 (goto-char (1- (match-end 0))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7464 (delete-backward-char 1) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7465 (goto-char (match-beginning 0)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7466 (self-insert-command N)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7467 (setq org-table-may-need-update t) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7468 (self-insert-command N))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7469 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7470 ;; FIXME: |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7471 ;; The following two functions might still be optimized to trigger |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7472 ;; re-alignment less frequently. Right now they raise the flag each time |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7473 ;; (through before-change-functions). Here is how this could be minimized: |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7474 ;; Basically, check if the non-white field width before deletion is |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7475 ;; equal to the column width. If yes, the delete should trigger a |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7476 ;; re-align. I have not implemented this so far because it is not so |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7477 ;; easy, requires grabbing the field etc. So it may finally have some |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7478 ;; impact on typing performance which we don't want. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7479 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7480 ;; The defsubst is only a draft, untested... |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7481 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7482 ;; Maybe it is not so important to get rid of realigns - maybe the most |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7483 ;; important aspect is to keep the table look noce as long as possible, |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7484 ;; which is already achieved... |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7485 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7486 ;(defsubst org-check-delete-triggers-realign () |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7487 ; (let ((pos (point))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7488 ; (skip-chars-backward "^|\n") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7489 ; (and (looking-at " *\\(.*?\\) *|") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7490 ; (= (nth (1- (org-table-current-column)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7491 ; org-table-last-column-widths) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7492 ; (- (match-end 1) (match-beginning 1))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7493 ; (setq org-table-may-need-update t)))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7494 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7495 (defun org-delete-backward-char (N) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7496 "Like `delete-backward-char', insert whitespace at field end in tables. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7497 When deleting backwards, in tables this function will insert whitespace in |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7498 front of the next \"|\" separator, to keep the table aligned. The table will |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7499 still be marked for re-alignment, because a narrow field may lead to a |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7500 reduced column width." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7501 (interactive "p") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7502 (if (and (org-table-p) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7503 (eq N 1) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7504 (looking-at ".*?|")) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7505 (let ((pos (point))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7506 (backward-delete-char N) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7507 (skip-chars-forward "^|") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7508 (insert " ") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7509 (goto-char (1- pos))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7510 (backward-delete-char N))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7511 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7512 (defun org-delete-char (N) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7513 "Like `delete-char', but insert whitespace at field end in tables. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7514 When deleting characters, in tables this function will insert whitespace in |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7515 front of the next \"|\" separator, to keep the table aligned. The table |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7516 will still be marked for re-alignment, because a narrow field may lead to |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7517 a reduced column width." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7518 (interactive "p") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7519 (if (and (org-table-p) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7520 (eq N 1)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7521 (if (looking-at ".*?|") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7522 (let ((pos (point))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7523 (replace-match (concat |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7524 (substring (match-string 0) 1 -1) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7525 " |")) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7526 (goto-char pos))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7527 (delete-char N))) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7528 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7529 ;; How to do this: Measure non-white length of current string |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7530 ;; If equal to column width, we should realign. |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7531 |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7532 (when (eq org-enable-table-editor 'optimized) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7533 ;; If the user wants maximum table support, we need to hijack |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7534 ;; some standard editing functions |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7535 (substitute-key-definition 'self-insert-command 'org-self-insert-command |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7536 org-mode-map global-map) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7537 (substitute-key-definition 'delete-char 'org-delete-char |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7538 org-mode-map global-map) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7539 (substitute-key-definition 'delete-backward-char 'org-delete-backward-char |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7540 org-mode-map global-map) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7541 (define-key org-mode-map "|" 'self-insert-command)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7542 |
58792 | 7543 (defun org-shiftcursor-error () |
7544 "Throw an error because Shift-Cursor command was applied in wrong context." | |
7545 (error "This command is only active in tables and on headlines.")) | |
7546 | |
7547 (defun org-shifttab () | |
7548 "Call `(org-cycle t)' or `org-table-previous-field'." | |
7549 (interactive) | |
7550 (cond | |
7551 ((org-at-table-p) (org-table-previous-field)) | |
7552 (t (org-cycle '(4))))) | |
7553 | |
7554 (defun org-shiftmetaleft (&optional arg) | |
7555 "Call `org-promote-subtree' or `org-table-delete-column'." | |
7556 (interactive "P") | |
7557 (cond | |
7558 ((org-at-table-p) (org-table-delete-column arg)) | |
7559 ((org-on-heading-p) (org-promote-subtree arg)) | |
7560 (t (org-shiftcursor-error)))) | |
7561 (defun org-shiftmetaright (&optional arg) | |
7562 "Call `org-demote-subtree' or `org-table-insert-column'." | |
7563 (interactive "P") | |
7564 (cond | |
7565 ((org-at-table-p) (org-table-insert-column arg)) | |
7566 ((org-on-heading-p) (org-demote-subtree arg)) | |
7567 (t (org-shiftcursor-error)))) | |
7568 (defun org-shiftmetaup (&optional arg) | |
7569 "Call `org-move-subtree-up' or `org-table-kill-row'." | |
7570 (interactive "P") | |
7571 (cond | |
7572 ((org-at-table-p) (org-table-kill-row arg)) | |
7573 ((org-on-heading-p) (org-move-subtree-up arg)) | |
7574 (t (org-shiftcursor-error)))) | |
7575 (defun org-shiftmetadown (&optional arg) | |
7576 "Call `org-move-subtree-down' or `org-table-insert-row'." | |
7577 (interactive "P") | |
7578 (cond | |
7579 ((org-at-table-p) (org-table-insert-row arg)) | |
7580 ((org-on-heading-p) (org-move-subtree-down arg)) | |
7581 (t (org-shiftcursor-error)))) | |
7582 | |
7583 (defun org-metaleft (&optional arg) | |
7584 "Call `org-do-promote' or `org-table-move-column' to left." | |
7585 (interactive "P") | |
7586 (cond | |
7587 ((org-at-table-p) (org-table-move-column 'left)) | |
7588 ((or (org-on-heading-p) (org-region-active-p)) (org-do-promote arg)) | |
7589 (t (backward-word (prefix-numeric-value arg))))) | |
7590 (defun org-metaright (&optional arg) | |
7591 "Call `org-do-demote' or `org-table-move-column' to right." | |
7592 (interactive "P") | |
7593 (cond | |
7594 ((org-at-table-p) (org-table-move-column nil)) | |
7595 ((or (org-on-heading-p) (org-region-active-p)) (org-do-demote arg)) | |
7596 (t (forward-word (prefix-numeric-value arg))))) | |
7597 (defun org-metaup (&optional arg) | |
7598 "Call `org-move-subtree-up' or `org-table-move-row' up." | |
7599 (interactive "P") | |
7600 (cond | |
7601 ((org-at-table-p) (org-table-move-row 'up)) | |
7602 ((org-on-heading-p) (org-move-subtree-up arg)) | |
7603 (t (org-shiftcursor-error)))) | |
7604 (defun org-metadown (&optional arg) | |
7605 "Call `org-move-subtree-down' or `org-table-move-row' down." | |
7606 (interactive "P") | |
7607 (cond | |
7608 ((org-at-table-p) (org-table-move-row nil)) | |
7609 ((org-on-heading-p) (org-move-subtree-down arg)) | |
7610 (t (org-shiftcursor-error)))) | |
7611 | |
7612 (defun org-shiftup (&optional arg) | |
7613 "Call `org-timestamp-up' or `org-priority-up'." | |
7614 (interactive "P") | |
7615 (cond | |
7616 ((org-at-timestamp-p) (org-timestamp-up arg)) | |
7617 (t (org-priority-up)))) | |
7618 | |
7619 (defun org-shiftdown (&optional arg) | |
7620 "Call `org-timestamp-down' or `org-priority-down'." | |
7621 (interactive "P") | |
7622 (cond | |
7623 ((org-at-timestamp-p) (org-timestamp-down arg)) | |
7624 (t (org-priority-down)))) | |
7625 | |
7626 (defun org-copy-special (arg) | |
7627 "Call either `org-table-copy' or `org-copy-subtree'." | |
7628 (interactive "P") | |
7629 (if (org-at-table-p) | |
7630 (org-table-copy-region arg) | |
7631 (org-copy-subtree arg))) | |
7632 | |
7633 (defun org-cut-special (arg) | |
7634 "Call either `org-table-copy' or `org-copy-subtree'." | |
7635 (interactive "P") | |
7636 (if (org-at-table-p) | |
7637 (org-table-cut-region arg) | |
7638 (org-cut-subtree arg))) | |
7639 | |
7640 (defun org-paste-special (arg) | |
7641 "Call either `org-table-paste-rectangle' or `org-paste-subtree'." | |
7642 (interactive "P") | |
7643 (if (org-at-table-p) | |
7644 (org-table-paste-rectangle arg) | |
7645 (org-paste-subtree arg))) | |
7646 | |
7647 (defun org-ctrl-c-ctrl-c (&optional arg) | |
7648 "Call realign table, or recognize a table.el table. | |
7649 When the cursor is inside a table created by the table.el package, | |
7650 activate that table. Otherwise, if the cursor is at a normal table | |
7651 created with org.el, re-align that table. This command works even if | |
7652 the automatic table editor has been turned off." | |
7653 (interactive "P") | |
7654 (let ((org-enable-table-editor t)) | |
7655 (cond | |
7656 ((org-at-table.el-p) | |
7657 (require 'table) | |
7658 (beginning-of-line 1) | |
7659 (re-search-forward "|" (save-excursion (end-of-line 2) (point))) | |
7660 (table-recognize-table)) | |
7661 ((org-at-table-p) | |
7662 (org-table-align)) | |
7663 ((org-region-active-p) | |
7664 (org-table-convert-region (region-beginning) (region-end) arg)) | |
7665 ((and (region-beginning) (region-end)) | |
7666 (if (y-or-n-p "Convert inactive region to table? ") | |
7667 (org-table-convert-region (region-beginning) (region-end) arg) | |
7668 (error "Abort"))) | |
7669 (t (error "No table at point, and no region to make one."))))) | |
7670 | |
7671 (defun org-return (&optional arg) | |
7672 "Call `org-table-next-row' or `newline'." | |
7673 (interactive "P") | |
7674 (cond | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7675 ((org-at-table-p) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7676 (org-table-justify-field-maybe) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7677 (org-table-next-row)) |
58792 | 7678 (t (newline)))) |
7679 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7680 (defun org-meta-return (&optional arg) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7681 "Call `org-insert-heading' or `org-table-wrap-region'." |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7682 (interactive "P") |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7683 (cond |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7684 ((org-at-table-p) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7685 (org-table-wrap-region arg)) |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7686 (t (org-insert-heading arg)))) |
58792 | 7687 |
7688 ;;; Menu entries | |
7689 | |
7690 ;; First, remove the outline menus. | |
7691 (if org-xemacs-p | |
7692 (add-hook 'org-mode-hook | |
7693 (lambda () | |
7694 (delete-menu-item '("Headings")) | |
7695 (delete-menu-item '("Show")) | |
7696 (delete-menu-item '("Hide")) | |
7697 (set-menubar-dirty-flag))) | |
7698 (setq org-mode-map (delq (assoc 'menu-bar (cdr org-mode-map)) | |
7699 org-mode-map))) | |
7700 | |
7701 ;; Define the Org-mode menus | |
7702 (easy-menu-define org-org-menu org-mode-map "Org menu" | |
7703 '("Org" | |
7704 ["Cycle Visibility" org-cycle (or (bobp) (outline-on-heading-p))] | |
7705 ["Sparse Tree" org-occur t] | |
7706 ["Show All" show-all t] | |
7707 "--" | |
7708 ["New Heading" org-insert-heading t] | |
7709 ("Navigate Headings" | |
7710 ["Up" outline-up-heading t] | |
7711 ["Next" outline-next-visible-heading t] | |
7712 ["Previous" outline-previous-visible-heading t] | |
7713 ["Next Same Level" outline-forward-same-level t] | |
7714 ["Previous Same Level" outline-backward-same-level t] | |
7715 "--" | |
7716 ["Jump" org-goto t]) | |
7717 ("Edit Structure" | |
7718 ["Move subtree up" org-shiftmetaup (not (org-at-table-p))] | |
7719 ["Move subtree down" org-shiftmetadown (not (org-at-table-p))] | |
7720 "--" | |
7721 ["Copy Subtree" org-copy-special (not (org-at-table-p))] | |
7722 ["Cut Subtree" org-cut-special (not (org-at-table-p))] | |
7723 ["Paste Subtree" org-paste-special (not (org-at-table-p))] | |
7724 "--" | |
7725 ["Promote Heading" org-metaleft (not (org-at-table-p))] | |
7726 ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] | |
7727 ["Demote Heading" org-metaright (not (org-at-table-p))] | |
7728 ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))]) | |
7729 "--" | |
7730 ("TODO lists" | |
7731 ["TODO/DONE/-" org-todo t] | |
7732 ["Show TODO Tree" org-show-todo-tree t] | |
7733 "--" | |
7734 ["Set priority" org-priority t] | |
7735 ["Priority up" org-shiftup t] | |
7736 ["Priority down" org-shiftdown t]) | |
7737 ("Dates and Scheduling" | |
7738 ["Timestamp" org-time-stamp t] | |
7739 ("Change Date" | |
7740 ["1 day later" org-timestamp-up-day t] | |
7741 ["1 day earlier" org-timestamp-down-day t] | |
7742 ["1 ... later" org-shiftup t] | |
7743 ["1 ... earlier" org-shiftdown t]) | |
7744 ["Compute Time Range" org-evaluate-time-range t] | |
7745 ["Schedule Item" org-schedule t] | |
7746 ["Deadline" org-deadline t] | |
7747 "--" | |
7748 ["Goto Calendar" org-goto-calendar t] | |
7749 ["Date from Calendar" org-date-from-calendar t]) | |
7750 "--" | |
7751 ("Timeline/Agenda" | |
7752 ["Show TODO Tree this file" org-show-todo-tree t] | |
7753 ["Check Deadlines this file" org-check-deadlines t] | |
7754 ["Timeline current file" org-timeline t] | |
7755 "--" | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
7756 ["Adenda (multifile)" org-agenda t]) |
58792 | 7757 ("File List for Agenda") |
7758 "--" | |
7759 ("Hyperlinks" | |
7760 ["Store Link (global)" org-store-link t] | |
7761 ["Insert Link" org-insert-link t] | |
7762 ["Follow Link" org-open-at-point t]) | |
7763 ;; ["BBDB" org-bbdb-name t] | |
7764 "--" | |
7765 ("Table" | |
7766 ["Align" org-ctrl-c-ctrl-c (org-at-table-p)] | |
7767 ["Next field" org-cycle (org-at-table-p)] | |
7768 ["Previous Field" org-shifttab (org-at-table-p)] | |
7769 ["Next row" org-return (org-at-table-p)] | |
7770 "--" | |
7771 ["Blank field" org-table-blank-field (org-at-table-p)] | |
7772 ["Copy field from above" org-table-copy-from-above (org-at-table-p)] | |
7773 "--" | |
7774 ("Column" | |
7775 ["Move column left" org-metaleft (org-at-table-p)] | |
7776 ["Move column right" org-metaright (org-at-table-p)] | |
7777 ["Delete column" org-shiftmetaleft (org-at-table-p)] | |
7778 ["Insert column" org-shiftmetaright (org-at-table-p)]) | |
7779 ("Row" | |
7780 ["Move row up" org-metaup (org-at-table-p)] | |
7781 ["Move row down" org-metadown (org-at-table-p)] | |
7782 ["Delete row" org-shiftmetaup (org-at-table-p)] | |
7783 ["Insert row" org-shiftmetadown (org-at-table-p)] | |
7784 "--" | |
7785 ["Insert hline" org-table-insert-hline (org-at-table-p)]) | |
7786 ("Rectangle" | |
7787 ["Copy rectangle" org-copy-special (org-at-table-p)] | |
7788 ["Cut rectangle" org-cut-special (org-at-table-p)] | |
7789 ["Paste rectangle" org-paste-special (org-at-table-p)] | |
7790 ["Fill rectangle" org-table-wrap-region (org-at-table-p)]) | |
7791 "--" | |
7792 ["Which column?" org-table-current-column (org-at-table-p)] | |
7793 ["Sum column/rectangle" org-table-sum | |
7794 (or (org-at-table-p) (org-region-active-p))] | |
7795 ["Eval formula" org-table-eval-formula (org-at-table-p)] | |
7796 "--" | |
7797 ["Invisible Vlines" org-table-toggle-vline-visibility | |
7798 :style toggle :selected (org-in-invisibility-spec-p '(org-table))] | |
7799 "--" | |
7800 ["Create" org-table-create (and (not (org-at-table-p)) | |
7801 org-enable-table-editor)] | |
7802 ["Convert region" org-ctrl-c-ctrl-c (not (org-at-table-p 'any))] | |
7803 ["Import from file" org-table-import (not (org-at-table-p))] | |
7804 ["Export to file" org-table-export (org-at-table-p)] | |
7805 "--" | |
7806 ["Create/convert from/to table.el" org-table-create-with-table.el t]) | |
7807 "--" | |
7808 ("Export" | |
7809 ["ASCII" org-export-as-ascii t] | |
7810 ["HTML" org-export-as-html t] | |
7811 ["HTML, and open" org-export-as-html-and-open t] | |
7812 "--" | |
7813 ["Option template" org-insert-export-options-template t] | |
7814 ["Toggle fixed width" org-toggle-fixed-width-section t]) | |
7815 "--" | |
7816 ("Documentation" | |
7817 ["Show Version" org-version t] | |
7818 ["Info Documentation" org-info t]) | |
7819 ("Customize" | |
7820 ["Browse Org Group" org-customize t] | |
7821 "--" | |
7822 ["Build Full Customize Menu" org-create-customize-menu | |
7823 (fboundp 'customize-menu-create)]) | |
7824 )) | |
7825 | |
7826 | |
7827 (defun org-info (&optional node) | |
7828 "Read documentation for Org-mode in the info system. | |
7829 With optional NODE, go directly to that node." | |
7830 (interactive) | |
7831 (require 'info) | |
7832 (Info-goto-node (format "(org)%s" (or node "")))) | |
7833 | |
7834 | |
7835 (defun org-install-agenda-files-menu () | |
7836 (easy-menu-change | |
7837 '("Org") "File List for Agenda" | |
7838 (append | |
7839 (list | |
7840 ["Edit file list" (customize-variable 'org-agenda-files) t] | |
7841 ["Add current file to list" org-add-file t] | |
7842 ["Remove current file from list" org-remove-file t] | |
7843 "--") | |
7844 (mapcar 'org-file-menu-entry org-agenda-files)))) | |
7845 | |
7846 ;;; Documentation | |
7847 | |
7848 (defun org-customize () | |
7849 "Call the customize function with org as argument." | |
7850 (interactive) | |
7851 (customize-browse 'org)) | |
7852 | |
7853 (defun org-create-customize-menu () | |
7854 "Create a full customization menu for Org-mode, insert it into the menu." | |
7855 (interactive) | |
7856 (if (fboundp 'customize-menu-create) | |
7857 (progn | |
7858 (easy-menu-change | |
7859 '("Org") "Customize" | |
7860 `(["Browse Org group" org-customize t] | |
7861 "--" | |
7862 ,(customize-menu-create 'org) | |
7863 ["Set" Custom-set t] | |
7864 ["Save" Custom-save t] | |
7865 ["Reset to Current" Custom-reset-current t] | |
7866 ["Reset to Saved" Custom-reset-saved t] | |
7867 ["Reset to Standard Settings" Custom-reset-standard t])) | |
7868 (message "\"Org\"-menu now contains full customization menu")) | |
7869 (error "Cannot expand menu (outdated version of cus-edit.el)"))) | |
7870 | |
7871 ;;; Miscellaneous stuff | |
7872 | |
7873 (defun org-move-line-down (arg) | |
7874 "Move the current line up." | |
7875 (interactive "p") | |
7876 (let ((col (current-column)) | |
7877 beg end pos) | |
7878 (beginning-of-line 1) (setq beg (point)) | |
7879 (beginning-of-line 2) (setq end (point)) | |
7880 (beginning-of-line (+ 1 arg)) | |
7881 (setq pos (move-marker (make-marker) (point))) | |
7882 (insert (delete-and-extract-region beg end)) | |
7883 (goto-char pos) | |
7884 (move-to-column col))) | |
7885 | |
7886 (defun org-move-line-up (arg) | |
7887 "Move the current line up." | |
7888 (interactive "p") | |
7889 (let ((col (current-column)) | |
7890 beg end pos) | |
7891 (beginning-of-line 1) (setq beg (point)) | |
7892 (beginning-of-line 2) (setq end (point)) | |
7893 (beginning-of-line (+ -2 arg)) | |
7894 (setq pos (move-marker (make-marker) (point))) | |
7895 (insert (delete-and-extract-region beg end)) | |
7896 (goto-char pos) | |
7897 (move-to-column col))) | |
7898 | |
7899 ;; Functions needed for Emacs/XEmacs region compatibility | |
7900 | |
7901 (defun org-region-active-p () | |
7902 "Is transient-mark-mode on and the region active? | |
7903 Works on both Emacs and XEmacs." | |
7904 (if org-ignore-region | |
7905 nil | |
7906 (if org-xemacs-p | |
7907 (and zmacs-regions (region-active-p)) | |
7908 (and transient-mark-mode mark-active)))) | |
7909 | |
7910 (defun org-add-to-invisibility-spec (arg) | |
7911 "Add elements to `buffer-invisibility-spec'. | |
7912 See documentation for `buffer-invisibility-spec' for the kind of elements | |
7913 that can be added." | |
7914 (cond | |
7915 ((fboundp 'add-to-invisibility-spec) | |
7916 (add-to-invisibility-spec arg)) | |
7917 ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t)) | |
7918 (setq buffer-invisibility-spec (list arg))) | |
7919 (t | |
7920 (setq buffer-invisibility-spec | |
7921 (cons arg buffer-invisibility-spec))))) | |
7922 | |
7923 (defun org-remove-from-invisibility-spec (arg) | |
7924 "Remove elements from `buffer-invisibility-spec'." | |
7925 (if (fboundp 'remove-from-invisibility-spec) | |
7926 (remove-from-invisibility-spec arg) | |
7927 (if (consp buffer-invisibility-spec) | |
7928 (setq buffer-invisibility-spec | |
7929 (delete arg buffer-invisibility-spec))))) | |
7930 | |
7931 (defun org-in-invisibility-spec-p (arg) | |
7932 "Is ARG a member of `buffer-invisibility-spec'?." | |
7933 (if (consp buffer-invisibility-spec) | |
7934 (member arg buffer-invisibility-spec) | |
7935 nil)) | |
7936 | |
7937 (defun org-image-file-name-regexp () | |
7938 "Return regexp matching the file names of images." | |
7939 (if (fboundp 'image-file-name-regexp) | |
7940 (image-file-name-regexp) | |
7941 (let ((image-file-name-extensions | |
7942 '("png" "jpeg" "jpg" "gif" "tiff" "tif" | |
7943 "xbm" "xpm" "pbm" "pgm" "ppm"))) | |
7944 (concat "\\." | |
7945 (regexp-opt (nconc (mapcar 'upcase | |
7946 image-file-name-extensions) | |
7947 image-file-name-extensions) | |
7948 t) | |
7949 "\\'")))) | |
7950 | |
7951 ;; Functions needed for compatibility with old outline.el | |
7952 | |
7953 ;; The following functions capture almost the entire compatibility code | |
7954 ;; between the different versions of outline-mode. The only other place | |
7955 ;; where this is important are the font-lock-keywords. Search for | |
7956 ;; `org-noutline-p' to find it. | |
7957 | |
7958 ;; C-a should go to the beginning of a *visible* line, also in the | |
7959 ;; new outline.el. I guess this should be patched into Emacs? | |
7960 (defun org-beginning-of-line () | |
7961 "Go to the beginning of the current line. If that is invisible, continue | |
7962 to a visible line beginning. This makes the function of C-a more intuitive." | |
7963 (interactive) | |
7964 (beginning-of-line 1) | |
7965 (if (bobp) | |
7966 nil | |
7967 (backward-char 1) | |
7968 (if (org-invisible-p) | |
7969 (while (and (not (bobp)) (org-invisible-p)) | |
7970 (backward-char 1) | |
7971 (beginning-of-line 1)) | |
7972 (forward-char 1)))) | |
7973 (when org-noutline-p | |
7974 (define-key org-mode-map "\C-a" 'org-beginning-of-line)) | |
7975 | |
7976 (defun org-invisible-p () | |
7977 "Check if point is at a character currently not visible." | |
7978 (if org-noutline-p | |
7979 ;; Early versions of noutline don't have `outline-invisible-p'. | |
7980 (if (fboundp 'outline-invisible-p) | |
7981 (outline-invisible-p) | |
7982 (get-char-property (point) 'invisible)) | |
7983 (save-excursion | |
7984 (skip-chars-backward "^\r\n") | |
7985 (if (bobp) | |
7986 nil | |
7987 (equal (char-before) ?\r))))) | |
7988 | |
7989 (defun org-back-to-heading (&optional invisible-ok) | |
7990 "Move to previous heading line, or beg of this line if it's a heading. | |
7991 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." | |
7992 (if org-noutline-p | |
7993 (outline-back-to-heading invisible-ok) | |
7994 (if (looking-at outline-regexp) | |
7995 t | |
7996 (if (re-search-backward (concat (if invisible-ok "[\r\n]" "^") | |
7997 outline-regexp) | |
7998 nil t) | |
7999 (if invisible-ok | |
8000 (progn (forward-char 1) | |
8001 (looking-at outline-regexp))) | |
8002 (error "Before first heading"))))) | |
8003 | |
8004 (defun org-on-heading-p (&optional invisible-ok) | |
8005 "Return t if point is on a (visible) heading line. | |
8006 If INVISIBLE-OK is non-nil, an invisible heading line is ok too." | |
8007 (if org-noutline-p | |
8008 (outline-on-heading-p 'invisible-ok) | |
8009 (save-excursion | |
8010 (skip-chars-backward "^\n\r") | |
8011 (and (looking-at outline-regexp) | |
8012 (or invisible-ok | |
8013 (bobp) | |
8014 (equal (char-before) ?\n)))))) | |
8015 | |
8016 (defun org-up-heading-all (arg) | |
8017 "Move to the heading line of which the present line is a subheading. | |
8018 This function considers both visible and invisible heading lines. | |
8019 With argument, move up ARG levels." | |
8020 (if org-noutline-p | |
8021 (outline-up-heading-all arg) | |
8022 (org-back-to-heading t) | |
8023 (looking-at outline-regexp) | |
8024 (if (<= (- (match-end 0) (match-beginning 0)) arg) | |
8025 (error "Cannot move up %d levels" arg) | |
8026 (re-search-backward | |
8027 (concat "[\n\r]" (regexp-quote | |
8028 (make-string (- (match-end 0) (match-beginning 0) arg) | |
8029 ?*)) | |
8030 "[^*]")) | |
8031 (forward-char 1)))) | |
8032 | |
8033 (defun org-show-hidden-entry () | |
8034 "Show an entry where even the heading is hidden." | |
8035 (save-excursion | |
8036 (if (not org-noutline-p) | |
8037 (progn | |
8038 (org-back-to-heading t) | |
8039 (org-flag-heading nil))) | |
8040 (show-entry))) | |
8041 | |
8042 (defun org-check-occur-regexp (regexp) | |
8043 "If REGEXP starts with \"^\", modify it to check for \\r as well. | |
8044 Of course, only for the old outline mode." | |
8045 (if org-noutline-p | |
8046 regexp | |
8047 (if (string-match "^\\^" regexp) | |
8048 (concat "[\n\r]" (substring regexp 1)) | |
8049 regexp))) | |
8050 | |
8051 (defun org-flag-heading (flag &optional entry) | |
8052 "Flag the current heading. FLAG non-nil means make invisible. | |
8053 When ENTRY is non-nil, show the entire entry." | |
8054 (save-excursion | |
8055 (org-back-to-heading t) | |
8056 (if (not org-noutline-p) | |
8057 ;; Make the current headline visible | |
8058 (outline-flag-region (max 1 (1- (point))) (point) (if flag ?\r ?\n))) | |
8059 ;; Check if we should show the entire entry | |
8060 (if entry | |
8061 (progn | |
8062 (show-entry) | |
8063 (save-excursion ;; FIXME: Is this the fix for points in the -| | |
8064 ;; middle of text? | | |
8065 (and (outline-next-heading) ;; | | |
8066 (org-flag-heading nil)))) ; show the next heading _| | |
8067 (outline-flag-region (max 1 (1- (point))) | |
8068 (save-excursion (outline-end-of-heading) (point)) | |
8069 (if org-noutline-p | |
8070 flag | |
8071 (if flag ?\r ?\n)))))) | |
8072 | |
8073 (defun org-make-options-regexp (kwds) | |
8074 "Make a regular expression for keyword lines." | |
8075 (concat | |
8076 (if org-noutline-p "^" "[\n\r]") | |
8077 "#?[ \t]*\\+\\(" | |
8078 (mapconcat 'regexp-quote kwds "\\|") | |
8079 "\\):[ \t]*" | |
8080 (if org-noutline-p "\\(.+\\)" "\\([^\n\r]+\\)"))) | |
8081 | |
8082 ;; Advise the bookmark-jump function to make jump position visible | |
8083 ;; Wrapped into eval-after-load to avoid loading advice unnecessarily | |
8084 (eval-after-load "bookmark" | |
8085 '(defadvice bookmark-jump (after org-make-visible activate) | |
8086 "Make the position visible." | |
8087 (and (eq major-mode 'org-mode) | |
8088 (org-invisible-p) | |
8089 (org-show-hierarchy-above)))) | |
8090 | |
8091 ;;; Finish up | |
8092 | |
8093 (provide 'org) | |
8094 | |
8095 (run-hooks 'org-load-hook) | |
8096 | |
59539
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
8097 ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd |
998101ef8562
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
58841
diff
changeset
|
8098 |
58792 | 8099 ;;; org.el ends here |
8100 |