aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--etc/ChangeLog11
-rw-r--r--lisp/org/org-attach.el339
-rw-r--r--lisp/org/org-list.el1042
-rw-r--r--lisp/org/org-plot.el314
4 files changed, 1706 insertions, 0 deletions
diff --git a/etc/ChangeLog b/etc/ChangeLog
index af468126952..f849a96a66e 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,12 @@
12008-10-12 Carsten Dominik <dominik@science.uva.nl>
2
3 * refcards/orgcard.tex: Add description for attachments, plus
4 minor changes.
5
62008-07-24 Carsten Dominik <dominik@science.uva.nl>
7
8 * refcards/orgcard.tex: Minor fixes.
9
12008-09-08 Daiki Ueno <ueno@unixuser.org> 102008-09-08 Daiki Ueno <ueno@unixuser.org>
2 11
3 * TODO: Remove the entry describing auto-encryption. 12 * TODO: Remove the entry describing auto-encryption.
@@ -36,11 +45,13 @@
36 * PROBLEMS: 45 * PROBLEMS:
37 * MACHINES: Remove VMS info. 46 * MACHINES: Remove VMS info.
38 47
48>>>>>>> 1.736
392008-07-27 Dan Nicolaescu <dann@ics.uci.edu> 492008-07-27 Dan Nicolaescu <dann@ics.uci.edu>
40 50
41 * PROBLEMS: 51 * PROBLEMS:
42 * MACHINES: Remove mentions of Mac Carbon. 52 * MACHINES: Remove mentions of Mac Carbon.
43 53
54>>>>>>> 1.727
442008-07-24 Vinicius Jose Latorre <viniciusjl@ig.com.br> 552008-07-24 Vinicius Jose Latorre <viniciusjl@ig.com.br>
45 56
46 * NEWS: New function `diff-show-trailing-blanks' in diff-mode.el. 57 * NEWS: New function `diff-show-trailing-blanks' in diff-mode.el.
diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el
new file mode 100644
index 00000000000..ae363237f11
--- /dev/null
+++ b/lisp/org/org-attach.el
@@ -0,0 +1,339 @@
1;;; org-attach.el --- Manage file attachments to org-mode tasks
2
3;; Copyright (C) 2008 Free Software Foundation, Inc.
4
5;; Author: John Wiegley <johnw@newartisans.com>
6;; Keywords: org data task
7;; Version: 6.09a
8
9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; See the Org-mode manual for information on how to use it.
27;;
28;; Attachments are managed in a special directory called "data", which
29;; lives in the directory given by `org-directory'. If this data
30;; directory is initialized as a Git repository, then org-attach will
31;; automatically commit changes when it sees them.
32;;
33;; Attachment directories are identified using a UUID generated for the
34;; task which has the attachments. These are added as property to the
35;; task when necessary, and should not be deleted or changed by the
36;; user, ever. UUIDs are generated by a mechanism defined in the variable
37;; `org-id-method'.
38
39;;; Code:
40
41(eval-when-compile
42 (require 'cl))
43(require 'org-id)
44(require 'org)
45
46(defgroup org-attach nil
47 "Options concerning entry attachments in Org-mode."
48 :tag "Org Attach"
49 :group 'org)
50
51(defcustom org-attach-directory "data/"
52 "The directory where attachments are stored.
53If this is a relative path, it will be interpreted relative to the directory
54where the Org file lives."
55 :group 'org-attach
56 :type 'direcory)
57
58(defcustom org-attach-auto-tag "ATTACH"
59 "Tag that will be triggered automatically when an entry has an attachment."
60 :group 'org-attach
61 :type '(choice
62 (const :tag "None" nil)
63 (string :tag "Tag")))
64
65(defcustom org-attach-file-list-property "Attachments"
66 "The property used to keep a list of attachment belonging to this entry.
67This is not really needed, so you may set this to nil if you don't want it."
68 :group 'org-attach
69 :type '(choice
70 (const :tag "None" nil)
71 (string :tag "Tag")))
72
73(defcustom org-attach-method 'cp
74 "The preferred method to attach a file.
75Allowed values are:
76
77mv rename the file to move it into the attachment directory
78cp copy the file
79ln create a hard link. Note that this is not supported
80 on all systems, and then the result is not defined."
81 :group 'org-attach
82 :type '(choice
83 (const :tag "Copy" cp)
84 (const :tag "Move/Rename" mv)
85 (const :tag "Link" ln)))
86
87(defcustom org-attach-expert nil
88 "Non-nil means do not show the splash buffer with the attach dispatcher."
89 :group 'org-attach
90 :type 'boolean)
91
92;;;###autoload
93(defun org-attach ()
94 "The dispatcher for attachment commands.
95Shows a list of commands and prompts for another key to execute a command."
96 (interactive)
97 (let (c marker)
98 (when (eq major-mode 'org-agenda-mode)
99 (setq marker (or (get-text-property (point) 'org-hd-marker)
100 (get-text-property (point) 'org-marker)))
101 (unless marker
102 (error "No task in current line")))
103 (save-excursion
104 (when marker
105 (set-buffer (marker-buffer marker))
106 (goto-char marker))
107 (org-back-to-heading t)
108 (save-excursion
109 (save-window-excursion
110 (unless org-attach-expert
111 (with-output-to-temp-buffer "*Org Attach*"
112 (princ "Select an Attachment Command:
113
114a Select a file and attach it to the task, using `org-attach-method'.
115c/m/l Attach a file using copy/move/link method.
116n Create a new attachment, as an Emacs buffer.
117z Synchronize the current task with its attachment
118 directory, in case you added attachments yourself.
119
120o Open current task's attachments.
121O Like \"o\", but force opening in Emacs.
122f Open current task's attachment directory.
123F Like \"f\", but force using dired in Emacs.
124
125d Delete one attachment, you will be prompted for a file name.
126D Delete all of a task's attachments. A safer way is
127 to open the directory in dired and delete from there.")))
128 (shrink-window-if-larger-than-buffer (get-buffer-window "*Org Attach*"))
129 (message "Select command: [acmlzoOfFdD]")
130 (setq c (read-char-exclusive))
131 (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*"))))
132 (cond
133 ((memq c '(?a ?\C-a)) (call-interactively 'org-attach-attach))
134 ((memq c '(?c ?\C-c))
135 (let ((org-attach-method 'cp)) (call-interactively 'org-attach-attach)))
136 ((memq c '(?m ?\C-m))
137 (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach)))
138 ((memq c '(?l ?\C-l))
139 (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
140 ((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new))
141 ((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync))
142 ((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open))
143 ((eq c ?O) (call-interactively 'org-attach-open-in-emacs))
144 ((memq c '(?f ?\C-f)) (call-interactively 'org-attach-reveal))
145 ((memq c '(?F)) (call-interactively 'org-attach-reveal-in-emacs))
146 ((memq c '(?d ?\C-d)) (call-interactively
147 'org-attach-delete-one))
148 ((eq c ?D) (call-interactively 'org-attach-delete-all))
149 ((eq c ?q) (message "Abort"))
150 (t (error "No such attachment command %c" c))))))
151
152(defun org-attach-dir (&optional create-if-not-exists-p)
153 "Return the directory associated with the current entry.
154If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil,
155the directory and the corresponding ID will be created."
156 (let ((uuid (org-id-get (point) create-if-not-exists-p)))
157 (when (or uuid create-if-not-exists-p)
158 (unless uuid
159 (let ((uuid-string (shell-command-to-string "uuidgen")))
160 (setf uuid-string
161 (substring uuid-string 0 (1- (length uuid-string))))
162 (org-entry-put (point) "ID" uuid-string)
163 (setf uuid uuid-string)))
164 (let ((attach-dir (expand-file-name
165 (format "%s/%s"
166 (substring uuid 0 2)
167 (substring uuid 2))
168 (expand-file-name org-attach-directory))))
169 (if (and create-if-not-exists-p
170 (not (file-directory-p attach-dir)))
171 (make-directory attach-dir t))
172 (and (file-exists-p attach-dir)
173 attach-dir)))))
174
175(defun org-attach-commit ()
176 "Commit changes to git if `org-attach-directory' is properly initialized.
177This checks for the existence of a \".git\" directory in that directory."
178 (let ((dir (expand-file-name org-attach-directory)))
179 (if (file-exists-p (expand-file-name ".git" dir))
180 (shell-command
181 (concat "(cd " dir "; "
182 " git add .; "
183 " git ls-files --deleted -z | xargs -0 git rm; "
184 " git commit -m 'Synchronized attachments')")))))
185
186(defun org-attach-tag (&optional off)
187 "Turn the autotag on or (if OFF is set) off."
188 (when org-attach-auto-tag
189 (save-excursion
190 (org-back-to-heading t)
191 (org-toggle-tag org-attach-auto-tag (if off 'off 'on)))))
192
193(defun org-attach-untag ()
194 "Turn the autotag off."
195 (org-attach-tag 'off))
196
197(defun org-attach-attach (file &optional visit-dir method)
198 "Move/copy/link FILE into the attachment directory of the current task.
199If VISIT-DIR is non-nil, visit the directory with dired.
200METHOD may be `cp', `mv', or `ln', default taken from `org-attach-method'."
201 (interactive "fFile to keep as an attachment: \nP")
202 (setq method (or method org-attach-method))
203 (let ((basename (file-name-nondirectory file)))
204 (when org-attach-file-list-property
205 (org-entry-add-to-multivalued-property
206 (point) org-attach-file-list-property basename))
207 (let* ((attach-dir (org-attach-dir t))
208 (fname (expand-file-name basename attach-dir)))
209 (cond
210 ((eq method 'mv) (rename-file file fname))
211 ((eq method 'cp) (copy-file file fname))
212 ((eq method 'ln) (add-name-to-file file fname)))
213 (org-attach-commit)
214 (org-attach-tag)
215 (if visit-dir
216 (dired attach-dir)
217 (message "File \"%s\" is now a task attachment." basename)))))
218
219(defun org-attach-attach-cp ()
220 "Attach a file by copying it."
221 (interactive)
222 (let ((org-attach-method 'cp)) (call-interactively 'org-attach-attach)))
223(defun org-attach-attach-mv ()
224 "Attach a file by moving (renaming) it."
225 (interactive)
226 (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach)))
227(defun org-attach-attach-ln ()
228 "Attach a file by creating a hard link to it.
229Beware that this does not work on systems that do not support hard links.
230On some systems, this apparently does copy the file instead."
231 (interactive)
232 (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
233
234(defun org-attach-new (file)
235 "Create a new attachment FILE for the current task.
236The attachment is created as an Emacs buffer."
237 (interactive "sCreate attachment named: ")
238 (when org-attach-file-list-property
239 (org-entry-add-to-multivalued-property
240 (point) org-attach-file-list-property file))
241 (let ((attach-dir (org-attach-dir t)))
242 (org-attach-tag)
243 (find-file (expand-file-name file attach-dir))
244 (message "New attachment %s" file)))
245
246(defun org-attach-delete-one (&optional file)
247 "Delete a single attachment."
248 (interactive)
249 (let* ((attach-dir (org-attach-dir t))
250 (files (org-attach-file-list attach-dir))
251 (file (or file
252 (completing-read
253 "Delete attachment: "
254 (mapcar (lambda (f)
255 (list (file-name-nondirectory f)))
256 files)))))
257 (setq file (expand-file-name file attach-dir))
258 (unless (file-exists-p file)
259 (error "No such attachment: %s" file))
260 (delete-file file)))
261
262(defun org-attach-delete-all (&optional force)
263 "Delete all attachments from the current task.
264This actually deletes the entire attachment directory.
265A safer way is to open the directory in dired and delete from there."
266 (interactive "P")
267 (when org-attach-file-list-property
268 (org-entry-delete (point) org-attach-file-list-property))
269 (let ((attach-dir (org-attach-dir)))
270 (when
271 (and attach-dir
272 (or force
273 (y-or-n-p "Are you sure you want to remove all attachments of this entry? ")))
274 (shell-command (format "rm -fr %s" attach-dir))
275 (message "Attachment directory removed")
276 (org-attach-commit)
277 (org-attach-untag))))
278
279(defun org-attach-sync ()
280 "Synchronize the current tasks with its attachments.
281This can be used after files have been added externally."
282 (interactive)
283 (org-attach-commit)
284 (when org-attach-file-list-property
285 (org-entry-delete (point) org-attach-file-list-property))
286 (let ((attach-dir (org-attach-dir)))
287 (when attach-dir
288 (let ((files (org-attach-file-list attach-dir)))
289 (and files (org-attach-tag))
290 (when org-attach-file-list-property
291 (dolist (file files)
292 (unless (string-match "^\\." file)
293 (org-entry-add-to-multivalued-property
294 (point) org-attach-file-list-property file))))))))
295
296(defun org-attach-file-list (dir)
297 "Return a list of files in the attachment directory.
298This ignores files starting with a \".\", and files ending in \"~\"."
299 (delq nil
300 (mapcar (lambda (x) (if (string-match "^\\." x) nil x))
301 (directory-files dir nil "[^~]\\'"))))
302
303(defun org-attach-reveal ()
304 "Show the attachment directory of the current task in dired."
305 (interactive)
306 (let ((attach-dir (org-attach-dir t)))
307 (org-open-file attach-dir)))
308
309(defun org-attach-reveal-in-emacs ()
310 "Show the attachment directory of the current task.
311This will attempt to use an external program to show the directory."
312 (interactive)
313 (let ((attach-dir (org-attach-dir t)))
314 (dired attach-dir)))
315
316(defun org-attach-open (&optional in-emacs)
317 "Open an attachment of the current task.
318If there are more than one attachment, you will be prompted for the file name.
319This command will open the file using the settings in `org-file-apps'
320and in the system-specific variants of this variable.
321If IN-EMACS is non-nil, force opening in Emacs."
322 (interactive "P")
323 (let* ((attach-dir (org-attach-dir t))
324 (files (org-attach-file-list attach-dir))
325 (file (if (= (length files) 1)
326 (car files)
327 (completing-read "Open attachment: "
328 (mapcar 'list files) nil t))))
329 (org-open-file (expand-file-name file attach-dir) in-emacs)))
330
331(defun org-attach-open-in-emacs ()
332 "Open attachment, force opening in Emacs.
333See `org-attach-open'."
334 (interactive)
335 (org-attach-open 'in-emacs))
336
337(provide 'org-attach)
338
339;;; org-attach.el ends here
diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el
new file mode 100644
index 00000000000..d5e7556d03a
--- /dev/null
+++ b/lisp/org/org-list.el
@@ -0,0 +1,1042 @@
1;;; org-list.el --- Plain lists for Org-mode
2;;
3;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
4;;
5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Bastien Guerry <bzg AT altern DOT org>
7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org
9;; Version: 6.09a
10;;
11;; This file is part of GNU Emacs.
12;;
13;; GNU Emacs is free software: you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26;;
27;;; Commentary:
28
29;; This file contains the code dealing with plain lists in Org-mode.
30
31;;; Code:
32
33(require 'org-macs)
34(require 'org-compat)
35
36(defvar org-blank-before-new-entry)
37(defvar org-M-RET-may-split-line)
38
39(declare-function org-invisible-p "org" ())
40(declare-function org-on-heading-p "org" (&optional invisible-ok))
41(declare-function outline-next-heading "org" ())
42(declare-function outline-back-to-heading "org" (&optional invisible-ok))
43(declare-function org-back-to-heading "org" (&optional invisible-ok))
44(declare-function org-back-over-empty-lines "org" ())
45(declare-function org-skip-whitespace "org" ())
46(declare-function org-trim "org" (s))
47(declare-function org-get-indentation "org" (&optional line))
48
49(defgroup org-plain-lists nil
50 "Options concerning plain lists in Org-mode."
51 :tag "Org Plain lists"
52 :group 'org-structure)
53
54(defcustom org-cycle-include-plain-lists nil
55 "Non-nil means, include plain lists into visibility cycling.
56This means that during cycling, plain list items will *temporarily* be
57interpreted as outline headlines with a level given by 1000+i where i is the
58indentation of the bullet. In all other operations, plain list items are
59not seen as headlines. For example, you cannot assign a TODO keyword to
60such an item."
61 :group 'org-plain-lists
62 :type 'boolean)
63
64(defcustom org-plain-list-ordered-item-terminator t
65 "The character that makes a line with leading number an ordered list item.
66Valid values are ?. and ?\). To get both terminators, use t. While
67?. may look nicer, it creates the danger that a line with leading
68number may be incorrectly interpreted as an item. ?\) therefore is
69the safe choice."
70 :group 'org-plain-lists
71 :type '(choice (const :tag "dot like in \"2.\"" ?.)
72 (const :tag "paren like in \"2)\"" ?\))
73 (const :tab "both" t)))
74
75(defcustom org-empty-line-terminates-plain-lists nil
76 "Non-nil means, an empty line ends all plain list levels.
77When nil, empty lines are part of the preceeding item."
78 :group 'org-plain-lists
79 :type 'boolean)
80
81(defcustom org-auto-renumber-ordered-lists t
82 "Non-nil means, automatically renumber ordered plain lists.
83Renumbering happens when the sequence have been changed with
84\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands,
85use \\[org-ctrl-c-ctrl-c] to trigger renumbering."
86 :group 'org-plain-lists
87 :type 'boolean)
88
89(defcustom org-provide-checkbox-statistics t
90 "Non-nil means, update checkbox statistics after insert and toggle.
91When this is set, checkbox statistics is updated each time you either insert
92a new checkbox with \\[org-insert-todo-heading] or toggle a checkbox
93with \\[org-ctrl-c-ctrl-c\\]."
94 :group 'org-plain-lists
95 :type 'boolean)
96
97(defcustom org-description-max-indent 20
98 "Maximum indentation for the second line of a description list.
99When the indentation would be larger than this, it will become
1005 characters instead."
101 :group 'org-plain-lists
102 :type 'integer)
103
104(defvar org-list-beginning-re
105 "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) +\\(.*\\)$")
106
107(defcustom org-list-radio-list-templates
108 '((latex-mode "% BEGIN RECEIVE ORGLST %n
109% END RECEIVE ORGLST %n
110\\begin{comment}
111#+ORGLST: SEND %n org-list-to-latex
112| | |
113\\end{comment}\n")
114 (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
115@c END RECEIVE ORGLST %n
116@ignore
117#+ORGLST: SEND %n org-list-to-texinfo
118| | |
119@end ignore\n")
120 (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
121<!-- END RECEIVE ORGLST %n -->
122<!--
123#+ORGLST: SEND %n org-list-to-html
124| | |
125-->\n"))
126 "Templates for radio lists in different major modes.
127All occurrences of %n in a template will be replaced with the name of the
128list, obtained by prompting the user."
129 :group 'org-plain-lists
130 :type '(repeat
131 (list (symbol :tag "Major mode")
132 (string :tag "Format"))))
133
134;;;; Plain list items, including checkboxes
135
136;;; Plain list items
137
138(defun org-at-item-p ()
139 "Is point in a line starting a hand-formatted item?"
140 (let ((llt org-plain-list-ordered-item-terminator))
141 (save-excursion
142 (goto-char (point-at-bol))
143 (looking-at
144 (cond
145 ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
146 ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
147 ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+))\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
148 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))))))
149
150(defun org-in-item-p ()
151 "It the cursor inside a plain list item.
152Does not have to be the first line."
153 (save-excursion
154 (condition-case nil
155 (progn
156 (org-beginning-of-item)
157 (org-at-item-p)
158 t)
159 (error nil))))
160
161(defun org-insert-item (&optional checkbox)
162 "Insert a new item at the current level.
163Return t when things worked, nil when we are not in an item."
164 (when (save-excursion
165 (condition-case nil
166 (progn
167 (org-beginning-of-item)
168 (org-at-item-p)
169 (if (org-invisible-p) (error "Invisible item"))
170 t)
171 (error nil)))
172 (let* ((bul (match-string 0))
173 (descp (save-excursion (goto-char (match-beginning 0))
174 (beginning-of-line 1)
175 (save-match-data
176 (looking-at "[ \t]*.*? ::"))))
177 (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")
178 (match-end 0)))
179 (blank (cdr (assq 'plain-list-item org-blank-before-new-entry)))
180 pos)
181 (if descp (setq checkbox nil))
182 (cond
183 ((and (org-at-item-p) (<= (point) eow))
184 ;; before the bullet
185 (beginning-of-line 1)
186 (open-line (if blank 2 1)))
187 ((<= (point) eow)
188 (beginning-of-line 1))
189 (t
190 (unless (org-get-alist-option org-M-RET-may-split-line 'item)
191 (end-of-line 1)
192 (delete-horizontal-space))
193 (newline (if blank 2 1))))
194 (insert bul
195 (if checkbox "[ ]" "")
196 (if descp (concat (if checkbox " " "")
197 (read-string "Term: ") " :: ") ""))
198 (just-one-space)
199 (setq pos (point))
200 (end-of-line 1)
201 (unless (= (point) pos) (just-one-space) (backward-delete-char 1)))
202 (org-maybe-renumber-ordered-list)
203 (and checkbox (org-update-checkbox-count-maybe))
204 t))
205
206;;; Checkboxes
207
208(defun org-at-item-checkbox-p ()
209 "Is point at a line starting a plain-list item with a checklet?"
210 (and (org-at-item-p)
211 (save-excursion
212 (goto-char (match-end 0))
213 (skip-chars-forward " \t")
214 (looking-at "\\[[- X]\\]"))))
215
216(defun org-toggle-checkbox (&optional arg)
217 "Toggle the checkbox in the current line."
218 (interactive "P")
219 (catch 'exit
220 (let (beg end status (firstnew 'unknown))
221 (cond
222 ((org-region-active-p)
223 (setq beg (region-beginning) end (region-end)))
224 ((org-on-heading-p)
225 (setq beg (point) end (save-excursion (outline-next-heading) (point))))
226 ((org-at-item-checkbox-p)
227 (let ((pos (point)))
228 (replace-match
229 (cond (arg "[-]")
230 ((member (match-string 0) '("[ ]" "[-]")) "[X]")
231 (t "[ ]"))
232 t t)
233 (goto-char pos))
234 (throw 'exit t))
235 (t (error "Not at a checkbox or heading, and no active region")))
236 (save-excursion
237 (goto-char beg)
238 (while (< (point) end)
239 (when (org-at-item-checkbox-p)
240 (setq status (equal (match-string 0) "[X]"))
241 (when (eq firstnew 'unknown)
242 (setq firstnew (not status)))
243 (replace-match
244 (if (if arg (not status) firstnew) "[X]" "[ ]") t t))
245 (beginning-of-line 2)))))
246 (org-update-checkbox-count-maybe))
247
248(defun org-update-checkbox-count-maybe ()
249 "Update checkbox statistics unless turned off by user."
250 (when org-provide-checkbox-statistics
251 (org-update-checkbox-count)))
252
253(defun org-update-checkbox-count (&optional all)
254 "Update the checkbox statistics in the current section.
255This will find all statistic cookies like [57%] and [6/12] and update them
256with the current numbers. With optional prefix argument ALL, do this for
257the whole buffer."
258 (interactive "P")
259 (save-excursion
260 (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
261 (beg (condition-case nil
262 (progn (outline-back-to-heading) (point))
263 (error (point-min))))
264 (end (move-marker (make-marker)
265 (progn (outline-next-heading) (point))))
266 (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
267 (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)")
268 (re-find (concat re "\\|" re-box))
269 beg-cookie end-cookie is-percent c-on c-off lim
270 eline curr-ind next-ind continue-from startsearch
271 (cstat 0)
272 )
273 (when all
274 (goto-char (point-min))
275 (outline-next-heading)
276 (setq beg (point) end (point-max)))
277 (goto-char end)
278 ;; find each statistic cookie
279 (while (re-search-backward re-find beg t)
280 (setq beg-cookie (match-beginning 1)
281 end-cookie (match-end 1)
282 cstat (+ cstat (if end-cookie 1 0))
283 startsearch (point-at-eol)
284 continue-from (point-at-bol)
285 is-percent (match-beginning 2)
286 lim (cond
287 ((org-on-heading-p) (outline-next-heading) (point))
288 ((org-at-item-p) (org-end-of-item) (point))
289 (t nil))
290 c-on 0
291 c-off 0)
292 (when lim
293 ;; find first checkbox for this cookie and gather
294 ;; statistics from all that are at this indentation level
295 (goto-char startsearch)
296 (if (re-search-forward re-box lim t)
297 (progn
298 (org-beginning-of-item)
299 (setq curr-ind (org-get-indentation))
300 (setq next-ind curr-ind)
301 (while (and (bolp) (org-at-item-p) (= curr-ind next-ind))
302 (save-excursion (end-of-line) (setq eline (point)))
303 (if (re-search-forward re-box eline t)
304 (if (member (match-string 2) '("[ ]" "[-]"))
305 (setq c-off (1+ c-off))
306 (setq c-on (1+ c-on))
307 )
308 )
309 (org-end-of-item)
310 (setq next-ind (org-get-indentation))
311 )))
312 (goto-char continue-from)
313 ;; update cookie
314 (when end-cookie
315 (delete-region beg-cookie end-cookie)
316 (goto-char beg-cookie)
317 (insert
318 (if is-percent
319 (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
320 (format "[%d/%d]" c-on (+ c-on c-off)))))
321 ;; update items checkbox if it has one
322 (when (org-at-item-p)
323 (org-beginning-of-item)
324 (when (and (> (+ c-on c-off) 0)
325 (re-search-forward re-box (point-at-eol) t))
326 (setq beg-cookie (match-beginning 2)
327 end-cookie (match-end 2))
328 (delete-region beg-cookie end-cookie)
329 (goto-char beg-cookie)
330 (cond ((= c-off 0) (insert "[X]"))
331 ((= c-on 0) (insert "[ ]"))
332 (t (insert "[-]")))
333 )))
334 (goto-char continue-from))
335 (when (interactive-p)
336 (message "Checkbox satistics updated %s (%d places)"
337 (if all "in entire file" "in current outline entry") cstat)))))
338
339(defun org-get-checkbox-statistics-face ()
340 "Select the face for checkbox statistics.
341The face will be `org-done' when all relevant boxes are checked. Otherwise
342it will be `org-todo'."
343 (if (match-end 1)
344 (if (equal (match-string 1) "100%") 'org-done 'org-todo)
345 (if (and (> (match-end 2) (match-beginning 2))
346 (equal (match-string 2) (match-string 3)))
347 'org-done
348 'org-todo)))
349
350(defun org-beginning-of-item ()
351 "Go to the beginning of the current hand-formatted item.
352If the cursor is not in an item, throw an error."
353 (interactive)
354 (let ((pos (point))
355 (limit (save-excursion
356 (condition-case nil
357 (progn
358 (org-back-to-heading)
359 (beginning-of-line 2) (point))
360 (error (point-min)))))
361 (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
362 ind ind1)
363 (if (org-at-item-p)
364 (beginning-of-line 1)
365 (beginning-of-line 1)
366 (skip-chars-forward " \t")
367 (setq ind (current-column))
368 (if (catch 'exit
369 (while t
370 (beginning-of-line 0)
371 (if (or (bobp) (< (point) limit)) (throw 'exit nil))
372
373 (if (looking-at "[ \t]*$")
374 (setq ind1 ind-empty)
375 (skip-chars-forward " \t")
376 (setq ind1 (current-column)))
377 (if (< ind1 ind)
378 (progn (beginning-of-line 1) (throw 'exit (org-at-item-p))))))
379 nil
380 (goto-char pos)
381 (error "Not in an item")))))
382
383(defun org-end-of-item ()
384 "Go to the end of the current hand-formatted item.
385If the cursor is not in an item, throw an error."
386 (interactive)
387 (let* ((pos (point))
388 ind1
389 (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
390 (limit (save-excursion (outline-next-heading) (point)))
391 (ind (save-excursion
392 (org-beginning-of-item)
393 (skip-chars-forward " \t")
394 (current-column)))
395 (end (catch 'exit
396 (while t
397 (beginning-of-line 2)
398 (if (eobp) (throw 'exit (point)))
399 (if (>= (point) limit) (throw 'exit (point-at-bol)))
400 (if (looking-at "[ \t]*$")
401 (setq ind1 ind-empty)
402 (skip-chars-forward " \t")
403 (setq ind1 (current-column)))
404 (if (<= ind1 ind)
405 (throw 'exit (point-at-bol)))))))
406 (if end
407 (goto-char end)
408 (goto-char pos)
409 (error "Not in an item"))))
410
411(defun org-next-item ()
412 "Move to the beginning of the next item in the current plain list.
413Error if not at a plain list, or if this is the last item in the list."
414 (interactive)
415 (let (ind ind1 (pos (point)))
416 (org-beginning-of-item)
417 (setq ind (org-get-indentation))
418 (org-end-of-item)
419 (setq ind1 (org-get-indentation))
420 (unless (and (org-at-item-p) (= ind ind1))
421 (goto-char pos)
422 (error "On last item"))))
423
424(defun org-previous-item ()
425 "Move to the beginning of the previous item in the current plain list.
426Error if not at a plain list, or if this is the first item in the list."
427 (interactive)
428 (let (beg ind ind1 (pos (point)))
429 (org-beginning-of-item)
430 (setq beg (point))
431 (setq ind (org-get-indentation))
432 (goto-char beg)
433 (catch 'exit
434 (while t
435 (beginning-of-line 0)
436 (if (looking-at "[ \t]*$")
437 nil
438 (if (<= (setq ind1 (org-get-indentation)) ind)
439 (throw 'exit t)))))
440 (condition-case nil
441 (if (or (not (org-at-item-p))
442 (< ind1 (1- ind)))
443 (error "")
444 (org-beginning-of-item))
445 (error (goto-char pos)
446 (error "On first item")))))
447
448(defun org-first-list-item-p ()
449 "Is this heading the item in a plain list?"
450 (unless (org-at-item-p)
451 (error "Not at a plain list item"))
452 (org-beginning-of-item)
453 (= (point) (save-excursion (org-beginning-of-item-list))))
454
455(defun org-move-item-down ()
456 "Move the plain list item at point down, i.e. swap with following item.
457Subitems (items with larger indentation) are considered part of the item,
458so this really moves item trees."
459 (interactive)
460 (let ((col (current-column))
461 (pos (point))
462 beg beg0 end end0 ind ind1 txt ne-end ne-beg)
463 (org-beginning-of-item)
464 (setq beg0 (point))
465 (save-excursion
466 (setq ne-beg (org-back-over-empty-lines))
467 (setq beg (point)))
468 (goto-char beg0)
469 (setq ind (org-get-indentation))
470 (org-end-of-item)
471 (setq end0 (point))
472 (setq ind1 (org-get-indentation))
473 (setq ne-end (org-back-over-empty-lines))
474 (setq end (point))
475 (goto-char beg0)
476 (when (and (org-first-list-item-p) (< ne-end ne-beg))
477 ;; include less whitespace
478 (save-excursion
479 (goto-char beg)
480 (forward-line (- ne-beg ne-end))
481 (setq beg (point))))
482 (goto-char end0)
483 (if (and (org-at-item-p) (= ind ind1))
484 (progn
485 (org-end-of-item)
486 (org-back-over-empty-lines)
487 (setq txt (buffer-substring beg end))
488 (save-excursion
489 (delete-region beg end))
490 (setq pos (point))
491 (insert txt)
492 (goto-char pos) (org-skip-whitespace)
493 (org-maybe-renumber-ordered-list)
494 (move-to-column col))
495 (goto-char pos)
496 (move-to-column col)
497 (error "Cannot move this item further down"))))
498
499(defun org-move-item-up (arg)
500 "Move the plain list item at point up, i.e. swap with previous item.
501Subitems (items with larger indentation) are considered part of the item,
502so this really moves item trees."
503 (interactive "p")
504 (let ((col (current-column)) (pos (point))
505 beg beg0 end ind ind1 txt
506 ne-beg ne-ins ins-end)
507 (org-beginning-of-item)
508 (setq beg0 (point))
509 (setq ind (org-get-indentation))
510 (save-excursion
511 (setq ne-beg (org-back-over-empty-lines))
512 (setq beg (point)))
513 (goto-char beg0)
514 (org-end-of-item)
515 (org-back-over-empty-lines)
516 (setq end (point))
517 (goto-char beg0)
518 (catch 'exit
519 (while t
520 (beginning-of-line 0)
521 (if (looking-at "[ \t]*$")
522 (if org-empty-line-terminates-plain-lists
523 (progn
524 (goto-char pos)
525 (error "Cannot move this item further up"))
526 nil)
527 (if (<= (setq ind1 (org-get-indentation)) ind)
528 (throw 'exit t)))))
529 (condition-case nil
530 (org-beginning-of-item)
531 (error (goto-char beg0)
532 (move-to-column col)
533 (error "Cannot move this item further up")))
534 (setq ind1 (org-get-indentation))
535 (if (and (org-at-item-p) (= ind ind1))
536 (progn
537 (setq ne-ins (org-back-over-empty-lines))
538 (setq txt (buffer-substring beg end))
539 (save-excursion
540 (delete-region beg end))
541 (setq pos (point))
542 (insert txt)
543 (setq ins-end (point))
544 (goto-char pos) (org-skip-whitespace)
545
546 (when (and (org-first-list-item-p) (> ne-ins ne-beg))
547 ;; Move whitespace back to beginning
548 (save-excursion
549 (goto-char ins-end)
550 (let ((kill-whole-line t))
551 (kill-line (- ne-ins ne-beg)) (point)))
552 (insert (make-string (- ne-ins ne-beg) ?\n)))
553
554 (org-maybe-renumber-ordered-list)
555 (move-to-column col))
556 (goto-char pos)
557 (move-to-column col)
558 (error "Cannot move this item further up"))))
559
560(defun org-maybe-renumber-ordered-list ()
561 "Renumber the ordered list at point if setup allows it.
562This tests the user option `org-auto-renumber-ordered-lists' before
563doing the renumbering."
564 (interactive)
565 (when (and org-auto-renumber-ordered-lists
566 (org-at-item-p))
567 (if (match-beginning 3)
568 (org-renumber-ordered-list 1)
569 (org-fix-bullet-type))))
570
571(defun org-maybe-renumber-ordered-list-safe ()
572 (condition-case nil
573 (save-excursion
574 (org-maybe-renumber-ordered-list))
575 (error nil)))
576
577(defun org-cycle-list-bullet (&optional which)
578 "Cycle through the different itemize/enumerate bullets.
579This cycle the entire list level through the sequence:
580
581 `-' -> `+' -> `*' -> `1.' -> `1)'
582
583If WHICH is a string, use that as the new bullet. If WHICH is an integer,
5840 meand `-', 1 means `+' etc."
585 (interactive "P")
586 (org-preserve-lc
587 (org-beginning-of-item-list)
588 (org-at-item-p)
589 (beginning-of-line 1)
590 (let ((current (match-string 0))
591 (prevp (eq which 'previous))
592 new)
593 (setq new (cond
594 ((and (numberp which)
595 (nth (1- which) '("-" "+" "*" "1." "1)"))))
596 ((string-match "-" current) (if prevp "1)" "+"))
597 ((string-match "\\+" current)
598 (if prevp "-" (if (looking-at "\\S-") "1." "*")))
599 ((string-match "\\*" current) (if prevp "+" "1."))
600 ((string-match "\\." current) (if prevp "*" "1)"))
601 ((string-match ")" current) (if prevp "1." "-"))
602 (t (error "This should not happen"))))
603 (and (looking-at "\\([ \t]*\\)\\S-+") (replace-match (concat "\\1" new)))
604 (org-fix-bullet-type)
605 (org-maybe-renumber-ordered-list))))
606
607(defun org-get-string-indentation (s)
608 "What indentation has S due to SPACE and TAB at the beginning of the string?"
609 (let ((n -1) (i 0) (w tab-width) c)
610 (catch 'exit
611 (while (< (setq n (1+ n)) (length s))
612 (setq c (aref s n))
613 (cond ((= c ?\ ) (setq i (1+ i)))
614 ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
615 (t (throw 'exit t)))))
616 i))
617
618(defun org-renumber-ordered-list (arg)
619 "Renumber an ordered plain list.
620Cursor needs to be in the first line of an item, the line that starts
621with something like \"1.\" or \"2)\"."
622 (interactive "p")
623 (unless (and (org-at-item-p)
624 (match-beginning 3))
625 (error "This is not an ordered list"))
626 (let ((line (org-current-line))
627 (col (current-column))
628 (ind (org-get-string-indentation
629 (buffer-substring (point-at-bol) (match-beginning 3))))
630 ;; (term (substring (match-string 3) -1))
631 ind1 (n (1- arg))
632 fmt bobp)
633 ;; find where this list begins
634 (org-beginning-of-item-list)
635 (setq bobp (bobp))
636 (looking-at "[ \t]*[0-9]+\\([.)]\\)")
637 (setq fmt (concat "%d" (match-string 1)))
638 (beginning-of-line 0)
639 ;; walk forward and replace these numbers
640 (catch 'exit
641 (while t
642 (catch 'next
643 (if bobp (setq bobp nil) (beginning-of-line 2))
644 (if (eobp) (throw 'exit nil))
645 (if (looking-at "[ \t]*$") (throw 'next nil))
646 (skip-chars-forward " \t") (setq ind1 (current-column))
647 (if (> ind1 ind) (throw 'next t))
648 (if (< ind1 ind) (throw 'exit t))
649 (if (not (org-at-item-p)) (throw 'exit nil))
650 (delete-region (match-beginning 2) (match-end 2))
651 (goto-char (match-beginning 2))
652 (insert (format fmt (setq n (1+ n)))))))
653 (goto-line line)
654 (org-move-to-column col)))
655
656(defun org-fix-bullet-type ()
657 "Make sure all items in this list have the same bullet as the firsst item."
658 (interactive)
659 (unless (org-at-item-p) (error "This is not a list"))
660 (let ((line (org-current-line))
661 (col (current-column))
662 (ind (current-indentation))
663 ind1 bullet)
664 ;; find where this list begins
665 (org-beginning-of-item-list)
666 (beginning-of-line 1)
667 ;; find out what the bullet type is
668 (looking-at "[ \t]*\\(\\S-+\\)")
669 (setq bullet (match-string 1))
670 ;; walk forward and replace these numbers
671 (beginning-of-line 0)
672 (catch 'exit
673 (while t
674 (catch 'next
675 (beginning-of-line 2)
676 (if (eobp) (throw 'exit nil))
677 (if (looking-at "[ \t]*$") (throw 'next nil))
678 (skip-chars-forward " \t") (setq ind1 (current-column))
679 (if (> ind1 ind) (throw 'next t))
680 (if (< ind1 ind) (throw 'exit t))
681 (if (not (org-at-item-p)) (throw 'exit nil))
682 (skip-chars-forward " \t")
683 (looking-at "\\S-+")
684 (replace-match bullet))))
685 (goto-line line)
686 (org-move-to-column col)
687 (if (string-match "[0-9]" bullet)
688 (org-renumber-ordered-list 1))))
689
690(defun org-beginning-of-item-list ()
691 "Go to the beginning of the current item list.
692I.e. to the first item in this list."
693 (interactive)
694 (org-beginning-of-item)
695 (let ((pos (point-at-bol))
696 (ind (org-get-indentation))
697 ind1)
698 ;; find where this list begins
699 (catch 'exit
700 (while t
701 (catch 'next
702 (beginning-of-line 0)
703 (if (looking-at "[ \t]*$")
704 (throw (if (bobp) 'exit 'next) t))
705 (skip-chars-forward " \t") (setq ind1 (current-column))
706 (if (or (< ind1 ind)
707 (and (= ind1 ind)
708 (not (org-at-item-p)))
709 (and (= (point-at-bol) (point-min))
710 (setq pos (point-min))))
711 (throw 'exit t)
712 (when (org-at-item-p) (setq pos (point-at-bol)))))))
713 (goto-char pos)))
714
715
716(defun org-end-of-item-list ()
717 "Go to the end of the current item list.
718I.e. to the text after the last item."
719 (interactive)
720 (org-beginning-of-item)
721 (let ((pos (point-at-bol))
722 (ind (org-get-indentation))
723 ind1)
724 ;; find where this list begins
725 (catch 'exit
726 (while t
727 (catch 'next
728 (beginning-of-line 2)
729 (if (looking-at "[ \t]*$")
730 (throw (if (eobp) 'exit 'next) t))
731 (skip-chars-forward " \t") (setq ind1 (current-column))
732 (if (or (< ind1 ind)
733 (and (= ind1 ind)
734 (not (org-at-item-p)))
735 (eobp))
736 (progn
737 (setq pos (point-at-bol))
738 (throw 'exit t))))))
739 (goto-char pos)))
740
741
742(defvar org-last-indent-begin-marker (make-marker))
743(defvar org-last-indent-end-marker (make-marker))
744
745(defun org-outdent-item (arg)
746 "Outdent a local list item."
747 (interactive "p")
748 (org-indent-item (- arg)))
749
750(defun org-indent-item (arg)
751 "Indent a local list item."
752 (interactive "p")
753 (unless (org-at-item-p)
754 (error "Not on an item"))
755 (save-excursion
756 (let (beg end ind ind1 tmp delta ind-down ind-up)
757 (if (memq last-command '(org-shiftmetaright org-shiftmetaleft))
758 (setq beg org-last-indent-begin-marker
759 end org-last-indent-end-marker)
760 (org-beginning-of-item)
761 (setq beg (move-marker org-last-indent-begin-marker (point)))
762 (org-end-of-item)
763 (setq end (move-marker org-last-indent-end-marker (point))))
764 (goto-char beg)
765 (setq tmp (org-item-indent-positions)
766 ind (car tmp)
767 ind-down (nth 2 tmp)
768 ind-up (nth 1 tmp)
769 delta (if (> arg 0)
770 (if ind-down (- ind-down ind) 2)
771 (if ind-up (- ind-up ind) -2)))
772 (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin"))
773 (while (< (point) end)
774 (beginning-of-line 1)
775 (skip-chars-forward " \t") (setq ind1 (current-column))
776 (delete-region (point-at-bol) (point))
777 (or (eolp) (org-indent-to-column (+ ind1 delta)))
778 (beginning-of-line 2))))
779 (org-fix-bullet-type)
780 (org-maybe-renumber-ordered-list-safe)
781 (save-excursion
782 (beginning-of-line 0)
783 (condition-case nil (org-beginning-of-item) (error nil))
784 (org-maybe-renumber-ordered-list-safe)))
785
786(defun org-item-indent-positions ()
787 "Return indentation for plain list items.
788This returns a list with three values: The current indentation, the
789parent indentation and the indentation a child should habe.
790Assumes cursor in item line."
791 (let* ((bolpos (point-at-bol))
792 (ind (org-get-indentation))
793 ind-down ind-up pos)
794 (save-excursion
795 (org-beginning-of-item-list)
796 (skip-chars-backward "\n\r \t")
797 (when (org-in-item-p)
798 (org-beginning-of-item)
799 (setq ind-up (org-get-indentation))))
800 (setq pos (point))
801 (save-excursion
802 (cond
803 ((and (condition-case nil (progn (org-previous-item) t)
804 (error nil))
805 (or (forward-char 1) t)
806 (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t))
807 (setq ind-down (org-get-indentation)))
808 ((and (goto-char pos)
809 (org-at-item-p))
810 (goto-char (match-end 0))
811 (skip-chars-forward " \t")
812 (setq ind-down (current-column)))))
813 (list ind ind-up ind-down)))
814
815
816;;; Send and receive lists
817
818(defun org-list-parse-list (&optional delete)
819 "Parse the list at point and maybe DELETE it.
820Return a list containing first level items as strings and
821sublevels as a list of strings."
822 (let* ((item-beginning (org-list-item-beginning))
823 (start (car item-beginning))
824 (end (org-list-end (cdr item-beginning)))
825 output itemsep ltype)
826 (while (re-search-forward org-list-beginning-re end t)
827 (goto-char (match-beginning 3))
828 (save-match-data
829 (cond ((string-match "[0-9]" (match-string 2))
830 (setq itemsep "[0-9]+\\(?:\\.\\|)\\)"
831 ltype 'ordered))
832 ((string-match "^.*::" (match-string 0))
833 (setq itemsep "[-+]" ltype 'descriptive))
834 (t (setq itemsep "[-+]" ltype 'unordered))))
835 (let* ((indent1 (match-string 1))
836 (nextitem (save-excursion
837 (save-match-data
838 (or (and (re-search-forward
839 (concat "^" indent1 itemsep " *?") end t)
840 (match-beginning 0)) end))))
841 (item (buffer-substring
842 (point)
843 (or (and (re-search-forward
844 org-list-beginning-re end t)
845 (goto-char (match-beginning 0)))
846 (goto-char end))))
847 (nextindent (match-string 1))
848 (item (org-trim item))
849 (item (if (string-match "^\\[.+\\]" item)
850 (replace-match "\\\\texttt{\\&}"
851 t nil item) item)))
852 (push item output)
853 (when (> (length nextindent)
854 (length indent1))
855 (narrow-to-region (point) nextitem)
856 (push (org-list-parse-list) output)
857 (widen))))
858 (when delete (delete-region start end))
859 (setq output (nreverse output))
860 (push ltype output)))
861
862(defun org-list-item-beginning ()
863 "Find the beginning of the list item.
864Return a cons which car is the beginning position of the item and
865cdr is the indentation string."
866 (save-excursion
867 (if (not (or (looking-at org-list-beginning-re)
868 (re-search-backward
869 org-list-beginning-re nil t)))
870 (progn (goto-char (point-min)) (point))
871 (cons (match-beginning 0) (match-string 1)))))
872
873(defun org-list-end (indent)
874 "Return the position of the end of the list.
875INDENT is the indentation of the list."
876 (save-excursion
877 (catch 'exit
878 (while (or (looking-at org-list-beginning-re)
879 (looking-at (concat "^" indent "[ \t]+\\|^$")))
880 (if (eq (point) (point-max))
881 (throw 'exit (point-max)))
882 (forward-line 1))) (point)))
883
884(defun org-list-insert-radio-list ()
885 "Insert a radio list template appropriate for this major mode."
886 (interactive)
887 (let* ((e (assq major-mode org-list-radio-list-templates))
888 (txt (nth 1 e))
889 name pos)
890 (unless e (error "No radio list setup defined for %s" major-mode))
891 (setq name (read-string "List name: "))
892 (while (string-match "%n" txt)
893 (setq txt (replace-match name t t txt)))
894 (or (bolp) (insert "\n"))
895 (setq pos (point))
896 (insert txt)
897 (goto-char pos)))
898
899(defun org-list-send-list (&optional maybe)
900 "Send a tranformed version of this list to the receiver position.
901With argument MAYBE, fail quietly if no transformation is defined for
902this list."
903 (interactive)
904 (catch 'exit
905 (unless (org-at-item-p) (error "Not at a list"))
906 (save-excursion
907 (goto-char (car (org-list-item-beginning)))
908 (beginning-of-line 0)
909 (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?")
910 (if maybe
911 (throw 'exit nil)
912 (error "Don't know how to transform this list"))))
913 (let* ((name (match-string 1))
914 (item-beginning (org-list-item-beginning))
915 (transform (intern (match-string 2)))
916 (txt (buffer-substring-no-properties
917 (car item-beginning)
918 (org-list-end (cdr item-beginning))))
919 (list (org-list-parse-list))
920 beg)
921 (unless (fboundp transform)
922 (error "No such transformation function %s" transform))
923 (setq txt (funcall transform list))
924 ;; Find the insertion place
925 (save-excursion
926 (goto-char (point-min))
927 (unless (re-search-forward
928 (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t)
929 (error "Don't know where to insert translated list"))
930 (goto-char (match-beginning 0))
931 (beginning-of-line 2)
932 (setq beg (point))
933 (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
934 (error "Cannot find end of insertion region"))
935 (beginning-of-line 1)
936 (delete-region beg (point))
937 (goto-char beg)
938 (insert txt "\n"))
939 (message "List converted and installed at receiver location"))))
940
941(defun org-list-to-generic (list params)
942 "Convert a LIST parsed through `org-list-parse-list' to other formats.
943
944Valid parameters PARAMS are
945
946:ustart String to start an unordered list
947:uend String to end an unordered list
948
949:ostart String to start an ordered list
950:oend String to end an ordered list
951
952:dstart String to start a descriptive list
953:dend String to end a descriptive list
954:dtstart String to start a descriptive term
955:dtend String to end a descriptive term
956:ddstart String to start a description
957:ddend String to end a description
958
959:splice When set to t, return only list body lines, don't wrap
960 them into :[u/o]start and :[u/o]end. Default is nil.
961
962:istart String to start a list item
963:iend String to end a list item
964:isep String to separate items
965:lsep String to separate sublists"
966 (interactive)
967 (let* ((p params) sublist
968 (splicep (plist-get p :splice))
969 (ostart (plist-get p :ostart))
970 (oend (plist-get p :oend))
971 (ustart (plist-get p :ustart))
972 (uend (plist-get p :uend))
973 (dstart (plist-get p :dstart))
974 (dend (plist-get p :dend))
975 (dtstart (plist-get p :dtstart))
976 (dtend (plist-get p :dtend))
977 (ddstart (plist-get p :ddstart))
978 (ddend (plist-get p :ddend))
979 (istart (plist-get p :istart))
980 (iend (plist-get p :iend))
981 (isep (plist-get p :isep))
982 (lsep (plist-get p :lsep)))
983 (let ((wrapper
984 (cond ((eq (car list) 'ordered)
985 (concat ostart "\n%s" oend "\n"))
986 ((eq (car list) 'unordered)
987 (concat ustart "\n%s" uend "\n"))
988 ((eq (car list) 'descriptive)
989 (concat dstart "\n%s" dend "\n"))))
990 rtn term defstart defend)
991 (while (setq sublist (pop list))
992 (cond ((symbolp sublist) nil)
993 ((stringp sublist)
994 (when (string-match "^\\(.*\\) ::" sublist)
995 (setq term (org-trim (format (concat dtstart "%s" dtend)
996 (match-string 1 sublist))))
997 (setq sublist (substring sublist (1+ (length term)))))
998 (setq rtn (concat rtn istart term ddstart
999 sublist ddend iend isep)))
1000 (t (setq rtn (concat rtn ;; previous list
1001 lsep ;; list separator
1002 (org-list-to-generic sublist p)
1003 lsep ;; list separator
1004 )))))
1005 (format wrapper rtn))))
1006
1007(defun org-list-to-latex (list)
1008 "Convert LIST into a LaTeX list."
1009 (org-list-to-generic
1010 list '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
1011 :ustart "\\begin{itemize}" :uend "\\end{itemize}"
1012 :dstart "\\begin{description}" :dend "\\end{description}"
1013 :dtstart "[" :dtend "]"
1014 :ddstart "" :ddend ""
1015 :istart "\\item " :iend ""
1016 :isep "\n" :lsep "\n")))
1017
1018(defun org-list-to-html (list)
1019 "Convert LIST into a HTML list."
1020 (org-list-to-generic
1021 list '(:splicep nil :ostart "<ol>" :oend "</ol>"
1022 :ustart "<ul>" :uend "</ul>"
1023 :dstart "<dl>" :dend "</dl>"
1024 :dtstart "<dt>" :dtend "</dt>"
1025 :ddstart "<dd>" :ddend "</dd>"
1026 :istart "<li>" :iend "</li>"
1027 :isep "\n" :lsep "\n")))
1028
1029(defun org-list-to-texinfo (list)
1030 "Convert LIST into a Texinfo list."
1031 (org-list-to-generic
1032 list '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
1033 :ustart "@enumerate" :uend "@end enumerate"
1034 :dstart "@table" :dend "@end table"
1035 :dtstart "@item " :dtend "\n"
1036 :ddstart "" :ddend ""
1037 :istart "@item\n" :iend ""
1038 :isep "\n" :lsep "\n")))
1039
1040(provide 'org-list)
1041
1042;;; org-list.el ends here
diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el
new file mode 100644
index 00000000000..f8e268de8da
--- /dev/null
+++ b/lisp/org/org-plot.el
@@ -0,0 +1,314 @@
1;;; org-plot.el --- Support for plotting from Org-mode
2
3;; Copyright (C) 2008 Free Software Foundation, Inc.
4;;
5;; Author: Eric Schulte <schulte dot eric at gmail dot com>
6;; Keywords: tables, plotting
7;; Homepage: http://orgmode.org
8;; Version: 6.06b
9;;
10;; This file is part of GNU Emacs.
11;;
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; Borrows ideas and a couple of lines of code from org-exp.el.
28
29;; Thanks to the org-mode mailing list for testing and implementation
30;; and feature suggestions
31
32;;; Code:
33(require 'org)
34(require 'org-exp)
35(require 'org-table)
36(eval-and-compile
37 (require 'cl))
38
39(declare-function gnuplot-delchar-or-maybe-eof "ext:gnuplot" (arg))
40(declare-function gnuplot-mode "ext:gnuplot" ())
41(declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot" ())
42
43(defvar org-plot/gnuplot-default-options
44 '((:plot-type . 2d)
45 (:with . lines)
46 (:ind . 0))
47 "Default options to gnuplot used by `org-plot/gnuplot'")
48
49(defun org-plot/add-options-to-plist (p options)
50 "Parse an OPTIONS line and set values in the property list P.
51Returns the resulting property list."
52 (let (o)
53 (when options
54 (let ((op '(("type" . :plot-type)
55 ("script" . :script)
56 ("line" . :line)
57 ("set" . :set)
58 ("title" . :title)
59 ("ind" . :ind)
60 ("deps" . :deps)
61 ("with" . :with)
62 ("file" . :file)
63 ("labels" . :labels)
64 ("map" . :map)))
65 (multiples '("set" "line"))
66 (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)")
67 (start 0)
68 o)
69 (while (setq o (pop op))
70 (if (member (car o) multiples) ;; keys with multiple values
71 (while (string-match
72 (concat (regexp-quote (car o)) regexp)
73 options start)
74 (setq start (match-end 0))
75 (setq p (plist-put p (cdr o)
76 (cons (car (read-from-string
77 (match-string 1 options)))
78 (plist-get p (cdr o)))))
79 p)
80 (if (string-match (concat (regexp-quote (car o)) regexp)
81 options)
82 (setq p (plist-put p (cdr o)
83 (car (read-from-string
84 (match-string 1 options)))))))))))
85 p)
86
87(defun org-plot/goto-nearest-table ()
88 "Move the point forward to the beginning of nearest table.
89Return value is the point at the beginning of the table."
90 (interactive) (move-beginning-of-line 1)
91 (while (not (or (org-at-table-p) (< 0 (forward-line 1)))))
92 (goto-char (org-table-begin)))
93
94(defun org-plot/collect-options (&optional params)
95 "Collect options from an org-plot '#+Plot:' line.
96Accepts an optional property list PARAMS, to which the options
97will be added. Returns the resulting property list."
98 (interactive)
99 (let ((line (thing-at-point 'line)))
100 (if (string-match "#\\+PLOT: +\\(.*\\)$" line)
101 (org-plot/add-options-to-plist params (match-string 1 line))
102 params)))
103
104(defun org-plot-quote-tsv-field (s)
105 "Quote field S for export to gnuplot."
106 (if (string-match org-table-number-regexp s) s
107 (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")))
108
109(defun org-plot/gnuplot-to-data (table data-file params)
110 "Export TABLE to DATA-FILE in a format readable by gnuplot.
111Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
112 (with-temp-file
113 data-file (insert (orgtbl-to-generic
114 table
115 (org-combine-plists
116 '(:sep "\t" :fmt org-plot-quote-tsv-field)
117 params))))
118 nil)
119
120(defun org-plot/gnuplot-to-grid-data (table data-file params)
121 "Export the data in TABLE to DATA-FILE for gnuplot.
122This means, in a format appropriate for grid plotting by gnuplot.
123PARAMS specifies which columns of TABLE should be plotted as independant
124and dependant variables."
125 (interactive)
126 (let* ((ind (- (plist-get params :ind) 1))
127 (deps (if (plist-member params :deps)
128 (mapcar (lambda (val) (- val 1)) (plist-get params :deps))
129 (let (collector)
130 (dotimes (col (length (first table)))
131 (setf collector (cons col collector)))
132 collector)))
133 row-vals (counter 0))
134 (when (>= ind 0) ;; collect values of ind col
135 (setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter))
136 (cons counter (nth ind row))) table)))
137 (when (or deps (>= ind 0)) ;; remove non-plotting columns
138 (setf deps (delq ind deps))
139 (setf table (mapcar (lambda (row)
140 (dotimes (col (length row))
141 (unless (memq col deps)
142 (setf (nth col row) nil)))
143 (delq nil row))
144 table)))
145 ;; write table to gnuplot grid datafile format
146 (with-temp-file data-file
147 (let ((num-rows (length table)) (num-cols (length (first table)))
148 front-edge back-edge)
149 (flet ((gnuplot-row (col row value)
150 (setf col (+ 1 col)) (setf row (+ 1 row))
151 (format "%f %f %f\n%f %f %f\n"
152 col (- row 0.5) value ;; lower edge
153 col (+ row 0.5) value))) ;; upper edge
154 (dotimes (col num-cols)
155 (dotimes (row num-rows)
156 (setf back-edge
157 (concat back-edge
158 (gnuplot-row (- col 1) row (string-to-number
159 (nth col (nth row table))))))
160 (setf front-edge
161 (concat front-edge
162 (gnuplot-row col row (string-to-number
163 (nth col (nth row table)))))))
164 ;; only insert once per row
165 (insert back-edge) (insert "\n") ;; back edge
166 (insert front-edge) (insert "\n") ;; front edge
167 (setf back-edge "") (setf front-edge "")))))
168 row-vals))
169
170(defun org-plot/gnuplot-script (data-file num-cols params)
171 "Write a gnuplot script to DATA-FILE respecting the options set in PARAMS.
172NUM-COLS controls the number of columns plotted in a 2-d plot."
173 (let* ((type (plist-get params :plot-type))
174 (with (if (equal type 'grid)
175 'pm3d
176 (plist-get params :with)))
177 (sets (plist-get params :set))
178 (lines (plist-get params :line))
179 (map (plist-get params :map))
180 (title (plist-get params :title))
181 (file (plist-get params :file))
182 (ind (plist-get params :ind))
183 (text-ind (plist-get params :textind))
184 (deps (if (plist-member params :deps) (plist-get params :deps)))
185 (col-labels (plist-get params :labels))
186 (x-labels (plist-get params :xlabels))
187 (y-labels (plist-get params :ylabels))
188 (plot-str "'%s' using %s%d%s with %s title '%s'")
189 (plot-cmd (case type
190 ('2d "plot")
191 ('3d "splot")
192 ('grid "splot")))
193 (script "reset") plot-lines)
194 (flet ((add-to-script (line) (setf script (format "%s\n%s" script line))))
195 (when file ;; output file
196 (add-to-script (format "set term %s" (file-name-extension file)))
197 (add-to-script (format "set output '%s'" file)))
198 (case type ;; type
199 ('2d ())
200 ('3d (if map (add-to-script "set map")))
201 ('grid (if map
202 (add-to-script "set pm3d map")
203 (add-to-script "set pm3d"))))
204 (when title (add-to-script (format "set title '%s'" title))) ;; title
205 (when lines (mapc (lambda (el) (add-to-script el)) lines)) ;; line
206 (when sets ;; set
207 (mapc (lambda (el) (add-to-script (format "set %s" el))) sets))
208 (when x-labels ;; x labels (xtics)
209 (add-to-script
210 (format "set xtics (%s)"
211 (mapconcat (lambda (pair)
212 (format "\"%s\" %d" (cdr pair) (car pair)))
213 x-labels ", "))))
214 (when y-labels ;; y labels (ytics)
215 (add-to-script
216 (format "set ytics (%s)"
217 (mapconcat (lambda (pair)
218 (format "\"%s\" %d" (cdr pair) (car pair)))
219 y-labels ", "))))
220 (case type ;; plot command
221 ('2d (dotimes (col num-cols)
222 (unless (and (equal type '2d)
223 (or (and ind (equal (+ 1 col) ind))
224 (and deps (not (member (+ 1 col) deps)))))
225 (setf plot-lines
226 (cons
227 (format plot-str data-file
228 (or (and (not text-ind) ind
229 (> ind 0) (format "%d:" ind)) "")
230 (+ 1 col)
231 (if text-ind (format ":xticlabel(%d)" ind) "")
232 with
233 (or (nth col col-labels) (format "%d" (+ 1 col))))
234 plot-lines)))))
235 ('3d
236 (setq plot-lines (list (format "'%s' matrix with %s title ''"
237 data-file with))))
238 ('grid
239 (setq plot-lines (list (format "'%s' with %s title ''"
240 data-file with)))))
241 (add-to-script
242 (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n ")))
243 script)))
244
245;;-----------------------------------------------------------------------------
246;; facade functions
247;;;###autoload
248(defun org-plot/gnuplot (&optional params)
249 "Plot table using gnuplot. Gnuplot options can be specified with PARAMS.
250If not given options will be taken from the +PLOT
251line directly before or after the table."
252 (interactive)
253 (require 'gnuplot)
254 (save-window-excursion
255 (delete-other-windows)
256 (when (get-buffer "*gnuplot*") ;; reset *gnuplot* if it already running
257 (save-excursion
258 (set-buffer "*gnuplot*") (goto-char (point-max))
259 (gnuplot-delchar-or-maybe-eof nil)))
260 (org-plot/goto-nearest-table)
261 ;; set default options
262 (mapc
263 (lambda (pair)
264 (unless (plist-member params (car pair))
265 (setf params (plist-put params (car pair) (cdr pair)))))
266 org-plot/gnuplot-default-options)
267 ;; collect table and table information
268 (let* ((data-file (make-temp-file "org-plot"))
269 (table (org-table-to-lisp))
270 (num-cols (length (if (eq (first table) 'hline) (second table)
271 (first table)))))
272 (while (equal 'hline (first table)) (setf table (cdr table)))
273 (when (equal (second table) 'hline)
274 (setf params (plist-put params :labels (first table))) ;; headers to labels
275 (setf table (delq 'hline (cdr table)))) ;; clean non-data from table
276 ;; collect options
277 (save-excursion (while (and (equal 0 (forward-line -1))
278 (looking-at "#\\+"))
279 (setf params (org-plot/collect-options params))))
280 ;; dump table to datafile (very different for grid)
281 (case (plist-get params :plot-type)
282 ('2d (org-plot/gnuplot-to-data table data-file params))
283 ('3d (org-plot/gnuplot-to-data table data-file params))
284 ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data
285 table data-file params)))
286 (when y-labels (plist-put params :ylabels y-labels)))))
287 ;; check for text ind column
288 (let ((ind (- (plist-get params :ind) 1)))
289 (when (and (>= ind 0) (equal '2d (plist-get params :plot-type)))
290 (if (> (length
291 (delq 0 (mapcar
292 (lambda (el)
293 (if (string-match org-table-number-regexp el)
294 0 1))
295 (mapcar (lambda (row) (nth ind row)) table)))) 0)
296 (plist-put params :textind t))))
297 ;; write script
298 (with-temp-buffer
299 (if (plist-get params :script) ;; user script
300 (progn (insert-file-contents (plist-get params :script))
301 (goto-char (point-min))
302 (while (re-search-forward "$datafile" nil t)
303 (replace-match data-file nil nil)))
304 (insert
305 (org-plot/gnuplot-script data-file num-cols params)))
306 ;; graph table
307 (gnuplot-mode)
308 (gnuplot-send-buffer-to-gnuplot))
309 ;; cleanup
310 (bury-buffer (get-buffer "*gnuplot*"))(delete-file data-file))))
311
312(provide 'org-plot)
313
314;;; org-plot.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-19 02:07:51 +0000