diff options
| author | Carsten Dominik | 2008-10-12 06:18:14 +0000 |
|---|---|---|
| committer | Carsten Dominik | 2008-10-12 06:18:14 +0000 |
| commit | 47ffc45683207db93718fa37f2dcbb41fafcf51a (patch) | |
| tree | c300c881ffe390550bab4a11ea842d04c79e0aba /lisp | |
| parent | 621f83e4c1870e4574d3052669b3bb0343cca01e (diff) | |
| download | emacs-47ffc45683207db93718fa37f2dcbb41fafcf51a.tar.gz emacs-47ffc45683207db93718fa37f2dcbb41fafcf51a.zip | |
New files org-attach.el, org-list.el, org-plot.el.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/org/org-attach.el | 339 | ||||
| -rw-r--r-- | lisp/org/org-list.el | 1042 | ||||
| -rw-r--r-- | lisp/org/org-plot.el | 314 |
3 files changed, 1695 insertions, 0 deletions
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. | ||
| 53 | If this is a relative path, it will be interpreted relative to the directory | ||
| 54 | where 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. | ||
| 67 | This 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. | ||
| 75 | Allowed values are: | ||
| 76 | |||
| 77 | mv rename the file to move it into the attachment directory | ||
| 78 | cp copy the file | ||
| 79 | ln 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. | ||
| 95 | Shows 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 | |||
| 114 | a Select a file and attach it to the task, using `org-attach-method'. | ||
| 115 | c/m/l Attach a file using copy/move/link method. | ||
| 116 | n Create a new attachment, as an Emacs buffer. | ||
| 117 | z Synchronize the current task with its attachment | ||
| 118 | directory, in case you added attachments yourself. | ||
| 119 | |||
| 120 | o Open current task's attachments. | ||
| 121 | O Like \"o\", but force opening in Emacs. | ||
| 122 | f Open current task's attachment directory. | ||
| 123 | F Like \"f\", but force using dired in Emacs. | ||
| 124 | |||
| 125 | d Delete one attachment, you will be prompted for a file name. | ||
| 126 | D 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. | ||
| 154 | If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil, | ||
| 155 | the 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. | ||
| 177 | This 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. | ||
| 199 | If VISIT-DIR is non-nil, visit the directory with dired. | ||
| 200 | METHOD 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. | ||
| 229 | Beware that this does not work on systems that do not support hard links. | ||
| 230 | On 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. | ||
| 236 | The 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. | ||
| 264 | This actually deletes the entire attachment directory. | ||
| 265 | A 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. | ||
| 281 | This 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. | ||
| 298 | This 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. | ||
| 311 | This 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. | ||
| 318 | If there are more than one attachment, you will be prompted for the file name. | ||
| 319 | This command will open the file using the settings in `org-file-apps' | ||
| 320 | and in the system-specific variants of this variable. | ||
| 321 | If 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. | ||
| 333 | See `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. | ||
| 56 | This means that during cycling, plain list items will *temporarily* be | ||
| 57 | interpreted as outline headlines with a level given by 1000+i where i is the | ||
| 58 | indentation of the bullet. In all other operations, plain list items are | ||
| 59 | not seen as headlines. For example, you cannot assign a TODO keyword to | ||
| 60 | such 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. | ||
| 66 | Valid values are ?. and ?\). To get both terminators, use t. While | ||
| 67 | ?. may look nicer, it creates the danger that a line with leading | ||
| 68 | number may be incorrectly interpreted as an item. ?\) therefore is | ||
| 69 | the 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. | ||
| 77 | When 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. | ||
| 83 | Renumbering happens when the sequence have been changed with | ||
| 84 | \\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands, | ||
| 85 | use \\[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. | ||
| 91 | When this is set, checkbox statistics is updated each time you either insert | ||
| 92 | a new checkbox with \\[org-insert-todo-heading] or toggle a checkbox | ||
| 93 | with \\[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. | ||
| 99 | When the indentation would be larger than this, it will become | ||
| 100 | 5 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. | ||
| 127 | All occurrences of %n in a template will be replaced with the name of the | ||
| 128 | list, 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. | ||
| 152 | Does 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. | ||
| 163 | Return 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. | ||
| 255 | This will find all statistic cookies like [57%] and [6/12] and update them | ||
| 256 | with the current numbers. With optional prefix argument ALL, do this for | ||
| 257 | the 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. | ||
| 341 | The face will be `org-done' when all relevant boxes are checked. Otherwise | ||
| 342 | it 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. | ||
| 352 | If 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. | ||
| 385 | If 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. | ||
| 413 | Error 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. | ||
| 426 | Error 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. | ||
| 457 | Subitems (items with larger indentation) are considered part of the item, | ||
| 458 | so 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. | ||
| 501 | Subitems (items with larger indentation) are considered part of the item, | ||
| 502 | so 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. | ||
| 562 | This tests the user option `org-auto-renumber-ordered-lists' before | ||
| 563 | doing 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. | ||
| 579 | This cycle the entire list level through the sequence: | ||
| 580 | |||
| 581 | `-' -> `+' -> `*' -> `1.' -> `1)' | ||
| 582 | |||
| 583 | If WHICH is a string, use that as the new bullet. If WHICH is an integer, | ||
| 584 | 0 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. | ||
| 620 | Cursor needs to be in the first line of an item, the line that starts | ||
| 621 | with 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. | ||
| 692 | I.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. | ||
| 718 | I.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. | ||
| 788 | This returns a list with three values: The current indentation, the | ||
| 789 | parent indentation and the indentation a child should habe. | ||
| 790 | Assumes 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. | ||
| 820 | Return a list containing first level items as strings and | ||
| 821 | sublevels 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. | ||
| 864 | Return a cons which car is the beginning position of the item and | ||
| 865 | cdr 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. | ||
| 875 | INDENT 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. | ||
| 901 | With argument MAYBE, fail quietly if no transformation is defined for | ||
| 902 | this 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 | |||
| 944 | Valid 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. | ||
| 51 | Returns 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. | ||
| 89 | Return 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. | ||
| 96 | Accepts an optional property list PARAMS, to which the options | ||
| 97 | will 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. | ||
| 111 | Pass 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. | ||
| 122 | This means, in a format appropriate for grid plotting by gnuplot. | ||
| 123 | PARAMS specifies which columns of TABLE should be plotted as independant | ||
| 124 | and 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. | ||
| 172 | NUM-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. | ||
| 250 | If not given options will be taken from the +PLOT | ||
| 251 | line 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 | ||