aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/textmodes
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/textmodes')
-rw-r--r--lisp/textmodes/artist.el17
-rw-r--r--lisp/textmodes/bibtex.el63
-rw-r--r--lisp/textmodes/flyspell.el43
-rw-r--r--lisp/textmodes/ispell.el15
-rw-r--r--lisp/textmodes/org.el2909
-rw-r--r--lisp/textmodes/po.el19
-rw-r--r--lisp/textmodes/sgml-mode.el44
-rw-r--r--lisp/textmodes/table.el16
-rw-r--r--lisp/textmodes/text-mode.el2
9 files changed, 2245 insertions, 883 deletions
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 9305bdbf9bc..d5dcdd0d9ef 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -365,10 +365,11 @@ Example:
365 "*If in X Windows, use this pointer shape while drawing with the mouse.") 365 "*If in X Windows, use this pointer shape while drawing with the mouse.")
366 366
367 367
368(defcustom artist-text-renderer 'artist-figlet 368(defcustom artist-text-renderer-function 'artist-figlet
369 "Function for doing text rendering." 369 "Function for doing text rendering."
370 :group 'artist-text 370 :group 'artist-text
371 :type 'symbol) 371 :type 'symbol)
372(defvaralias 'artist-text-renderer 'artist-text-renderer-function)
372 373
373 374
374(defcustom artist-figlet-program "figlet" 375(defcustom artist-figlet-program "figlet"
@@ -2910,23 +2911,25 @@ Let blanks in TEXT overwrite any text already in the buffer."
2910 2911
2911(defun artist-text-see-thru (x y) 2912(defun artist-text-see-thru (x y)
2912 "Prompt for text to render, render it at X,Y. 2913 "Prompt for text to render, render it at X,Y.
2913This is done by calling the function specified by `artist-text-renderer', 2914This is done by calling the function specified by
2914which must return a list of strings, to be inserted in the buffer. 2915`artist-text-renderer-function', which must return a list of strings,
2916to be inserted in the buffer.
2915 2917
2916Text already in the buffer ``shines thru'' blanks in the rendered text." 2918Text already in the buffer ``shines thru'' blanks in the rendered text."
2917 (let* ((input-text (read-string "Type text to render: ")) 2919 (let* ((input-text (read-string "Type text to render: "))
2918 (rendered-text (artist-funcall artist-text-renderer input-text))) 2920 (rendered-text (artist-funcall artist-text-renderer-function input-text)))
2919 (artist-text-insert-see-thru x y rendered-text))) 2921 (artist-text-insert-see-thru x y rendered-text)))
2920 2922
2921 2923
2922(defun artist-text-overwrite (x y) 2924(defun artist-text-overwrite (x y)
2923 "Prompt for text to render, render it at X,Y. 2925 "Prompt for text to render, render it at X,Y.
2924This is done by calling the function specified by `artist-text-renderer', 2926This is done by calling the function specified by
2925which must return a list of strings, to be inserted in the buffer. 2927`artist-text-renderer-function', which must return a list of strings,
2928to be inserted in the buffer.
2926 2929
2927Blanks in the rendered text overwrites any text in the buffer." 2930Blanks in the rendered text overwrites any text in the buffer."
2928 (let* ((input-text (read-string "Type text to render: ")) 2931 (let* ((input-text (read-string "Type text to render: "))
2929 (rendered-text (artist-funcall artist-text-renderer input-text))) 2932 (rendered-text (artist-funcall artist-text-renderer-function input-text)))
2930 (artist-text-insert-overwrite x y rendered-text))) 2933 (artist-text-insert-overwrite x y rendered-text)))
2931 2934
2932;; 2935;;
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index e4f0a3db545..c82f2dcf3d0 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -87,7 +87,7 @@ If this is a function, call it to generate the initial field text."
87 :type '(choice (const :tag "None" nil) 87 :type '(choice (const :tag "None" nil)
88 (string :tag "Initial text") 88 (string :tag "Initial text")
89 (function :tag "Initialize Function" :value fun) 89 (function :tag "Initialize Function" :value fun)
90 (other :tag "Default" t))) 90 (const :tag "Default" t)))
91(put 'bibtex-include-OPTkey 'risky-local-variable t) 91(put 'bibtex-include-OPTkey 'risky-local-variable t)
92 92
93(defcustom bibtex-user-optional-fields 93(defcustom bibtex-user-optional-fields
@@ -153,7 +153,7 @@ narrowed to just the entry."
153(defcustom bibtex-maintain-sorted-entries nil 153(defcustom bibtex-maintain-sorted-entries nil
154 "If non-nil, BibTeX mode maintains all entries in sorted order. 154 "If non-nil, BibTeX mode maintains all entries in sorted order.
155Allowed non-nil values are: 155Allowed non-nil values are:
156plain All entries are sorted alphabetically. 156plain or t All entries are sorted alphabetically.
157crossref All entries are sorted alphabetically unless an entry has a 157crossref All entries are sorted alphabetically unless an entry has a
158 crossref field. These crossrefed entries are placed in 158 crossref field. These crossrefed entries are placed in
159 alphabetical order immediately preceding the main entry. 159 alphabetical order immediately preceding the main entry.
@@ -165,7 +165,10 @@ See also `bibtex-sort-ignore-string-entries'."
165 :type '(choice (const nil) 165 :type '(choice (const nil)
166 (const plain) 166 (const plain)
167 (const crossref) 167 (const crossref)
168 (const entry-class))) 168 (const entry-class)
169 (const t)))
170(put 'bibtex-maintain-sorted-entries 'safe-local-variable
171 '(lambda (a) (memq a '(nil t plain crossref entry-class))))
169 172
170(defcustom bibtex-sort-entry-class 173(defcustom bibtex-sort-entry-class
171 '(("String") 174 '(("String")
@@ -180,6 +183,17 @@ to all entries not explicitly mentioned."
180 :type '(repeat (choice :tag "Class" 183 :type '(repeat (choice :tag "Class"
181 (const :tag "catch-all" (catch-all)) 184 (const :tag "catch-all" (catch-all))
182 (repeat :tag "Entry name" string)))) 185 (repeat :tag "Entry name" string))))
186(put 'bibtex-sort-entry-class 'safe-local-variable
187 (lambda (x) (let ((OK t))
188 (while (consp x)
189 (let ((y (pop x)))
190 (while (consp y)
191 (let ((z (pop y)))
192 (unless (or (stringp z) (eq z 'catch-all))
193 (setq OK nil))))
194 (unless (null y) (setq OK nil))))
195 (unless (null x) (setq OK nil))
196 OK)))
183 197
184(defcustom bibtex-sort-ignore-string-entries t 198(defcustom bibtex-sort-ignore-string-entries t
185 "If non-nil, BibTeX @String entries are not sort-significant. 199 "If non-nil, BibTeX @String entries are not sort-significant.
@@ -607,6 +621,8 @@ See `bibtex-generate-autokey' for details."
607 (const :tag "Capitalize" capitalize) 621 (const :tag "Capitalize" capitalize)
608 (const :tag "Upcase" upcase) 622 (const :tag "Upcase" upcase)
609 (function :tag "Conversion function"))) 623 (function :tag "Conversion function")))
624(put 'bibtex-autokey-name-case-convert-function 'safe-local-variable
625 (lambda (x) (memq x '(upcase downcase capitalize identity))))
610(defvaralias 'bibtex-autokey-name-case-convert 626(defvaralias 'bibtex-autokey-name-case-convert
611 'bibtex-autokey-name-case-convert-function) 627 'bibtex-autokey-name-case-convert-function)
612 628
@@ -1185,13 +1201,7 @@ The CDRs of the elements are t for header keys and nil for crossref keys.")
1185(defvar bibtex-string-empty-key nil 1201(defvar bibtex-string-empty-key nil
1186 "If non-nil, `bibtex-parse-string' accepts empty key.") 1202 "If non-nil, `bibtex-parse-string' accepts empty key.")
1187 1203
1188(defvar bibtex-sort-entry-class-alist 1204(defvar bibtex-sort-entry-class-alist nil
1189 (let ((i -1) alist)
1190 (dolist (class bibtex-sort-entry-class alist)
1191 (setq i (1+ i))
1192 (dolist (entry class)
1193 ;; all entry names should be downcase (for ease of comparison)
1194 (push (cons (if (stringp entry) (downcase entry) entry) i) alist))))
1195 "Alist mapping entry types to their sorting index. 1205 "Alist mapping entry types to their sorting index.
1196Auto-generated from `bibtex-sort-entry-class'. 1206Auto-generated from `bibtex-sort-entry-class'.
1197Used when `bibtex-maintain-sorted-entries' is `entry-class'.") 1207Used when `bibtex-maintain-sorted-entries' is `entry-class'.")
@@ -1800,7 +1810,8 @@ Formats current entry according to variable `bibtex-entry-format'."
1800 1810
1801 ;; identify entry type 1811 ;; identify entry type
1802 (goto-char (point-min)) 1812 (goto-char (point-min))
1803 (re-search-forward bibtex-entry-type) 1813 (or (re-search-forward bibtex-entry-type nil t)
1814 (error "Not inside a BibTeX entry"))
1804 (let ((beg-type (1+ (match-beginning 0))) 1815 (let ((beg-type (1+ (match-beginning 0)))
1805 (end-type (match-end 0))) 1816 (end-type (match-end 0)))
1806 (setq entry-list (assoc-string (buffer-substring-no-properties 1817 (setq entry-list (assoc-string (buffer-substring-no-properties
@@ -3184,6 +3195,17 @@ of the head of the entry found. Return nil if no entry found."
3184 entry-name)) 3195 entry-name))
3185 (list key nil entry-name)))))) 3196 (list key nil entry-name))))))
3186 3197
3198(defun bibtex-init-sort-entry-class-alist ()
3199 (unless (local-variable-p 'bibtex-sort-entry-class-alist)
3200 (set (make-local-variable 'bibtex-sort-entry-class-alist)
3201 (let ((i -1) alist)
3202 (dolist (class bibtex-sort-entry-class alist)
3203 (setq i (1+ i))
3204 (dolist (entry class)
3205 ;; All entry names should be downcase (for ease of comparison).
3206 (push (cons (if (stringp entry) (downcase entry) entry) i)
3207 alist)))))))
3208
3187(defun bibtex-lessp (index1 index2) 3209(defun bibtex-lessp (index1 index2)
3188 "Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2. 3210 "Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2.
3189Each index is a list (KEY CROSSREF-KEY ENTRY-NAME). 3211Each index is a list (KEY CROSSREF-KEY ENTRY-NAME).
@@ -3221,13 +3243,14 @@ If its value is nil use plain sorting. Text outside of BibTeX entries is not
3221affected. If `bibtex-sort-ignore-string-entries' is non-nil, @String entries 3243affected. If `bibtex-sort-ignore-string-entries' is non-nil, @String entries
3222are ignored." 3244are ignored."
3223 (interactive) 3245 (interactive)
3224 (bibtex-beginning-of-first-entry) ;; needed by `sort-subr' 3246 (bibtex-beginning-of-first-entry) ; Needed by `sort-subr'
3225 (sort-subr nil 3247 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'.
3226 'bibtex-skip-to-valid-entry ; NEXTREC function 3248 (sort-subr nil
3227 'bibtex-end-of-entry ; ENDREC function 3249 'bibtex-skip-to-valid-entry ; NEXTREC function
3228 'bibtex-entry-index ; STARTKEY function 3250 'bibtex-end-of-entry ; ENDREC function
3229 nil ; ENDKEY function 3251 'bibtex-entry-index ; STARTKEY function
3230 'bibtex-lessp)) ; PREDICATE 3252 nil ; ENDKEY function
3253 'bibtex-lessp)) ; PREDICATE
3231 3254
3232(defun bibtex-find-crossref (crossref-key &optional pnt split) 3255(defun bibtex-find-crossref (crossref-key &optional pnt split)
3233 "Move point to the beginning of BibTeX entry CROSSREF-KEY. 3256 "Move point to the beginning of BibTeX entry CROSSREF-KEY.
@@ -3328,6 +3351,7 @@ If `bibtex-maintain-sorted-entries' is non-nil, perform a binary
3328search to look for place for KEY. This requires that buffer is sorted, 3351search to look for place for KEY. This requires that buffer is sorted,
3329see `bibtex-validate'. 3352see `bibtex-validate'.
3330Return t if preparation was successful or nil if entry KEY already exists." 3353Return t if preparation was successful or nil if entry KEY already exists."
3354 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'.
3331 (let ((key (nth 0 index)) 3355 (let ((key (nth 0 index))
3332 key-exist) 3356 key-exist)
3333 (cond ((or (null key) 3357 (cond ((or (null key)
@@ -3876,7 +3900,8 @@ At end of the cleaning process, the functions in
3876 (interactive "P") 3900 (interactive "P")
3877 (let ((case-fold-search t) 3901 (let ((case-fold-search t)
3878 (start (bibtex-beginning-of-entry)) 3902 (start (bibtex-beginning-of-entry))
3879 (_ (looking-at bibtex-any-entry-maybe-empty-head)) 3903 (_ (or (looking-at bibtex-any-entry-maybe-empty-head)
3904 (error "Not inside a BibTeX entry")))
3880 (entry-type (bibtex-type-in-head)) 3905 (entry-type (bibtex-type-in-head))
3881 (key (bibtex-key-in-head))) 3906 (key (bibtex-key-in-head)))
3882 ;; formatting 3907 ;; formatting
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 54b67a258a6..23f4756f4a7 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -271,21 +271,23 @@ If `flyspell-large-region' is nil, all regions are treated as small."
271;;* using flyspell with mail-mode add the following expression */ 271;;* using flyspell with mail-mode add the following expression */
272;;* in your .emacs file: */ 272;;* in your .emacs file: */
273;;* (add-hook 'mail-mode */ 273;;* (add-hook 'mail-mode */
274;;* '(lambda () (setq flyspell-generic-check-word-p */ 274;;* '(lambda () (setq flyspell-generic-check-word-predicate */
275;;* 'mail-mode-flyspell-verify))) */ 275;;* 'mail-mode-flyspell-verify))) */
276;;*---------------------------------------------------------------------*/ 276;;*---------------------------------------------------------------------*/
277(defvar flyspell-generic-check-word-p nil 277(defvar flyspell-generic-check-word-predicate nil
278 "Function providing per-mode customization over which words are flyspelled. 278 "Function providing per-mode customization over which words are flyspelled.
279Returns t to continue checking, nil otherwise. 279Returns t to continue checking, nil otherwise.
280Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate' 280Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate'
281property of the major mode name.") 281property of the major mode name.")
282(make-variable-buffer-local 'flyspell-generic-check-word-p) 282(make-variable-buffer-local 'flyspell-generic-check-word-predicate)
283(defvaralias 'flyspell-generic-check-word-p
284 'flyspell-generic-check-word-predicate)
283 285
284;;*--- mail mode -------------------------------------------------------*/ 286;;*--- mail mode -------------------------------------------------------*/
285(put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) 287(put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
286(put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) 288(put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
287(defun mail-mode-flyspell-verify () 289(defun mail-mode-flyspell-verify ()
288 "This function is used for `flyspell-generic-check-word-p' in Mail mode." 290 "Function used for `flyspell-generic-check-word-predicate' in Mail mode."
289 (let ((header-end (save-excursion 291 (let ((header-end (save-excursion
290 (goto-char (point-min)) 292 (goto-char (point-min))
291 (re-search-forward 293 (re-search-forward
@@ -313,7 +315,7 @@ property of the major mode name.")
313;;*--- texinfo mode ----------------------------------------------------*/ 315;;*--- texinfo mode ----------------------------------------------------*/
314(put 'texinfo-mode 'flyspell-mode-predicate 'texinfo-mode-flyspell-verify) 316(put 'texinfo-mode 'flyspell-mode-predicate 'texinfo-mode-flyspell-verify)
315(defun texinfo-mode-flyspell-verify () 317(defun texinfo-mode-flyspell-verify ()
316 "This function is used for `flyspell-generic-check-word-p' in Texinfo mode." 318 "Function used for `flyspell-generic-check-word-predicate' in Texinfo mode."
317 (save-excursion 319 (save-excursion
318 (forward-word -1) 320 (forward-word -1)
319 (not (looking-at "@")))) 321 (not (looking-at "@"))))
@@ -321,7 +323,7 @@ property of the major mode name.")
321;;*--- tex mode --------------------------------------------------------*/ 323;;*--- tex mode --------------------------------------------------------*/
322(put 'tex-mode 'flyspell-mode-predicate 'tex-mode-flyspell-verify) 324(put 'tex-mode 'flyspell-mode-predicate 'tex-mode-flyspell-verify)
323(defun tex-mode-flyspell-verify () 325(defun tex-mode-flyspell-verify ()
324 "This function is used for `flyspell-generic-check-word-p' in LaTeX mode." 326 "Function used for `flyspell-generic-check-word-predicate' in LaTeX mode."
325 (and 327 (and
326 (not (save-excursion 328 (not (save-excursion
327 (re-search-backward "^[ \t]*%%%[ \t]+Local" nil t))) 329 (re-search-backward "^[ \t]*%%%[ \t]+Local" nil t)))
@@ -338,7 +340,7 @@ property of the major mode name.")
338(put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify) 340(put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify)
339 341
340(defun sgml-mode-flyspell-verify () 342(defun sgml-mode-flyspell-verify ()
341 "This function is used for `flyspell-generic-check-word-p' in SGML mode." 343 "Function used for `flyspell-generic-check-word-predicate' in SGML mode."
342 (not (save-excursion 344 (not (save-excursion
343 (let ((this (point-marker)) 345 (let ((this (point-marker))
344 (s (progn (beginning-of-line) (point-marker))) 346 (s (progn (beginning-of-line) (point-marker)))
@@ -368,7 +370,7 @@ property of the major mode name.")
368 "Faces corresponding to text in programming-mode buffers.") 370 "Faces corresponding to text in programming-mode buffers.")
369 371
370(defun flyspell-generic-progmode-verify () 372(defun flyspell-generic-progmode-verify ()
371 "Used for `flyspell-generic-check-word-p' in programming modes." 373 "Used for `flyspell-generic-check-word-predicate' in programming modes."
372 (let ((f (get-text-property (point) 'face))) 374 (let ((f (get-text-property (point) 'face)))
373 (memq f flyspell-prog-text-faces))) 375 (memq f flyspell-prog-text-faces)))
374 376
@@ -376,7 +378,8 @@ property of the major mode name.")
376(defun flyspell-prog-mode () 378(defun flyspell-prog-mode ()
377 "Turn on `flyspell-mode' for comments and strings." 379 "Turn on `flyspell-mode' for comments and strings."
378 (interactive) 380 (interactive)
379 (setq flyspell-generic-check-word-p 'flyspell-generic-progmode-verify) 381 (setq flyspell-generic-check-word-predicate
382 'flyspell-generic-progmode-verify)
380 (flyspell-mode 1) 383 (flyspell-mode 1)
381 (run-hooks 'flyspell-prog-mode-hook)) 384 (run-hooks 'flyspell-prog-mode-hook))
382 385
@@ -483,6 +486,18 @@ in your .emacs file.
483 (flyspell-mode-on) 486 (flyspell-mode-on)
484 (flyspell-mode-off))) 487 (flyspell-mode-off)))
485 488
489;;;###autoload
490(defun turn-on-flyspell ()
491 "Unconditionally turn on Flyspell mode."
492 (flyspell-mode 1))
493
494;;;###autoload
495(defun turn-off-flyspell ()
496 "Unconditionally turn off Flyspell mode."
497 (flyspell-mode -1))
498
499(custom-add-option 'text-mode-hook 'turn-on-flyspell)
500
486;;*---------------------------------------------------------------------*/ 501;;*---------------------------------------------------------------------*/
487;;* flyspell-buffers ... */ 502;;* flyspell-buffers ... */
488;;* ------------------------------------------------------------- */ 503;;* ------------------------------------------------------------- */
@@ -563,10 +578,10 @@ in your .emacs file.
563 (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t) 578 (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t)
564 ;; we bound flyspell action to after-change hook 579 ;; we bound flyspell action to after-change hook
565 (add-hook 'after-change-functions 'flyspell-after-change-function nil t) 580 (add-hook 'after-change-functions 'flyspell-after-change-function nil t)
566 ;; set flyspell-generic-check-word-p based on the major mode 581 ;; set flyspell-generic-check-word-predicate based on the major mode
567 (let ((mode-predicate (get major-mode 'flyspell-mode-predicate))) 582 (let ((mode-predicate (get major-mode 'flyspell-mode-predicate)))
568 (if mode-predicate 583 (if mode-predicate
569 (setq flyspell-generic-check-word-p mode-predicate))) 584 (setq flyspell-generic-check-word-predicate mode-predicate)))
570 ;; the welcome message 585 ;; the welcome message
571 (if (and flyspell-issue-message-flag 586 (if (and flyspell-issue-message-flag
572 flyspell-issue-welcome-flag 587 flyspell-issue-welcome-flag
@@ -979,8 +994,8 @@ Mostly we check word delimiters."
979 (flyspell-word (flyspell-get-word following)) 994 (flyspell-word (flyspell-get-word following))
980 start end poss word) 995 start end poss word)
981 (if (or (eq flyspell-word nil) 996 (if (or (eq flyspell-word nil)
982 (and (fboundp flyspell-generic-check-word-p) 997 (and (fboundp flyspell-generic-check-word-predicate)
983 (not (funcall flyspell-generic-check-word-p)))) 998 (not (funcall flyspell-generic-check-word-predicate))))
984 t 999 t
985 (progn 1000 (progn
986 ;; destructure return flyspell-word info list. 1001 ;; destructure return flyspell-word info list.
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 5629e8feb31..00a757d68bd 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -416,11 +416,12 @@ The following values are supported:
416 :type 'boolean 416 :type 'boolean
417 :group 'ispell) 417 :group 'ispell)
418 418
419(defcustom ispell-format-word (function upcase) 419(defcustom ispell-format-word-function (function upcase)
420 "*Formatting function for displaying word being spell checked. 420 "*Formatting function for displaying word being spell checked.
421The function must take one string argument and return a string." 421The function must take one string argument and return a string."
422 :type 'function 422 :type 'function
423 :group 'ispell) 423 :group 'ispell)
424(defvaralias 'ispell-format-word 'ispell-format-word-function)
424 425
425(defcustom ispell-use-framepop-p nil 426(defcustom ispell-use-framepop-p nil
426 "When non-nil ispell uses framepop to display choices in a dedicated frame. 427 "When non-nil ispell uses framepop to display choices in a dedicated frame.
@@ -1565,7 +1566,7 @@ quit spell session exited."
1565 ;; But that is silly; if the user asks for it, we should do it. - rms. 1566 ;; But that is silly; if the user asks for it, we should do it. - rms.
1566 (or quietly 1567 (or quietly
1567 (message "Checking spelling of %s..." 1568 (message "Checking spelling of %s..."
1568 (funcall ispell-format-word word))) 1569 (funcall ispell-format-word-function word)))
1569 (ispell-send-string "%\n") ; put in verbose mode 1570 (ispell-send-string "%\n") ; put in verbose mode
1570 (ispell-send-string (concat "^" word "\n")) 1571 (ispell-send-string (concat "^" word "\n"))
1571 ;; wait until ispell has processed word 1572 ;; wait until ispell has processed word
@@ -1581,7 +1582,7 @@ quit spell session exited."
1581 (cond ((eq poss t) 1582 (cond ((eq poss t)
1582 (or quietly 1583 (or quietly
1583 (message "%s is correct" 1584 (message "%s is correct"
1584 (funcall ispell-format-word word))) 1585 (funcall ispell-format-word-function word)))
1585 (and (fboundp 'extent-at) 1586 (and (fboundp 'extent-at)
1586 (extent-at start) 1587 (extent-at start)
1587 (and (fboundp 'delete-extent) 1588 (and (fboundp 'delete-extent)
@@ -1589,8 +1590,8 @@ quit spell session exited."
1589 ((stringp poss) 1590 ((stringp poss)
1590 (or quietly 1591 (or quietly
1591 (message "%s is correct because of root %s" 1592 (message "%s is correct because of root %s"
1592 (funcall ispell-format-word word) 1593 (funcall ispell-format-word-function word)
1593 (funcall ispell-format-word poss))) 1594 (funcall ispell-format-word-function poss)))
1594 (and (fboundp 'extent-at) 1595 (and (fboundp 'extent-at)
1595 (extent-at start) 1596 (extent-at start)
1596 (and (fboundp 'delete-extent) 1597 (and (fboundp 'delete-extent)
@@ -1603,7 +1604,8 @@ quit spell session exited."
1603 (set-extent-property ext 'face ispell-highlight-face) 1604 (set-extent-property ext 'face ispell-highlight-face)
1604 (set-extent-property ext 'priority 2000))) 1605 (set-extent-property ext 'priority 2000)))
1605 (beep) 1606 (beep)
1606 (message "%s is incorrect"(funcall ispell-format-word word)))) 1607 (message "%s is incorrect"
1608 (funcall ispell-format-word-function word))))
1607 (t ; prompt for correct word. 1609 (t ; prompt for correct word.
1608 (save-window-excursion 1610 (save-window-excursion
1609 (setq replace (ispell-command-loop 1611 (setq replace (ispell-command-loop
@@ -3329,6 +3331,7 @@ Don't read buffer-local settings or word lists."
3329 "*End of text which will be checked in `ispell-message'. 3331 "*End of text which will be checked in `ispell-message'.
3330If it is a string, limit at first occurrence of that regular expression. 3332If it is a string, limit at first occurrence of that regular expression.
3331Otherwise, it must be a function which is called to get the limit.") 3333Otherwise, it must be a function which is called to get the limit.")
3334(put 'ispell-message-text-end 'risky-local-variable t)
3332 3335
3333 3336
3334(defun ispell-mime-multipartp (&optional limit) 3337(defun ispell-mime-multipartp (&optional limit)
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index ea9aa4448ee..853c28f5565 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -5,7 +5,7 @@
5;; Author: Carsten Dominik <dominik at science dot uva dot nl> 5;; Author: Carsten Dominik <dominik at science dot uva dot nl>
6;; Keywords: outlines, hypermedia, calendar, wp 6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ 7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8;; Version: 4.26 8;; Version: 4.36
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -30,16 +30,21 @@
30;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing 30;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing
31;; project planning with a fast and effective plain-text system. 31;; project planning with a fast and effective plain-text system.
32;; 32;;
33;; Org-mode develops organizational tasks around a NOTES file that contains 33;; Org-mode develops organizational tasks around NOTES files that contain
34;; information about projects as plain text. Org-mode is implemented on top 34;; information about projects as plain text. Org-mode is implemented on
35;; of outline-mode - ideal to keep the content of large files well structured. 35;; top of outline-mode, which makes it possible to keep the content of
36;; It supports ToDo items, deadlines and time stamps, which can be extracted 36;; large files well structured. Visibility cycling and structure editing
37;; to create a daily/weekly agenda that also integrates the diary of the Emacs 37;; help to work with the tree. Tables are easily created with a built-in
38;; calendar. Tables are easily created with a built-in table editor. Plain 38;; table editor. Org-mode supports ToDo items, deadlines, time stamps,
39;; text URL-like links connect to websites, emails (VM, RMAIL, WANDERLUST), 39;; and scheduling. It dynamically compiles entries into an agenda that
40;; Usenet messages (Gnus), BBDB entries, and any files related to the 40;; utilizes and smoothly integrates much of the Emacs calendar and diary.
41;; projects. For printing and sharing of notes, an Org-mode file (or a part 41;; Plain text URL-like links connect to websites, emails, Usenet
42;; of it) can be exported as a structured ASCII file, or as HTML. 42;; messages, BBDB entries, and any files related to the projects. For
43;; printing and sharing of notes, an Org-mode file can be exported as a
44;; structured ASCII file, as HTML, or (todo and agenda items only) as an
45;; iCalendar file. It can also serve as a publishing tool for a set of
46;; linked webpages.
47;;
43;; 48;;
44;; Installation 49;; Installation
45;; ------------ 50;; ------------
@@ -52,19 +57,23 @@
52;; (define-key global-map "\C-cl" 'org-store-link) 57;; (define-key global-map "\C-cl" 'org-store-link)
53;; (define-key global-map "\C-ca" 'org-agenda) 58;; (define-key global-map "\C-ca" 'org-agenda)
54;; 59;;
55;; If you have downloaded Org-mode from the Web, you must byte-compile 60;; Furthermore you need to activate font-lock-mode in org-mode buffers.
56;; org.el and put it on your load path. In addition to the Emacs Lisp 61;; either of the following two lins will do the trick:
57;; lines above, you also need to add the following lines to .emacs: 62;;
63;; (global-font-lock-mode 1) ; for all buffers
64;; (add-hook 'org-mode-hook 'turn-on-font-lock) ; org-mode buffers only
65;;
66;; If you have downloaded Org-mode from the Web, you have to take additional
67;; action: Byte-compile org.el and org-publish.el and put them together with
68;; org-install.el on your load path. Then also add to your .emacs file:
69;;
70;; (require 'org-install)
58;; 71;;
59;; (autoload 'org-mode "org" "Org mode" t)
60;; (autoload 'org-diary "org" "Diary entries from Org mode")
61;; (autoload 'org-agenda "org" "Multi-file agenda from Org mode" t)
62;; (autoload 'org-store-link "org" "Store a link to the current location" t)
63;; (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t)
64;; (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode")
65;; 72;;
66;; This setup will put all files with extension ".org" into Org-mode. As 73;; Activation
67;; an alternative, make the first line of a file look like this: 74;; ----------
75;; The setup above will put all files with extension ".org" into Org-mode.
76;; As an alternative, make the first line of a file look like this:
68;; 77;;
69;; MY PROJECTS -*- mode: org; -*- 78;; MY PROJECTS -*- mode: org; -*-
70;; 79;;
@@ -79,48 +88,78 @@
79;; excellent reference card made by Philip Rooke. This card can be found 88;; excellent reference card made by Philip Rooke. This card can be found
80;; in the etc/ directory of Emacs 22. 89;; in the etc/ directory of Emacs 22.
81;; 90;;
82;; Changes since version 4.10: 91;; Recent changes
83;; --------------------------- 92;; --------------
84;; Version 4.26 93;; Version 4.36
94;; - Improved indentation of ASCII export, when headlines become items.
95;; - Handling of 12am and 12pm fixed. Times beyond 24:00 can be used
96;; and will not lead to conflicts.
97;; - Support for mutually exclusive TAGS with the fast tags interface.
85;; - Bug fixes. 98;; - Bug fixes.
86;; 99;;
87;; Version 4.25 100;; Version 4.35
88;; - Revision of the font-lock faces section, with better tty support. 101;; - HTML export is now valid XHTML.
89;; - TODO keywords in Agenda buffer are fontified. 102;; - Timeline can also show dates without entries. See new option
90;; - Export converts links between .org files to links between .html files. 103;; `org-timeline-show-empty-dates'.
91;; - Better support for bold/italic/underline emphasis. 104;; - The bullets created by the ASCII exporter can now be configured.
105;; See the new option `org-export-ascii-bullets'.
106;; - New face `org-upcoming-deadline' (was `org-scheduled-previously').
107;; - New function `org-context' to allow testing for local context.
92;; 108;;
93;; Version 4.24 109;; Version 4.34
94;; - Bug fixes. 110;; - Bug fixes.
95;; 111;;
96;; Version 4.23 112;; Version 4.33
97;; - Bug fixes. 113;; - New commands to move through plain lists: S-up and S-down.
114;; - Bug fixes and documentation update.
98;; 115;;
99;; Version 4.22 116;; Version 4.32
117;; - Fast (single-key-per-tag) interface for setting TAGS.
118;; - The list of legal tags can be configured globally and locally.
119;; - Elisp and Info links (thanks to Todd Neal).
120;; - `org-export-publishing-directory' can be an alist, with different
121;; directories for different export types.
122;; - All context-sensitive commands use `call-interactively' to dispatch.
123;; - `org-confirm-shell-links' renamed to `org-confirm-shell-link-function'.
100;; - Bug fixes. 124;; - Bug fixes.
101;; - In agenda buffer, mouse-1 no longer follows link. 125;;
102;; See `org-agenda-mouse-1-follows-link' and `org-mouse-1-follows-link'. 126;; Version 4.31
103;;
104;; Version 4.20
105;; - Links use now the [[link][description]] format by default.
106;; When inserting links, the user is prompted for a description.
107;; - If a link has a description, only the description is displayed
108;; the link part is hidden. Use C-c C-l to edit the link part.
109;; - TAGS are now bold, but in the same color as the headline.
110;; - The width of a table column can be limited by using a field "<N>".
111;; - New structure for the customization tree.
112;; - Bug fixes. 127;; - Bug fixes.
113;; 128;;
114;; Version 4.13 129;; Version 4.30
115;; - The list of agenda files can be maintainted in an external file. 130;; - Modified installation: Autoloads have been collected in org-install.el.
131;; - Logging (org-log-done) is now a #+STARTUP option.
132;; - Checkboxes in plain list items, following up on Frank Ruell's idea.
133;; - File links inserted with C-c C-l will use relative paths if the linked
134;; file is in the current directory or a subdirectory of it.
135;; - New variable `org-link-file-path-type' to specify preference for
136;; relative and absolute paths.
137;; - New CSS classes for tags, timestamps, timestamp keywords.
138;; - Bug and typo fixes.
139;;
140;; Version 4.29
141;; - Inlining images in HTML export now depends on wheather the link
142;; contains a description or not.
143;; - TODO items can be scheduled from the global TODO list using C-c C-s.
144;; - TODO items already scheduled can be made to disappear from the global
145;; todo list, see `org-agenda-todo-ignore-scheduled'.
146;; - In Tables, formulas may also be Lisp forms.
147;; - Exporting the visible part of an outline with `C-c C-x v' works now
148;; for all available exporters.
149;; - Bug fixes, lots of them :-(
150;;
151;; Version 4.28
116;; - Bug fixes. 152;; - Bug fixes.
117;; 153;;
118;; Version 4.12 154;; Version 4.27
119;; - Templates for remember buffer. Note that the remember setup changes. 155;; - HTML exporter generalized to receive external options.
120;; To set up templates, see `org-remember-templates'. 156;; As part of the process, author, email and date have been moved to the
121;; - The time in new time stamps can be rounded, see new option 157;; end of the HTML file.
122;; `org-time-stamp-rounding-minutes'. 158;; - Support for customizable file search in file links.
123;; - Bug fixes (there are *always* more bugs). 159;; - BibTeX database links as first application of the above.
160;; - New option `org-agenda-todo-list-sublevels' to turn off listing TODO
161;; entries that are sublevels of another TODO entry.
162;;
124;; 163;;
125;;; Code: 164;;; Code:
126 165
@@ -131,13 +170,9 @@
131(require 'time-date) 170(require 'time-date)
132(require 'easymenu) 171(require 'easymenu)
133 172
134(defvar calc-embedded-close-formula) ; defined by the calc package
135(defvar calc-embedded-open-formula) ; defined by the calc package
136(defvar font-lock-unfontify-region-function) ; defined by font-lock.el
137
138;;; Customization variables 173;;; Customization variables
139 174
140(defvar org-version "4.26" 175(defvar org-version "4.36"
141 "The version number of the file org.el.") 176 "The version number of the file org.el.")
142(defun org-version () 177(defun org-version ()
143 (interactive) 178 (interactive)
@@ -325,14 +360,30 @@ An entry can be toggled between QUOTE and normal with
325 :tag "Org Cycle" 360 :tag "Org Cycle"
326 :group 'org-structure) 361 :group 'org-structure)
327 362
363(defcustom org-cycle-global-at-bob t
364 "Cycle globally if cursor is at beginning of buffer and not at a headline.
365This makes it possible to do global cycling without having to use S-TAB or
366C-u TAB. For this special case to work, the first line of the buffer
367must not be a headline - it may be empty ot some other text. When used in
368this way, `org-cycle-hook' is disables temporarily, to make sure the
369cursor stays at the beginning of the buffer.
370When this option is nil, don't do anything special at the beginning
371of the buffer."
372 :group 'org-cycle
373 :type 'boolean)
374
328(defcustom org-cycle-emulate-tab t 375(defcustom org-cycle-emulate-tab t
329 "Where should `org-cycle' emulate TAB. 376 "Where should `org-cycle' emulate TAB.
330nil Never 377nil Never
331white Only in completely white lines 378white Only in completely white lines
332t Everywhere except in headlines" 379whitestart Only at the beginning of lines, before the first non-white char.
380t Everywhere except in headlines
381If TAB is used in a place where it does not emulate TAB, the current subtree
382visibility is cycled."
333 :group 'org-cycle 383 :group 'org-cycle
334 :type '(choice (const :tag "Never" nil) 384 :type '(choice (const :tag "Never" nil)
335 (const :tag "Only in completely white lines" white) 385 (const :tag "Only in completely white lines" white)
386 (const :tag "Before first char in a line" whitestart)
336 (const :tag "Everywhere except in headlines" t) 387 (const :tag "Everywhere except in headlines" t)
337 )) 388 ))
338 389
@@ -376,6 +427,11 @@ body starts at column 0, indentation is not changed at all."
376 :group 'org-edit-structure 427 :group 'org-edit-structure
377 :type 'boolean) 428 :type 'boolean)
378 429
430(defcustom org-insert-heading-hook nil
431 "Hook being run after inserting a new heading."
432 :group 'org-edit-structure
433 :type 'boolean)
434
379(defcustom org-enable-fixed-width-editor t 435(defcustom org-enable-fixed-width-editor t
380 "Non-nil means, lines starting with \":\" are treated as fixed-width. 436 "Non-nil means, lines starting with \":\" are treated as fixed-width.
381This currently only means, they are never auto-wrapped. 437This currently only means, they are never auto-wrapped.
@@ -756,6 +812,23 @@ additional URL: prefix, so the format would be \"<URL:%s>\"."
756 (const :tag "\"<URL:%s>\" (e.g. <URL:http://www.there.com>)" "<URL:%s>") 812 (const :tag "\"<URL:%s>\" (e.g. <URL:http://www.there.com>)" "<URL:%s>")
757 (string :tag "Other" :value "<%s>"))) 813 (string :tag "Other" :value "<%s>")))
758 814
815(defcustom org-link-file-path-type 'adaptive
816 "How the path name in file links should be stored.
817Valid values are:
818
819relative relative to the current directory, i.e. the directory of the file
820 into which the link is being inserted.
821absolute absolute path, if possible with ~ for home directory.
822noabbrev absolute path, no abbreviation of home directory.
823adaptive Use relative path for files in the current directory and sub-
824 directories of it. For other files, use an absolute path."
825 :group 'org-link
826 :type '(choice
827 (const relative)
828 (const absolute)
829 (const noabbrev)
830 (const adaptive)))
831
759(defcustom org-activate-links '(bracket angle plain radio tag date) 832(defcustom org-activate-links '(bracket angle plain radio tag date)
760 "Types of links that should be activated in Org-mode files. 833 "Types of links that should be activated in Org-mode files.
761This is a list of symbols, each leading to the activation of a certain link 834This is a list of symbols, each leading to the activation of a certain link
@@ -898,15 +971,32 @@ When nil, an error will be generated."
898 :group 'org-link-follow 971 :group 'org-link-follow
899 :type 'boolean) 972 :type 'boolean)
900 973
901(defcustom org-confirm-shell-links 'yes-or-no-p 974(defcustom org-confirm-shell-link-function 'yes-or-no-p
902 "Non-nil means, ask for confirmation before executing shell links. 975 "Non-nil means, ask for confirmation before executing shell links.
903Shell links can be dangerous, just thing about a link 976Shell links can be dangerous, just thing about a link
904 977
905 [[shell:rm -rf ~/*][Google Search]] 978 [[shell:rm -rf ~/*][Google Search]]
906 979
907This link would show up in your Org-mode document as \"Google Search\" 980This link would show up in your Org-mode document as \"Google Search\"
908but really it would remove your entire home directory. Dangerous indeed. 981but really it would remove your entire home directory.
909Therefore I *definitely* advise agains setting this varaiable to nil. 982Therefore I *definitely* advise against setting this variable to nil.
983Just change it to `y-or-n-p' of you want to confirm with a single key press
984rather than having to type \"yes\"."
985 :group 'org-link-follow
986 :type '(choice
987 (const :tag "with yes-or-no (safer)" yes-or-no-p)
988 (const :tag "with y-or-n (faster)" y-or-n-p)
989 (const :tag "no confirmation (dangerous)" nil)))
990
991(defcustom org-confirm-elisp-link-function 'yes-or-no-p
992 "Non-nil means, ask for confirmation before executing elisp links.
993Elisp links can be dangerous, just thing about a link
994
995 [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]]
996
997This link would show up in your Org-mode document as \"Google Search\"
998but really it would remove your entire home directory.
999Therefore I *definitely* advise against setting this variable to nil.
910Just change it to `y-or-n-p' of you want to confirm with a single key press 1000Just change it to `y-or-n-p' of you want to confirm with a single key press
911rather than having to type \"yes\"." 1001rather than having to type \"yes\"."
912 :group 'org-link-follow 1002 :group 'org-link-follow
@@ -934,7 +1024,11 @@ for some files for which the OS does not have a good default.
934See `org-file-apps'.") 1024See `org-file-apps'.")
935 1025
936(defconst org-file-apps-defaults-windowsnt 1026(defconst org-file-apps-defaults-windowsnt
937 '((t . (w32-shell-execute "open" file))) 1027 (list (cons t
1028 (list (if (featurep 'xemacs)
1029 'mswindows-shell-execute
1030 'w32-shell-execute)
1031 "open" 'file)))
938 "Default file applications on a Windows NT system. 1032 "Default file applications on a Windows NT system.
939The system \"open\" is used for most files. 1033The system \"open\" is used for most files.
940See `org-file-apps'.") 1034See `org-file-apps'.")
@@ -946,18 +1040,25 @@ See `org-file-apps'.")
946 ("ltx" . emacs) 1040 ("ltx" . emacs)
947 ("org" . emacs) 1041 ("org" . emacs)
948 ("el" . emacs) 1042 ("el" . emacs)
1043 ("bib" . emacs)
949 ) 1044 )
950 "External applications for opening `file:path' items in a document. 1045 "External applications for opening `file:path' items in a document.
951Org-mode uses system defaults for different file types, but 1046Org-mode uses system defaults for different file types, but
952you can use this variable to set the application for a given file 1047you can use this variable to set the application for a given file
953extension. The entries in this list are cons cells with a file extension 1048extension. The entries in this list are cons cells where the car identifies
954and the corresponding command. Possible values for the command are: 1049files and the cdr the corresponding command. Possible values for the
955 `emacs' The file will be visited by the current Emacs process. 1050file identifier are
956 `default' Use the default application for this file type. 1051 \"ext\" A string identifying an extension
957 string A command to be executed by a shell; %s will be replaced 1052 `directory' Matches a directory
958 by the path to the file. 1053 t Default for all remaining files
959 sexp A Lisp form which will be evaluated. The file path will 1054
960 be available in the Lisp variable `file'. 1055Possible values for the command are:
1056 `emacs' The file will be visited by the current Emacs process.
1057 `default' Use the default application for this file type.
1058 string A command to be executed by a shell; %s will be replaced
1059 by the path to the file.
1060 sexp A Lisp form which will be evaluated. The file path will
1061 be available in the Lisp variable `file'.
961For more examples, see the system specific constants 1062For more examples, see the system specific constants
962`org-file-apps-defaults-macosx' 1063`org-file-apps-defaults-macosx'
963`org-file-apps-defaults-windowsnt' 1064`org-file-apps-defaults-windowsnt'
@@ -1085,7 +1186,12 @@ Lisp variable `state'."
1085(defcustom org-log-done nil 1186(defcustom org-log-done nil
1086 "When set, insert a (non-active) time stamp when TODO entry is marked DONE. 1187 "When set, insert a (non-active) time stamp when TODO entry is marked DONE.
1087When the state of an entry is changed from nothing to TODO, remove a previous 1188When the state of an entry is changed from nothing to TODO, remove a previous
1088closing date." 1189closing date.
1190This can also be configured on a per-file basis by adding one of
1191the following lines anywhere in the buffer:
1192
1193 #+STARTUP: logging
1194 #+STARTUP: nologging"
1089 :group 'org-todo 1195 :group 'org-todo
1090 :type 'boolean) 1196 :type 'boolean)
1091 1197
@@ -1110,6 +1216,14 @@ This is the priority an item get if no explicit priority is given."
1110 :tag "Org Time" 1216 :tag "Org Time"
1111 :group 'org) 1217 :group 'org)
1112 1218
1219(defcustom org-insert-labeled-timestamps-at-point nil
1220 "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point.
1221When nil, these labeled time stamps are forces into the second line of an
1222entry, just after the headline. When scheduling from the global TODO list,
1223the time stamp will always be forced into the second line."
1224 :group 'org-time
1225 :type 'boolean)
1226
1113(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") 1227(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
1114 "Formats for `format-time-string' which are used for time stamps. 1228 "Formats for `format-time-string' which are used for time stamps.
1115It is not recommended to change this constant.") 1229It is not recommended to change this constant.")
@@ -1149,6 +1263,36 @@ moved to the new date."
1149 :tag "Org Tags" 1263 :tag "Org Tags"
1150 :group 'org) 1264 :group 'org)
1151 1265
1266(defcustom org-tag-alist nil
1267 "List of tags allowed in Org-mode files.
1268When this list is nil, Org-mode will base TAG input on what is already in the
1269buffer.
1270The value of this variable is an alist, the car may be (and should) be a
1271character that is used to select that tag through the fast-tag-selection
1272interface. See the manual for details."
1273 :group 'org-tags
1274 :type '(repeat
1275 (choice
1276 (cons (string :tag "Tag name")
1277 (character :tag "Access char"))
1278 (const :tag "Start radio group" (:startgroup))
1279 (const :tag "End radio group" (:endgroup)))))
1280
1281(defcustom org-use-fast-tag-selection 'auto
1282 "Non-nil means, use fast tag selection scheme.
1283This is a special interface to select and deselect tags with single keys.
1284When nil, fast selection is never used.
1285When the symbol `auto', fast selection is used if and only if selection
1286characters for tags have been configured, either through the variable
1287`org-tag-alist' or through a #+TAGS line in the buffer.
1288When t, fast selection is always used and selection keys are assigned
1289automatically if necessary."
1290 :group 'org-tags
1291 :type '(choice
1292 (const :tag "Always" t)
1293 (const :tag "Never" nil)
1294 (const :tag "When selection characters are configured" 'auto)))
1295
1152(defcustom org-tags-column 48 1296(defcustom org-tags-column 48
1153 "The column to which tags should be indented in a headline. 1297 "The column to which tags should be indented in a headline.
1154If this number is positive, it specifies the column. If it is negative, 1298If this number is positive, it specifies the column. If it is negative,
@@ -1234,6 +1378,7 @@ key The key (a single char as a string) to be associated with the command.
1234type The command type, any of the following symbols: 1378type The command type, any of the following symbols:
1235 todo Entries with a specific TODO keyword, in all agenda files. 1379 todo Entries with a specific TODO keyword, in all agenda files.
1236 tags Tags match in all agenda files. 1380 tags Tags match in all agenda files.
1381 tags-todo Tags match in all agenda files, TODO entries only.
1237 todo-tree Sparse tree of specific TODO keyword in *current* file. 1382 todo-tree Sparse tree of specific TODO keyword in *current* file.
1238 tags-tree Sparse tree with all tags matches in *current* file. 1383 tags-tree Sparse tree with all tags matches in *current* file.
1239 occur-tree Occur sparse tree for current file. 1384 occur-tree Occur sparse tree for current file.
@@ -1246,13 +1391,30 @@ match What to search for:
1246 (list (string :tag "Key") 1391 (list (string :tag "Key")
1247 (choice :tag "Type" 1392 (choice :tag "Type"
1248 (const :tag "Tags search in all agenda files" tags) 1393 (const :tag "Tags search in all agenda files" tags)
1394 (const :tag "Tags search of TODO entries, all agenda files" tags-todo)
1249 (const :tag "TODO keyword search in all agenda files" todo) 1395 (const :tag "TODO keyword search in all agenda files" todo)
1250 (const :tag "Tags sparse tree in current buffer" tags-tree) 1396 (const :tag "Tags sparse tree in current buffer" tags-tree)
1251 (const :tag "TODO keyword tree in current buffer" todo-tree) 1397 (const :tag "TODO keyword tree in current buffer" todo-tree)
1252 (const :tag "Occur tree in current buffer" occur-tree)) 1398 (const :tag "Occur tree in current buffer" occur-tree))
1253 (string :tag "Match")))) 1399 (string :tag "Match"))))
1254 1400
1255(defcustom org-agenda-include-all-todo t 1401(defcustom org-agenda-todo-list-sublevels t
1402 "Non-nil means, check also the sublevels of a TODO entry for TODO entries.
1403When nil, the sublevels of a TODO entry are not checked, resulting in
1404potentially much shorter TODO lists."
1405 :group 'org-agenda
1406 :group 'org-todo
1407 :type 'boolean)
1408
1409(defcustom org-agenda-todo-ignore-scheduled nil
1410 "Non-nil means, don't show scheduled entries in the global todo list.
1411The idea behind this is that by scheduling it, you have already taken care
1412of this item."
1413 :group 'org-agenda
1414 :group 'org-todo
1415 :type 'boolean)
1416
1417(defcustom org-agenda-include-all-todo nil
1256 "Non-nil means, the agenda will always contain all TODO entries. 1418 "Non-nil means, the agenda will always contain all TODO entries.
1257When nil, date-less entries will only be shown if `org-agenda' is called 1419When nil, date-less entries will only be shown if `org-agenda' is called
1258with a prefix argument. 1420with a prefix argument.
@@ -1274,7 +1436,7 @@ forth between agenda and calendar."
1274 :group 'org-agenda 1436 :group 'org-agenda
1275 :type 'sexp) 1437 :type 'sexp)
1276 1438
1277(defgroup org-agenda-window-setup nil 1439(defgroup org-agenda-setup nil
1278 "Options concerning setting up the Agenda window in Org Mode." 1440 "Options concerning setting up the Agenda window in Org Mode."
1279 :tag "Org Agenda Window Setup" 1441 :tag "Org Agenda Window Setup"
1280 :group 'org-agenda) 1442 :group 'org-agenda)
@@ -1286,9 +1448,8 @@ Needs to be set before org.el is loaded."
1286 :group 'org-agenda-setup 1448 :group 'org-agenda-setup
1287 :type 'boolean) 1449 :type 'boolean)
1288 1450
1289(defcustom org-select-timeline-window t 1451(defcustom org-agenda-start-with-follow-mode nil
1290 "Non-nil means, after creating a timeline, move cursor into Timeline window. 1452 "The initial value of follwo-mode in a newly created agenda window."
1291When nil, cursor will remain in the current window."
1292 :group 'org-agenda-setup 1453 :group 'org-agenda-setup
1293 :type 'boolean) 1454 :type 'boolean)
1294 1455
@@ -1411,7 +1572,7 @@ categories by priority."
1411(defcustom org-sort-agenda-notime-is-late t 1572(defcustom org-sort-agenda-notime-is-late t
1412 "Non-nil means, items without time are considered late. 1573 "Non-nil means, items without time are considered late.
1413This is only relevant for sorting. When t, items which have no explicit 1574This is only relevant for sorting. When t, items which have no explicit
1414time like 15:30 will be considered as 24:01, i.e. later than any items which 1575time like 15:30 will be considered as 99:01, i.e. later than any items which
1415do have a time. When nil, the default time is before 0:00. You can use this 1576do have a time. When nil, the default time is before 0:00. You can use this
1416option to decide if the schedule for today should come before or after timeless 1577option to decide if the schedule for today should come before or after timeless
1417agenda entries." 1578agenda entries."
@@ -1472,17 +1633,11 @@ See also the variables `org-agenda-remove-times-when-in-prefix' and
1472 :type 'string 1633 :type 'string
1473 :group 'org-agenda-prefix) 1634 :group 'org-agenda-prefix)
1474 1635
1475(defcustom org-timeline-prefix-format " % s"
1476 "Like `org-agenda-prefix-format', but for the timeline of a single file."
1477 :type 'string
1478 :group 'org-agenda-prefix)
1479
1480(defvar org-prefix-format-compiled nil 1636(defvar org-prefix-format-compiled nil
1481 "The compiled version of the most recently used prefix format. 1637 "The compiled version of the most recently used prefix format.
1482Depending on which command was used last, this may be the compiled version 1638Depending on which command was used last, this may be the compiled version
1483of `org-agenda-prefix-format' or `org-timeline-prefix-format'.") 1639of `org-agenda-prefix-format' or `org-timeline-prefix-format'.")
1484 1640
1485;; FIXME: There seem to be situations where this does no work.
1486(defcustom org-agenda-remove-times-when-in-prefix t 1641(defcustom org-agenda-remove-times-when-in-prefix t
1487 "Non-nil means, remove duplicate time specifications in agenda items. 1642 "Non-nil means, remove duplicate time specifications in agenda items.
1488When the format `org-agenda-prefix-format' contains a `%t' specifier, a 1643When the format `org-agenda-prefix-format' contains a `%t' specifier, a
@@ -1510,6 +1665,34 @@ When this is the symbol `prefix', only remove tags when
1510 (const :tag "Never" nil) 1665 (const :tag "Never" nil)
1511 (const :tag "When prefix format contains %T" prefix))) 1666 (const :tag "When prefix format contains %T" prefix)))
1512 1667
1668(defgroup org-agenda-timeline nil
1669 "Options concerning the timeline buffer in Org Mode."
1670 :tag "Org Agenda Timeline"
1671 :group 'org-agenda)
1672
1673(defcustom org-timeline-prefix-format " % s"
1674 "Like `org-agenda-prefix-format', but for the timeline of a single file."
1675 :type 'string
1676 :group 'org-agenda-timeline)
1677
1678(defcustom org-select-timeline-window t
1679 "Non-nil means, after creating a timeline, move cursor into Timeline window.
1680When nil, cursor will remain in the current window."
1681 :group 'org-agenda-timeline
1682 :type 'boolean)
1683
1684(defcustom org-timeline-show-empty-dates 3
1685 "Non-nil means, `org-timeline' also shows dates without an entry.
1686When nil, only the days which actually have entries are shown.
1687When t, all days between the first and the last date are shown.
1688When an integer, show also empty dates, but if there is a gap of more than
1689N days, just insert a special line indicating the size of the gap."
1690 :group 'org-agenda-timeline
1691 :type '(choice
1692 (const :tag "None" nil)
1693 (const :tag "All" t)
1694 (number :tag "at most")))
1695
1513(defgroup org-export nil 1696(defgroup org-export nil
1514 "Options for exporting org-listings." 1697 "Options for exporting org-listings."
1515 :tag "Org Export" 1698 :tag "Org Export"
@@ -1520,6 +1703,23 @@ When this is the symbol `prefix', only remove tags when
1520 :tag "Org Export General" 1703 :tag "Org Export General"
1521 :group 'org-export) 1704 :group 'org-export)
1522 1705
1706(defcustom org-export-publishing-directory "."
1707 "Path to the location where exported files should be located.
1708This path may be relative to the directory where the Org-mode file lives.
1709The default is to put them into the same directory as the Org-mode file.
1710The variable may also be an alist with export types `:html', `:ascii',
1711`:ical', or `:xoxo' and the corresponding directories. If a direcoty path
1712is relative, it is interpreted relative to the directory where the exported
1713Org-mode files lives."
1714 :group 'org-export-general
1715 :type '(choice
1716 (directory)
1717 (repeat
1718 (cons
1719 (choice :tag "Type"
1720 (const :html) (const :ascii) (const :ical) (const :xoxo))
1721 (directory)))))
1722
1523(defcustom org-export-language-setup 1723(defcustom org-export-language-setup
1524 '(("en" "Author" "Date" "Table of Contents") 1724 '(("en" "Author" "Date" "Table of Contents")
1525 ("da" "Ophavsmand" "Dato" "Indhold") 1725 ("da" "Ophavsmand" "Dato" "Indhold")
@@ -1591,6 +1791,21 @@ This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"."
1591 :group 'org-export-general 1791 :group 'org-export-general
1592 :type 'boolean) 1792 :type 'boolean)
1593 1793
1794(defcustom org-export-with-timestamps t
1795 "Nil means, do not export time stamps and associated keywords."
1796 :group 'org-export
1797 :type 'boolean)
1798
1799(defcustom org-export-with-tags t
1800 "Nil means, do not export tags, just remove them from headlines."
1801 :group 'org-export-general
1802 :type 'boolean)
1803
1804(defcustom org-export-with-timestamps t
1805 "Nil means, do not export timestamps and associated keywords."
1806 :group 'org-export-general
1807 :type 'boolean)
1808
1594(defgroup org-export-translation nil 1809(defgroup org-export-translation nil
1595 "Options for translating special ascii sequences for the export backends." 1810 "Options for translating special ascii sequences for the export backends."
1596 :tag "Org Export Translation" 1811 :tag "Org Export Translation"
@@ -1714,6 +1929,22 @@ much faster."
1714 :tag "Org Export ASCII" 1929 :tag "Org Export ASCII"
1715 :group 'org-export) 1930 :group 'org-export)
1716 1931
1932(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-)
1933 "Characters for underlining headings in ASCII export.
1934In the given sequence, these characters will be used for level 1, 2, ..."
1935 :group 'org-export-ascii
1936 :type '(repeat character))
1937
1938(defcustom org-export-ascii-bullets '(?* ?+ ?-)
1939 "Bullet characters for headlines converted to lists in ASCII export.
1940The first character is is used for the first lest level generated in this
1941way, and so on. If there are more levels than characters given here,
1942the list will be repeated.
1943Note that plain lists will keep the same bullets as the have in the
1944Org-mode file."
1945 :group 'org-export-ascii
1946 :type '(repeat character))
1947
1717(defcustom org-export-ascii-show-new-buffer t 1948(defcustom org-export-ascii-show-new-buffer t
1718 "Non-nil means, popup buffer containing the exported ASCII text. 1949 "Non-nil means, popup buffer containing the exported ASCII text.
1719Otherwise the buffer will just be saved to a file and stay hidden." 1950Otherwise the buffer will just be saved to a file and stay hidden."
@@ -1725,14 +1956,6 @@ Otherwise the buffer will just be saved to a file and stay hidden."
1725 :tag "Org Export XML" 1956 :tag "Org Export XML"
1726 :group 'org-export) 1957 :group 'org-export)
1727 1958
1728(defcustom org-export-xml-type 'xoxo ;kw, if we have only one.
1729 "The kind of XML to be produced by the XML exporter.
1730Allowed values are:
1731xoxo The XOXO exporter."
1732 :group 'org-export-xml
1733 :type '(choice
1734 (const :tag "XOXO" xoxo)))
1735
1736(defgroup org-export-html nil 1959(defgroup org-export-html nil
1737 "Options specific for HTML export of Org-mode files." 1960 "Options specific for HTML export of Org-mode files."
1738 :tag "Org Export HTML" 1961 :tag "Org Export HTML"
@@ -1745,8 +1968,11 @@ xoxo The XOXO exporter."
1745 font-size: 12pt; 1968 font-size: 12pt;
1746 } 1969 }
1747 .title { text-align: center; } 1970 .title { text-align: center; }
1748 .todo, .deadline { color: red; } 1971 .todo { color: red; }
1749 .done { color: green; } 1972 .done { color: green; }
1973 .timestamp { color: grey }
1974 .timestamp-kwd { color: CadetBlue }
1975 .tag { background-color:lightblue; font-weight:normal }
1750 .target { background-color: lavender; } 1976 .target { background-color: lavender; }
1751 pre { 1977 pre {
1752 border: 1pt solid #AEBDCC; 1978 border: 1pt solid #AEBDCC;
@@ -1796,13 +2022,16 @@ When nil, the links still point to the plain `.org' file."
1796 :group 'org-export-html 2022 :group 'org-export-html
1797 :type 'boolean) 2023 :type 'boolean)
1798 2024
1799(defcustom org-export-html-inline-images t 2025(defcustom org-export-html-inline-images 'maybe
1800 "Non-nil means, inline images into exported HTML pages. 2026 "Non-nil means, inline images into exported HTML pages.
1801The link will still be to the original location of the image file. 2027This is done using an <img> tag. When nil, an anchor with href is used to
1802So if you are moving the page, lets say to your public HTML site, 2028link to the image. If this option is `maybe', then images in links with
1803you will have to move the image and maybe change the link." 2029an empty description will be inlined, while images with a description will
2030be linked only."
1804 :group 'org-export-html 2031 :group 'org-export-html
1805 :type 'boolean) 2032 :type '(choice (const :tag "Never" nil)
2033 (const :tag "Always" t)
2034 (const :tag "When there is no description" maybe)))
1806 2035
1807(defcustom org-export-html-expand t 2036(defcustom org-export-html-expand t
1808 "Non-nil means, for HTML export, treat @<...> as HTML tag. 2037 "Non-nil means, for HTML export, treat @<...> as HTML tag.
@@ -1814,7 +2043,7 @@ This option can also be set with the +OPTIONS line, e.g. \"@:nil\"."
1814 :type 'boolean) 2043 :type 'boolean)
1815 2044
1816(defcustom org-export-html-table-tag 2045(defcustom org-export-html-table-tag
1817 "<table border=1 cellspacing=0 cellpadding=6>" 2046 "<table border=\"1\" cellspacing=\"0\" cellpadding=\"6\">"
1818 "The HTML tag used to start a table. 2047 "The HTML tag used to start a table.
1819This must be a <table> tag, but you may change the options like 2048This must be a <table> tag, but you may change the options like
1820borders and spacing." 2049borders and spacing."
@@ -1829,7 +2058,7 @@ to a file."
1829 :type 'boolean) 2058 :type 'boolean)
1830 2059
1831(defcustom org-export-html-html-helper-timestamp 2060(defcustom org-export-html-html-helper-timestamp
1832 "<br><br><hr><p><!-- hhmts start --> <!-- hhmts end -->\n" 2061 "<br/><br/><hr><p><!-- hhmts start --> <!-- hhmts end --></p>\n"
1833 "The HTML tag used as timestamp delimiter for HTML-helper-mode." 2062 "The HTML tag used as timestamp delimiter for HTML-helper-mode."
1834 :group 'org-export-html 2063 :group 'org-export-html
1835 :type 'string) 2064 :type 'string)
@@ -1847,7 +2076,8 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1847 2076
1848(defcustom org-combined-agenda-icalendar-file "~/org.ics" 2077(defcustom org-combined-agenda-icalendar-file "~/org.ics"
1849 "The file name for the iCalendar file covering all agenda files. 2078 "The file name for the iCalendar file covering all agenda files.
1850This file is created with the command \\[org-export-icalendar-all-agenda-files]." 2079This file is created with the command \\[org-export-icalendar-all-agenda-files].
2080The file name should be absolute."
1851 :group 'org-export-icalendar 2081 :group 'org-export-icalendar
1852 :type 'file) 2082 :type 'file)
1853 2083
@@ -2003,7 +2233,7 @@ color of the frame."
2003 (org-compatible-face 2233 (org-compatible-face
2004 '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) 2234 '((((class color) (min-colors 16) (background light)) (:foreground "Orchid"))
2005 (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) 2235 (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue"))
2006 (((class color) (min-colors 8)) (:foreground "blue")))) ;; FIXME: for dark bg? 2236 (((class color) (min-colors 8)) (:foreground "blue"))))
2007 "Face used for level 7 headlines." 2237 "Face used for level 7 headlines."
2008 :group 'org-faces) 2238 :group 'org-faces)
2009 2239
@@ -2120,11 +2350,21 @@ This face is only used if `org-fontify-done-headline' is set."
2120 "Face for items scheduled previously, and not yet done." 2350 "Face for items scheduled previously, and not yet done."
2121 :group 'org-faces) 2351 :group 'org-faces)
2122 2352
2353(defface org-upcoming-deadline
2354 (org-compatible-face
2355 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
2356 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
2357 (((class color) (min-colors 8) (background light)) (:foreground "red"))
2358 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
2359 (t (:bold t))))
2360 "Face for items scheduled previously, and not yet done."
2361 :group 'org-faces)
2362
2123(defface org-time-grid ;; font-lock-variable-name-face 2363(defface org-time-grid ;; font-lock-variable-name-face
2124 (org-compatible-face 2364 (org-compatible-face
2125 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) 2365 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
2126 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) 2366 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
2127 (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) ; FIXME: turn off??? 2367 (((class color) (min-colors 8)) (:foreground "yellow" :weight light))))
2128 "Face used for time grids." 2368 "Face used for time grids."
2129 :group 'org-faces) 2369 :group 'org-faces)
2130 2370
@@ -2163,6 +2403,10 @@ This face is only used if `org-fontify-done-headline' is set."
2163(defvar org-todo-line-regexp nil 2403(defvar org-todo-line-regexp nil
2164 "Matches a headline and puts TODO state into group 2 if present.") 2404 "Matches a headline and puts TODO state into group 2 if present.")
2165(make-variable-buffer-local 'org-todo-line-regexp) 2405(make-variable-buffer-local 'org-todo-line-regexp)
2406(defvar org-todo-line-tags-regexp nil
2407 "Matches a headline and puts TODO state into group 2 if present.
2408Also put tags into group 4 if tags are present.")
2409(make-variable-buffer-local 'org-todo-line-tags-regexp)
2166(defvar org-nl-done-regexp nil 2410(defvar org-nl-done-regexp nil
2167 "Matches newline followed by a headline with the DONE keyword.") 2411 "Matches newline followed by a headline with the DONE keyword.")
2168(make-variable-buffer-local 'org-nl-done-regexp) 2412(make-variable-buffer-local 'org-nl-done-regexp)
@@ -2193,21 +2437,46 @@ This face is only used if `org-fontify-done-headline' is set."
2193(defvar org-scheduled-time-regexp nil 2437(defvar org-scheduled-time-regexp nil
2194 "Matches the SCHEDULED keyword together with a time stamp.") 2438 "Matches the SCHEDULED keyword together with a time stamp.")
2195(make-variable-buffer-local 'org-scheduled-time-regexp) 2439(make-variable-buffer-local 'org-scheduled-time-regexp)
2440(defvar org-closed-time-regexp nil
2441 "Matches the CLOSED keyword together with a time stamp.")
2442(make-variable-buffer-local 'org-closed-time-regexp)
2443
2444(defvar org-keyword-time-regexp nil
2445 "Matches any of the 3 keywords, together with the time stamp.")
2446(make-variable-buffer-local 'org-keyword-time-regexp)
2447(defvar org-maybe-keyword-time-regexp nil
2448 "Matches a timestamp, possibly preceeded by a keyword.")
2449(make-variable-buffer-local 'org-keyword-time-regexp)
2450
2451(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
2452 mouse-map t)
2453 "Properties to remove when a string without properties is wanted.")
2454
2455(defsubst org-match-string-no-properties (num &optional string)
2456 (if (featurep 'xemacs)
2457 (let ((s (match-string num string)))
2458 (remove-text-properties 0 (length s) org-rm-props s)
2459 s)
2460 (match-string-no-properties num string)))
2461
2462(defsubst org-no-properties (s)
2463 (remove-text-properties 0 (length s) org-rm-props s)
2464 s)
2196 2465
2197(defun org-set-regexps-and-options () 2466(defun org-set-regexps-and-options ()
2198 "Precompute regular expressions for current buffer." 2467 "Precompute regular expressions for current buffer."
2199 (when (eq major-mode 'org-mode) 2468 (when (eq major-mode 'org-mode)
2200 (let ((re (org-make-options-regexp 2469 (let ((re (org-make-options-regexp
2201 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" 2470 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO"
2202 "STARTUP" "ARCHIVE"))) 2471 "STARTUP" "ARCHIVE" "TAGS")))
2203 (splitre "[ \t]+") 2472 (splitre "[ \t]+")
2204 kwds int key value cat arch) 2473 kwds int key value cat arch tags)
2205 (save-excursion 2474 (save-excursion
2206 (save-restriction 2475 (save-restriction
2207 (widen) 2476 (widen)
2208 (goto-char (point-min)) 2477 (goto-char (point-min))
2209 (while (re-search-forward re nil t) 2478 (while (re-search-forward re nil t)
2210 (setq key (match-string 1) value (match-string 2)) 2479 (setq key (match-string 1) value (org-match-string-no-properties 2))
2211 (cond 2480 (cond
2212 ((equal key "CATEGORY") 2481 ((equal key "CATEGORY")
2213 (if (string-match "[ \t]+$" value) 2482 (if (string-match "[ \t]+$" value)
@@ -2222,6 +2491,8 @@ This face is only used if `org-fontify-done-headline' is set."
2222 ((equal key "TYP_TODO") 2491 ((equal key "TYP_TODO")
2223 (setq int 'type 2492 (setq int 'type
2224 kwds (append kwds (org-split-string value splitre)))) 2493 kwds (append kwds (org-split-string value splitre))))
2494 ((equal key "TAGS")
2495 (setq tags (append tags (org-split-string value splitre))))
2225 ((equal key "STARTUP") 2496 ((equal key "STARTUP")
2226 (let ((opts (org-split-string value splitre)) 2497 (let ((opts (org-split-string value splitre))
2227 (set '(("fold" org-startup-folded t) 2498 (set '(("fold" org-startup-folded t)
@@ -2235,6 +2506,8 @@ This face is only used if `org-fontify-done-headline' is set."
2235 ("oddeven" org-odd-levels-only nil) 2506 ("oddeven" org-odd-levels-only nil)
2236 ("align" org-startup-align-all-tables t) 2507 ("align" org-startup-align-all-tables t)
2237 ("noalign" org-startup-align-all-tables nil) 2508 ("noalign" org-startup-align-all-tables nil)
2509 ("logging" org-log-done t)
2510 ("nologging" org-log-done nil)
2238 ("dlcheck" org-startup-with-deadline-check t) 2511 ("dlcheck" org-startup-with-deadline-check t)
2239 ("nodlcheck" org-startup-with-deadline-check nil))) 2512 ("nodlcheck" org-startup-with-deadline-check nil)))
2240 l var val) 2513 l var val)
@@ -2250,7 +2523,24 @@ This face is only used if `org-fontify-done-headline' is set."
2250 (and cat (set (make-local-variable 'org-category) cat)) 2523 (and cat (set (make-local-variable 'org-category) cat))
2251 (and kwds (set (make-local-variable 'org-todo-keywords) kwds)) 2524 (and kwds (set (make-local-variable 'org-todo-keywords) kwds))
2252 (and arch (set (make-local-variable 'org-archive-location) arch)) 2525 (and arch (set (make-local-variable 'org-archive-location) arch))
2253 (and int (set (make-local-variable 'org-todo-interpretation) int))) 2526 (and int (set (make-local-variable 'org-todo-interpretation) int))
2527 (when tags
2528 (let (e tg c tgs)
2529 (while (setq e (pop tags))
2530 (cond
2531 ((equal e "{") (push '(:startgroup) tgs))
2532 ((equal e "}") (push '(:endgroup) tgs))
2533 ((string-match "^\\([0-9a-zA-Z_@]+\\)(\\(.\\))$" e)
2534 (push (cons (match-string 1 e)
2535 (string-to-char (match-string 2 e)))
2536 tgs))
2537 (t (push (list e) tgs))))
2538 (set (make-local-variable 'org-tag-alist) nil)
2539 (while (setq e (pop tgs))
2540 (or (and (stringp (car e))
2541 (assoc (car e) org-tag-alist))
2542 (push e org-tag-alist))))))
2543
2254 ;; Compute the regular expressions and other local variables 2544 ;; Compute the regular expressions and other local variables
2255 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) 2545 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority)
2256 org-todo-kwd-max-priority (1- (length org-todo-keywords)) 2546 org-todo-kwd-max-priority (1- (length org-todo-keywords))
@@ -2273,6 +2563,10 @@ This face is only used if `org-fontify-done-headline' is set."
2273 "\\)? *\\(.*\\)") 2563 "\\)? *\\(.*\\)")
2274 org-nl-done-regexp 2564 org-nl-done-regexp
2275 (concat "[\r\n]\\*+[ \t]+" org-done-string "\\>") 2565 (concat "[\r\n]\\*+[ \t]+" org-done-string "\\>")
2566 org-todo-line-tags-regexp
2567 (concat "^\\(\\*+\\)[ \t]*\\("
2568 (mapconcat 'regexp-quote org-todo-keywords "\\|")
2569 "\\)? *\\(.*?\\([ \t]:[a-zA-Z0-9:_@]+:[ \t]*\\)?$\\)")
2276 org-looking-at-done-regexp (concat "^" org-done-string "\\>") 2570 org-looking-at-done-regexp (concat "^" org-done-string "\\>")
2277 org-deadline-regexp (concat "\\<" org-deadline-string) 2571 org-deadline-regexp (concat "\\<" org-deadline-string)
2278 org-deadline-time-regexp 2572 org-deadline-time-regexp
@@ -2282,11 +2576,27 @@ This face is only used if `org-fontify-done-headline' is set."
2282 org-scheduled-regexp 2576 org-scheduled-regexp
2283 (concat "\\<" org-scheduled-string) 2577 (concat "\\<" org-scheduled-string)
2284 org-scheduled-time-regexp 2578 org-scheduled-time-regexp
2285 (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) 2579 (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
2580 org-closed-time-regexp
2581 (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
2582 org-keyword-time-regexp
2583 (concat "\\<\\(" org-scheduled-string
2584 "\\|" org-deadline-string
2585 "\\|" org-closed-string "\\)"
2586 " *[[<]\\([^]>]+\\)[]>]")
2587 org-maybe-keyword-time-regexp
2588 (concat "\\(\\<\\(" org-scheduled-string
2589 "\\|" org-deadline-string
2590 "\\|" org-closed-string "\\)\\)?"
2591 " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*?[]>]\\)"))
2592
2286 (org-set-font-lock-defaults))) 2593 (org-set-font-lock-defaults)))
2287 2594
2288;; Tell the compiler about dynamically scoped variables, 2595;; Tell the compiler about dynamically scoped variables,
2289;; and variables from other packages 2596;; and variables from other packages
2597(defvar calc-embedded-close-formula) ; defined by the calc package
2598(defvar calc-embedded-open-formula) ; defined by the calc package
2599(defvar font-lock-unfontify-region-function) ; defined by font-lock.el
2290(defvar zmacs-regions) ; XEmacs regions 2600(defvar zmacs-regions) ; XEmacs regions
2291(defvar original-date) ; dynamically scoped in calendar 2601(defvar original-date) ; dynamically scoped in calendar
2292(defvar org-old-auto-fill-inhibit-regexp) ; local variable used by `orgtbl-mode' 2602(defvar org-old-auto-fill-inhibit-regexp) ; local variable used by `orgtbl-mode'
@@ -2298,14 +2608,9 @@ This face is only used if `org-fontify-done-headline' is set."
2298(defvar mark-active) ; Emacs only, not available in XEmacs. 2608(defvar mark-active) ; Emacs only, not available in XEmacs.
2299(defvar timecnt) ; dynamically scoped parameter 2609(defvar timecnt) ; dynamically scoped parameter
2300(defvar levels-open) ; dynamically scoped parameter 2610(defvar levels-open) ; dynamically scoped parameter
2301(defvar title) ; dynamically scoped parameter
2302(defvar author) ; dynamically scoped parameter
2303(defvar email) ; dynamically scoped parameter
2304(defvar text) ; dynamically scoped parameter
2305(defvar entry) ; dynamically scoped parameter 2611(defvar entry) ; dynamically scoped parameter
2306(defvar date) ; dynamically scoped parameter 2612(defvar date) ; dynamically scoped parameter
2307(defvar language) ; dynamically scoped parameter 2613(defvar description) ; dynamically scoped parameter
2308(defvar options) ; dynamically scoped parameter
2309(defvar ans1) ; dynamically scoped parameter 2614(defvar ans1) ; dynamically scoped parameter
2310(defvar ans2) ; dynamically scoped parameter 2615(defvar ans2) ; dynamically scoped parameter
2311(defvar starting-day) ; local variable 2616(defvar starting-day) ; local variable
@@ -2330,6 +2635,9 @@ This face is only used if `org-fontify-done-headline' is set."
2330(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' 2635(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
2331(defvar initial) ; from remember.el, dynamically scoped in `remember-mode' 2636(defvar initial) ; from remember.el, dynamically scoped in `remember-mode'
2332(defvar orgtbl-mode) ; defined later in this file 2637(defvar orgtbl-mode) ; defined later in this file
2638(defvar Info-current-file) ; from info.el
2639(defvar Info-current-node) ; from info.el
2640
2333;;; Define the mode 2641;;; Define the mode
2334 2642
2335(defvar org-mode-map 2643(defvar org-mode-map
@@ -2372,11 +2680,31 @@ can be exported as a structured ASCII or HTML file.
2372The following commands are available: 2680The following commands are available:
2373 2681
2374\\{org-mode-map}" 2682\\{org-mode-map}"
2683
2684 ;; Get rid of Outline menus, they are not needed
2685 ;; Need to do this here because define-derived-mode sets up
2686 ;; the keymap so late.
2687 (if (featurep 'xemacs)
2688 (if org-noutline-p
2689 (progn
2690 (easy-menu-remove outline-mode-menu-heading)
2691 (easy-menu-remove outline-mode-menu-show)
2692 (easy-menu-remove outline-mode-menu-hide))
2693 (delete-menu-item '("Headings"))
2694 (delete-menu-item '("Show"))
2695 (delete-menu-item '("Hide"))
2696 (set-menubar-dirty-flag))
2697 (define-key org-mode-map [menu-bar headings] 'undefined)
2698 (define-key org-mode-map [menu-bar hide] 'undefined)
2699 (define-key org-mode-map [menu-bar show] 'undefined))
2700
2375 (easy-menu-add org-org-menu) 2701 (easy-menu-add org-org-menu)
2376 (easy-menu-add org-tbl-menu) 2702 (easy-menu-add org-tbl-menu)
2377 (org-install-agenda-files-menu) 2703 (org-install-agenda-files-menu)
2378 (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) 2704 (if org-descriptive-links (org-add-to-invisibility-spec '(org-link)))
2379 (org-add-to-invisibility-spec '(org-cwidth)) 2705 (org-add-to-invisibility-spec '(org-cwidth))
2706 (when (featurep 'xemacs)
2707 (set (make-local-variable 'line-move-ignore-invisible) t))
2380 (setq outline-regexp "\\*+") 2708 (setq outline-regexp "\\*+")
2381 ;;(setq outline-regexp "\\(?:\\*+\\|[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\) \\)") 2709 ;;(setq outline-regexp "\\(?:\\*+\\|[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\) \\)")
2382 (setq outline-level 'org-outline-level) 2710 (setq outline-level 'org-outline-level)
@@ -2405,19 +2733,6 @@ The following commands are available:
2405 (= (point-min) (point-max))) 2733 (= (point-min) (point-max)))
2406 (insert " -*- mode: org -*-\n\n")) 2734 (insert " -*- mode: org -*-\n\n"))
2407 2735
2408 ;; Get rid of Outline menus, they are not needed
2409 ;; Need to do this here because define-derived-mode sets up
2410 ;; the keymap so late.
2411 (if (featurep 'xemacs)
2412 (progn
2413 (delete-menu-item '("Headings"))
2414 (delete-menu-item '("Show"))
2415 (delete-menu-item '("Hide"))
2416 (set-menubar-dirty-flag))
2417 (define-key org-mode-map [menu-bar headings] 'undefined)
2418 (define-key org-mode-map [menu-bar hide] 'undefined)
2419 (define-key org-mode-map [menu-bar show] 'undefined))
2420
2421 (unless org-inhibit-startup 2736 (unless org-inhibit-startup
2422 (if org-startup-align-all-tables 2737 (if org-startup-align-all-tables
2423 (org-table-map-tables 'org-table-align)) 2738 (org-table-map-tables 'org-table-align))
@@ -2430,24 +2745,13 @@ The following commands are available:
2430 (let ((this-command 'org-cycle) (last-command 'org-cycle)) 2745 (let ((this-command 'org-cycle) (last-command 'org-cycle))
2431 (org-cycle '(4)) (org-cycle '(4)))))))) 2746 (org-cycle '(4)) (org-cycle '(4))))))))
2432 2747
2748(defsubst org-call-with-arg (command arg)
2749 "Call COMMAND interactively, but pretend prefix are was ARG."
2750 (let ((current-prefix-arg arg)) (call-interactively command)))
2751
2433(defsubst org-current-line (&optional pos) 2752(defsubst org-current-line (&optional pos)
2434 (+ (if (bolp) 1 0) (count-lines (point-min) (or pos (point))))) 2753 (+ (if (bolp) 1 0) (count-lines (point-min) (or pos (point)))))
2435 2754
2436(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
2437 mouse-map t)
2438 "Properties to remove when a string without properties is wanted.")
2439
2440(defsubst org-match-string-no-properties (num &optional string)
2441 (if (featurep 'xemacs)
2442 (let ((s (match-string num string)))
2443 (remove-text-properties 0 (length s) org-rm-props s)
2444 s)
2445 (match-string-no-properties num string)))
2446
2447(defsubst org-no-properties (s)
2448 (remove-text-properties 0 (length s) org-rm-props s)
2449 s)
2450
2451(defun org-current-time () 2755(defun org-current-time ()
2452 "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." 2756 "Current time, possibly rounded to `org-time-stamp-rounding-minutes'."
2453 (if (> org-time-stamp-rounding-minutes 0) 2757 (if (> org-time-stamp-rounding-minutes 0)
@@ -2488,7 +2792,7 @@ that will be added to PLIST. Returns the string that was modified."
2488 2792
2489(defconst org-non-link-chars "]\t\n\r<>") 2793(defconst org-non-link-chars "]\t\n\r<>")
2490(defconst org-link-types '("https?" "ftp" "mailto" "file" "news" "bbdb" "vm" 2794(defconst org-link-types '("https?" "ftp" "mailto" "file" "news" "bbdb" "vm"
2491 "wl" "mhe" "rmail" "gnus" "shell")) 2795 "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp"))
2492(defconst org-link-re-with-space 2796(defconst org-link-re-with-space
2493 (concat 2797 (concat
2494 "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" 2798 "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
@@ -2581,6 +2885,8 @@ that will be added to PLIST. Returns the string that was modified."
2581 (let* ((help (concat "LINK: " 2885 (let* ((help (concat "LINK: "
2582 (org-match-string-no-properties 1))) 2886 (org-match-string-no-properties 1)))
2583 ;; FIXME: above we should remove the escapes. 2887 ;; FIXME: above we should remove the escapes.
2888 ;; but that requires another match, protecting match data,
2889 ;; a lot of overhead for font-lock.
2584 (ip (list 'invisible 'org-link 'intangible t 'rear-nonsticky t 2890 (ip (list 'invisible 'org-link 'intangible t 'rear-nonsticky t
2585 'keymap org-mouse-map 'mouse-face 'highlight 2891 'keymap org-mouse-map 'mouse-face 'highlight
2586 'help-echo help)) 2892 'help-echo help))
@@ -2719,11 +3025,13 @@ between words."
2719 (let* ((em org-fontify-emphasized-text) 3025 (let* ((em org-fontify-emphasized-text)
2720 (lk org-activate-links) 3026 (lk org-activate-links)
2721 (org-font-lock-extra-keywords 3027 (org-font-lock-extra-keywords
3028 ;; Headlines
2722 (list 3029 (list
2723 '("^\\(\\**\\)\\(\\*\\)\\(.*\\)" (1 (org-get-level-face 1)) 3030 '("^\\(\\**\\)\\(\\*\\)\\(.*\\)" (1 (org-get-level-face 1))
2724 (2 (org-get-level-face 2)) (3 (org-get-level-face 3))) 3031 (2 (org-get-level-face 2)) (3 (org-get-level-face 3)))
2725 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 3032 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
2726 (1 'org-table)) 3033 (1 'org-table))
3034 ;; Links
2727 (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) 3035 (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
2728 (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) 3036 (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t)))
2729 (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) 3037 (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
@@ -2733,27 +3041,34 @@ between words."
2733 (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) 3041 (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
2734 (if org-table-limit-column-width 3042 (if org-table-limit-column-width
2735 '(org-hide-wide-columns (0 nil append))) 3043 '(org-hide-wide-columns (0 nil append)))
3044 ;; TODO lines
2736 (list (concat "^\\*+[ \t]*" org-not-done-regexp) 3045 (list (concat "^\\*+[ \t]*" org-not-done-regexp)
2737 '(1 'org-todo t)) 3046 '(1 'org-todo t))
3047 ;; Priorities
2738 (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t)) 3048 (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t))
3049 ;; Special keywords
2739 (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) 3050 (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
2740 (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) 3051 (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
2741 (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) 3052 (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
2742; (if em '("\\(\\W\\|^\\)\\(\\*\\w+\\*\\)\\(\\W\\|$\\)" 2 'bold prepend)) 3053 ;; Emphasis
2743; (if em '("\\(\\W\\|^\\)\\(/\\w+/\\)\\(\\W\\|$\\)" 2 'italic prepend))
2744; (if em '("\\(\\W\\|^\\)\\(_\\w+_\\)\\(\\W\\|$\\)" 2 'underline prepend))
2745 (if em (list org-bold-re 2 ''bold 'prepend)) 3054 (if em (list org-bold-re 2 ''bold 'prepend))
2746 (if em (list org-italic-re 2 ''italic 'prepend)) 3055 (if em (list org-italic-re 2 ''italic 'prepend))
2747 (if em (list org-underline-re 2 ''underline 'prepend)) 3056 (if em (list org-underline-re 2 ''underline 'prepend))
3057 ;; Checkboxes, similar to Frank Ruell's org-checklet.el
3058 '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
3059 2 'bold prepend)
3060 ;; COMMENT
2748 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string 3061 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string
2749 "\\|" org-quote-string "\\)\\>") 3062 "\\|" org-quote-string "\\)\\>")
2750 '(1 'org-special-keyword t)) 3063 '(1 'org-special-keyword t))
2751 '("^#.*" (0 'font-lock-comment-face t)) 3064 '("^#.*" (0 'font-lock-comment-face t))
3065 ;; DONE
2752 (if org-fontify-done-headline 3066 (if org-fontify-done-headline
2753 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") 3067 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>")
2754 '(1 'org-done t) '(2 'org-headline-done t)) 3068 '(1 'org-done t) '(2 'org-headline-done t))
2755 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") 3069 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>")
2756 '(1 'org-done t))) 3070 '(1 'org-done t)))
3071 ;; Table stuff
2757 '("^[ \t]*\\(:.*\\)" (1 'org-table t)) 3072 '("^[ \t]*\\(:.*\\)" (1 'org-table t))
2758 '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) 3073 '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
2759 '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) 3074 '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t))
@@ -2795,7 +3110,11 @@ between words."
2795;;; Visibility cycling 3110;;; Visibility cycling
2796 3111
2797(defvar org-cycle-global-status nil) 3112(defvar org-cycle-global-status nil)
3113(make-variable-buffer-local 'org-cycle-global-status)
2798(defvar org-cycle-subtree-status nil) 3114(defvar org-cycle-subtree-status nil)
3115(make-variable-buffer-local 'org-cycle-subtree-status)
3116
3117;;;###autoload
2799(defun org-cycle (&optional arg) 3118(defun org-cycle (&optional arg)
2800 "Visibility cycling for Org-mode. 3119 "Visibility cycling for Org-mode.
2801 3120
@@ -2825,15 +3144,18 @@ between words."
2825 no headline in line 1, this function will act as if called with prefix arg." 3144 no headline in line 1, this function will act as if called with prefix arg."
2826 (interactive "P") 3145 (interactive "P")
2827 3146
2828 (if (or (and (bobp) (not (looking-at outline-regexp))) 3147 (let* ((outline-regexp
2829 (equal arg '(4))) 3148 (if org-cycle-include-plain-lists
2830 ;; special case: use global cycling 3149 "\\*+\\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
2831 (setq arg t)) 3150 outline-regexp))
3151 (bob-special (and org-cycle-global-at-bob (bobp)
3152 (not (looking-at outline-regexp))))
3153 (org-cycle-hook (if bob-special nil org-cycle-hook))
3154 (pos (point)))
2832 3155
2833 (let ((outline-regexp 3156 (if (or bob-special (equal arg '(4)))
2834 (if org-cycle-include-plain-lists 3157 ;; special case: use global cycling
2835 "\\*+\\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " 3158 (setq arg t))
2836 outline-regexp)))
2837 3159
2838 (cond 3160 (cond
2839 3161
@@ -2843,7 +3165,7 @@ between words."
2843 (progn 3165 (progn
2844 (if arg (org-table-edit-field t) 3166 (if arg (org-table-edit-field t)
2845 (org-table-justify-field-maybe) 3167 (org-table-justify-field-maybe)
2846 (org-table-next-field))))) 3168 (call-interactively 'org-table-next-field)))))
2847 3169
2848 ((eq arg t) ;; Global cycling 3170 ((eq arg t) ;; Global cycling
2849 3171
@@ -2853,18 +3175,8 @@ between words."
2853 ;; We just created the overview - now do table of contents 3175 ;; We just created the overview - now do table of contents
2854 ;; This can be slow in very large buffers, so indicate action 3176 ;; This can be slow in very large buffers, so indicate action
2855 (message "CONTENTS...") 3177 (message "CONTENTS...")
2856 (save-excursion 3178 (org-content)
2857 ;; Visit all headings and show their offspring 3179 (message "CONTENTS...done")
2858 (goto-char (point-max))
2859 (catch 'exit
2860 (while (and (progn (condition-case nil
2861 (outline-previous-visible-heading 1)
2862 (error (goto-char (point-min))))
2863 t)
2864 (looking-at outline-regexp))
2865 (show-branches)
2866 (if (bobp) (throw 'exit nil))))
2867 (message "CONTENTS...done"))
2868 (setq org-cycle-global-status 'contents) 3180 (setq org-cycle-global-status 'contents)
2869 (run-hook-with-args 'org-cycle-hook 'contents)) 3181 (run-hook-with-args 'org-cycle-hook 'contents))
2870 3182
@@ -2878,7 +3190,7 @@ between words."
2878 3190
2879 (t 3191 (t
2880 ;; Default action: go to overview 3192 ;; Default action: go to overview
2881 (hide-sublevels 1) 3193 (org-overview)
2882 (message "OVERVIEW") 3194 (message "OVERVIEW")
2883 (setq org-cycle-global-status 'overview) 3195 (setq org-cycle-global-status 'overview)
2884 (run-hook-with-args 'org-cycle-hook 'overview)))) 3196 (run-hook-with-args 'org-cycle-hook 'overview))))
@@ -2908,10 +3220,10 @@ between words."
2908 (outline-next-heading)) 3220 (outline-next-heading))
2909 ;; Find out what to do next and set `this-command' 3221 ;; Find out what to do next and set `this-command'
2910 (cond 3222 (cond
2911 ((= eos eoh) 3223 ((and (= eos eoh)
2912 ;; Nothing is hidden behind this heading 3224 ;; Nothing is hidden behind this heading
2913 (message "EMPTY ENTRY") 3225 (message "EMPTY ENTRY")
2914 (setq org-cycle-subtree-status nil)) 3226 (setq org-cycle-subtree-status nil)))
2915 ((>= eol eos) 3227 ((>= eol eos)
2916 ;; Entire subtree is hidden in one line: open it 3228 ;; Entire subtree is hidden in one line: open it
2917 (org-show-entry) 3229 (org-show-entry)
@@ -2935,8 +3247,12 @@ between words."
2935 3247
2936 ;; TAB emulation 3248 ;; TAB emulation
2937 (buffer-read-only (org-back-to-heading)) 3249 (buffer-read-only (org-back-to-heading))
2938 ((if (and (eq org-cycle-emulate-tab 'white) 3250 ((if (and (memq org-cycle-emulate-tab '(white whitestart))
2939 (save-excursion (beginning-of-line 1) (looking-at "[ \t]+$"))) 3251 (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
3252 (or (and (eq org-cycle-emulate-tab 'white)
3253 (= (match-end 0) (point-at-eol)))
3254 (and (eq org-cycle-emulate-tab 'whitestart)
3255 (>= (match-end 0) pos))))
2940 t 3256 t
2941 (eq org-cycle-emulate-tab t)) 3257 (eq org-cycle-emulate-tab t))
2942 (if (and (looking-at "[ \n\r\t]") 3258 (if (and (looking-at "[ \n\r\t]")
@@ -2951,6 +3267,44 @@ between words."
2951 (org-back-to-heading) 3267 (org-back-to-heading)
2952 (org-cycle)))))) 3268 (org-cycle))))))
2953 3269
3270;;;###autoload
3271(defun org-global-cycle ()
3272 "Cycle the global visibility. For details see `org-cycle'."
3273 (interactive)
3274 (org-cycle '(4)))
3275
3276(defun org-overview ()
3277 "Switch to overview mode, shoing only top-level headlines.
3278Really, this shows all headlines with level equal or greater than the level
3279of the first headline in the buffer. This is important, because if the
3280first headline is not level one, then (hide-sublevels 1) gives confusing
3281results."
3282 (interactive)
3283 (hide-sublevels (save-excursion
3284 (goto-char (point-min))
3285 (if (re-search-forward (concat "^" outline-regexp) nil t)
3286 (progn
3287 (goto-char (match-beginning 0))
3288 (funcall outline-level))
3289 1))))
3290
3291;; FIXME: allow an argument to give a limiting level for this.
3292(defun org-content ()
3293 "Show all headlines in the buffer, like a table of contents"
3294 (interactive)
3295 (save-excursion
3296 ;; Visit all headings and show their offspring
3297 (goto-char (point-max))
3298 (catch 'exit
3299 (while (and (progn (condition-case nil
3300 (outline-previous-visible-heading 1)
3301 (error (goto-char (point-min))))
3302 t)
3303 (looking-at outline-regexp))
3304 (show-branches)
3305 (if (bobp) (throw 'exit nil))))))
3306
3307
2954(defun org-optimize-window-after-visibility-change (state) 3308(defun org-optimize-window-after-visibility-change (state)
2955 "Adjust the window after a change in outline visibility. 3309 "Adjust the window after a change in outline visibility.
2956This function is the default value of the hook `org-cycle-hook'." 3310This function is the default value of the hook `org-cycle-hook'."
@@ -3071,7 +3425,6 @@ or nil."
3071 (kill-buffer "*org-goto*") 3425 (kill-buffer "*org-goto*")
3072 org-selected-point)) 3426 org-selected-point))
3073 3427
3074;; FIXME: It may not be a good idea to temper with the prefix argument...
3075(defun org-goto-ret (&optional arg) 3428(defun org-goto-ret (&optional arg)
3076 "Finish `org-goto' by going to the new location." 3429 "Finish `org-goto' by going to the new location."
3077 (interactive "P") 3430 (interactive "P")
@@ -3114,26 +3467,36 @@ or nil."
3114 "To temporarily disable the active region.") 3467 "To temporarily disable the active region.")
3115 3468
3116(defun org-insert-heading (&optional force-heading) 3469(defun org-insert-heading (&optional force-heading)
3117 "Insert a new heading or item with same depth at point." 3470 "Insert a new heading or item with same depth at point.
3471If point is in a plain list and FORCE-HEADING is nil, create a new list item.
3472If point is at the beginning of a headline, insert a sibling before the
3473current headline. If point is in the middle of a headline, split the headline
3474at that position and make the rest of the headline part of the sibling below
3475the current headline."
3118 (interactive "P") 3476 (interactive "P")
3119 (when (or force-heading (not (org-insert-item))) 3477 (if (= (buffer-size) 0)
3120 (let* ((head (save-excursion 3478 (insert "\n* ")
3121 (condition-case nil 3479 (when (or force-heading (not (org-insert-item)))
3122 (org-back-to-heading) 3480 (let* ((head (save-excursion
3123 (error (outline-next-heading))) 3481 (condition-case nil
3124 (prog1 (match-string 0) 3482 (progn
3125 (funcall outline-level))))) 3483 (org-back-to-heading)
3126 (cond 3484 (match-string 0))
3127 ((and (org-on-heading-p) (bolp) 3485 (error "*"))))
3128 (save-excursion (backward-char 1) (not (org-invisible-p)))) 3486 pos)
3129 (open-line 1)) 3487 (cond
3130 ((bolp) nil) 3488 ((and (org-on-heading-p) (bolp)
3131 (t (newline))) 3489 (save-excursion (backward-char 1) (not (org-invisible-p))))
3132 (insert head) 3490 (open-line 1))
3133 (just-one-space) 3491 ((bolp) nil)
3134 (run-hooks 'org-insert-heading-hook)))) 3492 (t (newline)))
3135 3493 (insert head) (just-one-space)
3136(defun org-insert-item () 3494 (setq pos (point))
3495 (end-of-line 1)
3496 (unless (= (point) pos) (just-one-space) (backward-delete-char 1))
3497 (run-hooks 'org-insert-heading-hook)))))
3498
3499(defun org-insert-item (&optional checkbox)
3137 "Insert a new item at the current level. 3500 "Insert a new item at the current level.
3138Return t when things worked, nil when we are not in an item." 3501Return t when things worked, nil when we are not in an item."
3139 (when (save-excursion 3502 (when (save-excursion
@@ -3144,9 +3507,11 @@ Return t when things worked, nil when we are not in an item."
3144 t) 3507 t)
3145 (error nil))) 3508 (error nil)))
3146 (let* ((bul (match-string 0)) 3509 (let* ((bul (match-string 0))
3510 (end (match-end 0))
3147 (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") 3511 (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")
3148 (match-end 0))) 3512 (match-end 0)))
3149 (eowcol (save-excursion (goto-char eow) (current-column)))) 3513 (eowcol (save-excursion (goto-char eow) (current-column)))
3514 pos)
3150 (cond 3515 (cond
3151 ((and (org-at-item-p) (<= (point) eow)) 3516 ((and (org-at-item-p) (<= (point) eow))
3152 ;; before the bullet 3517 ;; before the bullet
@@ -3155,8 +3520,11 @@ Return t when things worked, nil when we are not in an item."
3155 ((<= (point) eow) 3520 ((<= (point) eow)
3156 (beginning-of-line 1)) 3521 (beginning-of-line 1))
3157 (t (newline))) 3522 (t (newline)))
3158 (insert bul) 3523 (insert bul (if checkbox "[ ]" ""))
3159 (just-one-space)) 3524 (just-one-space)
3525 (setq pos (point))
3526 (end-of-line 1)
3527 (unless (= (point) pos) (just-one-space) (backward-delete-char 1)))
3160 (org-maybe-renumber-ordered-list) 3528 (org-maybe-renumber-ordered-list)
3161 t)) 3529 t))
3162 3530
@@ -3165,16 +3533,19 @@ Return t when things worked, nil when we are not in an item."
3165If the heading has no TODO state, or if the state is DONE, use the first 3533If the heading has no TODO state, or if the state is DONE, use the first
3166state (TODO by default). Also with prefix arg, force first state." 3534state (TODO by default). Also with prefix arg, force first state."
3167 (interactive "P") 3535 (interactive "P")
3168 (org-insert-heading) 3536 (when (not (org-insert-item 'checkbox))
3169 (save-excursion 3537 (org-insert-heading)
3170 (org-back-to-heading) 3538 (save-excursion
3171 (outline-previous-heading) 3539 (org-back-to-heading)
3172 (looking-at org-todo-line-regexp)) 3540 (if org-noutline-p
3173 (if (or arg 3541 (outline-previous-heading)
3174 (not (match-beginning 2)) 3542 (outline-previous-visible-heading t))
3175 (equal (match-string 2) org-done-string)) 3543 (looking-at org-todo-line-regexp))
3176 (insert (car org-todo-keywords) " ") 3544 (if (or arg
3177 (insert (match-string 2) " "))) 3545 (not (match-beginning 2))
3546 (equal (match-string 2) org-done-string))
3547 (insert (car org-todo-keywords) " ")
3548 (insert (match-string 2) " "))))
3178 3549
3179(defun org-promote-subtree () 3550(defun org-promote-subtree ()
3180 "Promote the entire subtree. 3551 "Promote the entire subtree.
@@ -3408,7 +3779,7 @@ If optional TREE is given, use this text instead of the kill ring."
3408 (error 3779 (error
3409 (substitute-command-keys 3780 (substitute-command-keys
3410 "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) 3781 "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
3411 (let* ((txt (or tree (current-kill 0))) 3782 (let* ((txt (or tree (and kill-ring (current-kill 0))))
3412 (^re (concat "^\\(" outline-regexp "\\)")) 3783 (^re (concat "^\\(" outline-regexp "\\)"))
3413 (re (concat "\\(" outline-regexp "\\)")) 3784 (re (concat "\\(" outline-regexp "\\)"))
3414 (^re_ (concat "\\(" outline-regexp "\\)[ \t]*")) 3785 (^re_ (concat "\\(" outline-regexp "\\)[ \t]*"))
@@ -3457,8 +3828,12 @@ If optional TREE is given, use this text instead of the kill ring."
3457 (progn (insert "\n") (backward-char 1))) 3828 (progn (insert "\n") (backward-char 1)))
3458 ;; Paste 3829 ;; Paste
3459 (setq beg (point)) 3830 (setq beg (point))
3831 (if (string-match "[ \t\r\n]+\\'" txt)
3832 (setq txt (replace-match "\n" t t txt)))
3460 (insert txt) 3833 (insert txt)
3461 (setq end (point)) 3834 (setq end (point))
3835 (if (looking-at "[ \t\r\n]+")
3836 (replace-match "\n"))
3462 (goto-char beg) 3837 (goto-char beg)
3463 ;; Shift if necessary 3838 ;; Shift if necessary
3464 (if (= shift 0) 3839 (if (= shift 0)
@@ -3471,7 +3846,8 @@ If optional TREE is given, use this text instead of the kill ring."
3471 (goto-char (point-min)) 3846 (goto-char (point-min))
3472 (message "Pasted at level %d, with shift by %d levels" 3847 (message "Pasted at level %d, with shift by %d levels"
3473 new-level shift1))) 3848 new-level shift1)))
3474 (if (and (eq org-subtree-clip (current-kill 0)) 3849 (if (and kill-ring
3850 (eq org-subtree-clip (current-kill 0))
3475 org-subtree-clip-folded) 3851 org-subtree-clip-folded)
3476 ;; The tree was folded before it was killed/copied 3852 ;; The tree was folded before it was killed/copied
3477 (hide-subtree)))) 3853 (hide-subtree))))
@@ -3483,8 +3859,9 @@ headline level is not the largest headline level in the tree.
3483So this will actually accept several entries of equal levels as well, 3859So this will actually accept several entries of equal levels as well,
3484which is OK for `org-paste-subtree'. 3860which is OK for `org-paste-subtree'.
3485If optional TXT is given, check this string instead of the current kill." 3861If optional TXT is given, check this string instead of the current kill."
3486 (let* ((kill (or txt (current-kill 0) "")) 3862 (let* ((kill (or txt (and kill-ring (current-kill 0)) ""))
3487 (start-level (and (string-match (concat "\\`" outline-regexp) kill) 3863 (start-level (and kill
3864 (string-match (concat "\\`" outline-regexp) kill)
3488 (- (match-end 0) (match-beginning 0)))) 3865 (- (match-end 0) (match-beginning 0))))
3489 (re (concat "^" outline-regexp)) 3866 (re (concat "^" outline-regexp))
3490 (start 1)) 3867 (start 1))
@@ -3510,16 +3887,60 @@ If optional TXT is given, check this string instead of the current kill."
3510 ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") 3887 ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
3511 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) 3888 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))))))
3512 3889
3513(defun org-get-indentation () 3890(defun org-at-item-checkbox-p ()
3514 "Get the indentation of the current line, interpreting tabs." 3891 "Is point at a line starting a plain-list item with a checklet?"
3892 (and (org-at-item-p)
3893 (save-excursion
3894 (goto-char (match-end 0))
3895 (skip-chars-forward " \t")
3896 (looking-at "\\[[ X]\\]"))))
3897
3898(defun org-toggle-checkbox ()
3899 "Toggle the checkbox in the current line."
3900 (interactive)
3515 (save-excursion 3901 (save-excursion
3516 (beginning-of-line 1) 3902 (if (org-at-item-checkbox-p)
3517 (skip-chars-forward " \t") 3903 (replace-match (if (equal (match-string 0) "[ ]") "[X]" "[ ]") t t))))
3518 (current-column))) 3904
3905(defun org-get-indentation (&optional line)
3906 "Get the indentation of the current line, interpreting tabs.
3907When LINE is given, assume it represents a line and compute its indentation."
3908 (if line
3909 (if (string-match "^ *" (org-remove-tabs line))
3910 (match-end 0))
3911 (save-excursion
3912 (beginning-of-line 1)
3913 (skip-chars-forward " \t")
3914 (current-column))))
3915
3916(defun org-remove-tabs (s &optional width)
3917 "Replace tabulators in S with spaces.
3918Assumes that s is a single line, starting in column 0."
3919 (setq width (or width tab-width))
3920 (while (string-match "\t" s)
3921 (setq s (replace-match
3922 (make-string
3923 (- (* width (/ (+ (match-beginning 0) width) width))
3924 (match-beginning 0)) ?\ )
3925 t t s)))
3926 s)
3927
3928;; FIXME: document properly.
3929(defun org-fix-indentation (line ind)
3930 "If the current indenation is smaller than ind1, leave it alone.
3931If it is larger than ind, reduce it by ind."
3932 (let* ((l (org-remove-tabs line))
3933 (i (org-get-indentation l))
3934 (i1 (car ind)) (i2 (cdr ind)))
3935 (if (>= i i2) (setq l (substring line i2)))
3936 (if (> i1 0)
3937 (concat (make-string i1 ?\ ) l)
3938 l)))
3519 3939
3520(defun org-beginning-of-item () 3940(defun org-beginning-of-item ()
3521 "Go to the beginning of the current hand-formatted item. 3941 "Go to the beginning of the current hand-formatted item.
3522If the cursor is not in an item, throw an error." 3942If the cursor is not in an item, throw an error."
3943 (interactive)
3523 (let ((pos (point)) 3944 (let ((pos (point))
3524 (limit (save-excursion (org-back-to-heading) 3945 (limit (save-excursion (org-back-to-heading)
3525 (beginning-of-line 2) (point))) 3946 (beginning-of-line 2) (point)))
@@ -3545,6 +3966,7 @@ If the cursor is not in an item, throw an error."
3545(defun org-end-of-item () 3966(defun org-end-of-item ()
3546 "Go to the end of the current hand-formatted item. 3967 "Go to the end of the current hand-formatted item.
3547If the cursor is not in an item, throw an error." 3968If the cursor is not in an item, throw an error."
3969 (interactive)
3548 (let ((pos (point)) 3970 (let ((pos (point))
3549 (limit (save-excursion (outline-next-heading) (point))) 3971 (limit (save-excursion (outline-next-heading) (point)))
3550 (ind (save-excursion 3972 (ind (save-excursion
@@ -3564,11 +3986,47 @@ If the cursor is not in an item, throw an error."
3564 (goto-char pos) 3986 (goto-char pos)
3565 (error "Not in an item")))) 3987 (error "Not in an item"))))
3566 3988
3567(defun org-move-item-down (arg) 3989(defun org-next-item ()
3990 "Move to the beginning of the next item in the current plain list.
3991Error if not at a plain list, or if this is the last item in the list."
3992 (interactive)
3993 (let (beg end ind ind1 (pos (point)) txt)
3994 (org-beginning-of-item)
3995 (setq beg (point))
3996 (setq ind (org-get-indentation))
3997 (org-end-of-item)
3998 (setq end (point))
3999 (setq ind1 (org-get-indentation))
4000 (unless (and (org-at-item-p) (= ind ind1))
4001 (goto-char pos)
4002 (error "On last item"))))
4003
4004(defun org-previous-item ()
4005 "Move to the beginning of the previous item in the current plain list.
4006Error if not at a plain list, or if this is the last item in the list."
4007 (interactive)
4008 (let (beg end ind ind1 (pos (point)) txt)
4009 (org-beginning-of-item)
4010 (setq beg (point))
4011 (setq ind (org-get-indentation))
4012 (goto-char beg)
4013 (catch 'exit
4014 (while t
4015 (beginning-of-line 0)
4016 (if (looking-at "[ \t]*$")
4017 nil
4018 (if (<= (setq ind1 (org-get-indentation)) ind)
4019 (throw 'exit t)))))
4020 (condition-case nil
4021 (org-beginning-of-item)
4022 (error (goto-char pos)
4023 (error "On first item")))))
4024
4025(defun org-move-item-down ()
3568 "Move the plain list item at point down, i.e. swap with following item. 4026 "Move the plain list item at point down, i.e. swap with following item.
3569Subitems (items with larger indentation) are considered part of the item, 4027Subitems (items with larger indentation) are considered part of the item,
3570so this really moves item trees." 4028so this really moves item trees."
3571 (interactive "p") 4029 (interactive)
3572 (let (beg end ind ind1 (pos (point)) txt) 4030 (let (beg end ind ind1 (pos (point)) txt)
3573 (org-beginning-of-item) 4031 (org-beginning-of-item)
3574 (setq beg (point)) 4032 (setq beg (point))
@@ -3647,7 +4105,7 @@ doing the renumbering."
3647 4105
3648(defun org-renumber-ordered-list (arg) 4106(defun org-renumber-ordered-list (arg)
3649 "Renumber an ordered plain list. 4107 "Renumber an ordered plain list.
3650Cursor next to be in the first line of an item, the line that starts 4108Cursor needs to be in the first line of an item, the line that starts
3651with something like \"1.\" or \"2)\"." 4109with something like \"1.\" or \"2)\"."
3652 (interactive "p") 4110 (interactive "p")
3653 (unless (and (org-at-item-p) 4111 (unless (and (org-at-item-p)
@@ -3702,24 +4160,24 @@ with something like \"1.\" or \"2)\"."
3702 (interactive "p") 4160 (interactive "p")
3703 (unless (org-at-item-p) 4161 (unless (org-at-item-p)
3704 (error "Not on an item")) 4162 (error "Not on an item"))
3705 (let (beg end ind ind1) 4163 (save-excursion
3706 (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) 4164 (let (beg end ind ind1)
4165 (if (memq last-command '(org-shiftmetaright org-shiftmetaleft))
3707 (setq beg org-last-indent-begin-marker 4166 (setq beg org-last-indent-begin-marker
3708 end org-last-indent-end-marker) 4167 end org-last-indent-end-marker)
3709 (org-beginning-of-item) 4168 (org-beginning-of-item)
3710 (setq beg (move-marker org-last-indent-begin-marker (point))) 4169 (setq beg (move-marker org-last-indent-begin-marker (point)))
3711 (org-end-of-item) 4170 (org-end-of-item)
3712 (setq end (move-marker org-last-indent-end-marker (point)))) 4171 (setq end (move-marker org-last-indent-end-marker (point))))
3713 (goto-char beg) 4172 (goto-char beg)
3714 (skip-chars-forward " \t") (setq ind (current-column)) 4173 (skip-chars-forward " \t") (setq ind (current-column))
3715 (if (< (+ arg ind) 0) (error "Cannot outdent beyond margin")) 4174 (if (< (+ arg ind) 0) (error "Cannot outdent beyond margin"))
3716 (while (< (point) end) 4175 (while (< (point) end)
3717 (beginning-of-line 1) 4176 (beginning-of-line 1)
3718 (skip-chars-forward " \t") (setq ind1 (current-column)) 4177 (skip-chars-forward " \t") (setq ind1 (current-column))
3719 (delete-region (point-at-bol) (point)) 4178 (delete-region (point-at-bol) (point))
3720 (indent-to-column (+ ind1 arg)) 4179 (indent-to-column (+ ind1 arg))
3721 (beginning-of-line 2)) 4180 (beginning-of-line 2)))))
3722 (goto-char beg)))
3723 4181
3724;;; Archiving 4182;;; Archiving
3725 4183
@@ -3789,14 +4247,13 @@ heading be marked DONE, and the current time will be added."
3789 (or (bolp) (insert "\n")) 4247 (or (bolp) (insert "\n"))
3790 (insert "\n" heading "\n") 4248 (insert "\n" heading "\n")
3791 (end-of-line 0)) 4249 (end-of-line 0))
3792 ;; Make the heading visible, and the following as well 4250 ;; Make the subtree visible
3793 (let ((org-show-following-heading t)) (org-show-hierarchy-above)) 4251 (show-subtree)
3794 (if (re-search-forward 4252 (org-end-of-subtree t)
3795 (concat "^" (regexp-quote (make-string level ?*)) "[ \t]") 4253 (skip-chars-backward " \t\r\n]")
3796 nil t) 4254 (and (looking-at "[ \t\r\n]*")
3797 (progn (goto-char (match-beginning 0)) (insert "\n") 4255 (replace-match "\n\n")))
3798 (beginning-of-line 0)) 4256 ;; No specific heading, just go to end of file.
3799 (goto-char (point-max)) (insert "\n")))
3800 (goto-char (point-max)) (insert "\n")) 4257 (goto-char (point-max)) (insert "\n"))
3801 ;; Paste 4258 ;; Paste
3802 (org-paste-subtree (1+ level)) 4259 (org-paste-subtree (1+ level))
@@ -3816,7 +4273,7 @@ heading be marked DONE, and the current time will be added."
3816 ;; Here we are back in the original buffer. Everything seems to have 4273 ;; Here we are back in the original buffer. Everything seems to have
3817 ;; worked. So now cut the tree and finish up. 4274 ;; worked. So now cut the tree and finish up.
3818 (let (this-command) (org-cut-subtree)) 4275 (let (this-command) (org-cut-subtree))
3819 (if (looking-at "[ \t]*$") (kill-line)) 4276 (if (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line))
3820 (message "Subtree archived %s" 4277 (message "Subtree archived %s"
3821 (if (eq this-buffer buffer) 4278 (if (eq this-buffer buffer)
3822 (concat "under heading: " heading) 4279 (concat "under heading: " heading)
@@ -3844,6 +4301,7 @@ At all other locations, this simply calls `ispell-complete-word'."
3844 (if (equal (char-before (point)) ?\ ) (backward-char 1)) 4301 (if (equal (char-before (point)) ?\ ) (backward-char 1))
3845 (skip-chars-backward "a-zA-Z0-9_:$") 4302 (skip-chars-backward "a-zA-Z0-9_:$")
3846 (point))) 4303 (point)))
4304 (confirm (lambda (x) (stringp (car x))))
3847 (camel (equal (char-before beg) ?*)) 4305 (camel (equal (char-before beg) ?*))
3848 (tag (equal (char-before beg1) ?:)) 4306 (tag (equal (char-before beg1) ?:))
3849 (texp (equal (char-before beg) ?\\)) 4307 (texp (equal (char-before beg) ?\\))
@@ -3880,10 +4338,10 @@ At all other locations, this simply calls `ispell-complete-word'."
3880 tbl))) 4338 tbl)))
3881 tbl) 4339 tbl)
3882 (tag (setq type :tag beg beg1) 4340 (tag (setq type :tag beg beg1)
3883 (org-get-buffer-tags)) 4341 (or org-tag-alist (org-get-buffer-tags)))
3884 (t (progn (ispell-complete-word arg) (throw 'exit nil))))) 4342 (t (progn (ispell-complete-word arg) (throw 'exit nil)))))
3885 (pattern (buffer-substring-no-properties beg end)) 4343 (pattern (buffer-substring-no-properties beg end))
3886 (completion (try-completion pattern table))) 4344 (completion (try-completion pattern table confirm)))
3887 (cond ((eq completion t) 4345 (cond ((eq completion t)
3888 (if (equal type :opt) 4346 (if (equal type :opt)
3889 (insert (substring (cdr (assoc (upcase pattern) table)) 4347 (insert (substring (cdr (assoc (upcase pattern) table))
@@ -3906,7 +4364,8 @@ At all other locations, this simply calls `ispell-complete-word'."
3906 "Press \\[org-complete] again to insert example settings")))) 4364 "Press \\[org-complete] again to insert example settings"))))
3907 (t 4365 (t
3908 (message "Making completion list...") 4366 (message "Making completion list...")
3909 (let ((list (sort (all-completions pattern table) 'string<))) 4367 (let ((list (sort (all-completions pattern table confirm)
4368 'string<)))
3910 (with-output-to-temp-buffer "*Completions*" 4369 (with-output-to-temp-buffer "*Completions*"
3911 (condition-case nil 4370 (condition-case nil
3912 ;; Protection needed for XEmacs and emacs 21 4371 ;; Protection needed for XEmacs and emacs 21
@@ -3960,44 +4419,44 @@ prefix arg, switch to that state."
3960 (member (member this org-todo-keywords)) 4419 (member (member this org-todo-keywords))
3961 (tail (cdr member)) 4420 (tail (cdr member))
3962 (state (cond 4421 (state (cond
3963 ((equal arg '(4)) 4422 ((equal arg '(4))
3964 ;; Read a state with completion 4423 ;; Read a state with completion
3965 (completing-read "State: " (mapcar (lambda(x) (list x)) 4424 (completing-read "State: " (mapcar (lambda(x) (list x))
3966 org-todo-keywords) 4425 org-todo-keywords)
3967 nil t)) 4426 nil t))
3968 ((eq arg 'right) 4427 ((eq arg 'right)
3969 (if this 4428 (if this
3970 (if tail (car tail) nil) 4429 (if tail (car tail) nil)
3971 (car org-todo-keywords))) 4430 (car org-todo-keywords)))
3972 ((eq arg 'left) 4431 ((eq arg 'left)
3973 (if (equal member org-todo-keywords) 4432 (if (equal member org-todo-keywords)
3974 nil 4433 nil
3975 (if this 4434 (if this
3976 (nth (- (length org-todo-keywords) (length tail) 2) 4435 (nth (- (length org-todo-keywords) (length tail) 2)
3977 org-todo-keywords) 4436 org-todo-keywords)
3978 org-done-string))) 4437 org-done-string)))
3979 (arg 4438 (arg
3980 ;; user requests a specific state 4439 ;; user requests a specific state
3981 (nth (1- (prefix-numeric-value arg)) 4440 (nth (1- (prefix-numeric-value arg))
3982 org-todo-keywords)) 4441 org-todo-keywords))
3983 ((null member) (car org-todo-keywords)) 4442 ((null member) (car org-todo-keywords))
3984 ((null tail) nil) ;; -> first entry 4443 ((null tail) nil) ;; -> first entry
3985 ((eq org-todo-interpretation 'sequence) 4444 ((eq org-todo-interpretation 'sequence)
3986 (car tail)) 4445 (car tail))
3987 ((memq org-todo-interpretation '(type priority)) 4446 ((memq org-todo-interpretation '(type priority))
3988 (if (eq this-command last-command) 4447 (if (eq this-command last-command)
3989 (car tail) 4448 (car tail)
3990 (if (> (length tail) 0) org-done-string nil))) 4449 (if (> (length tail) 0) org-done-string nil)))
3991 (t nil))) 4450 (t nil)))
3992 (next (if state (concat " " state " ") " "))) 4451 (next (if state (concat " " state " ") " ")))
3993 (replace-match next t t) 4452 (replace-match next t t)
3994 (setq org-last-todo-state-is-todo 4453 (setq org-last-todo-state-is-todo
3995 (not (equal state org-done-string))) 4454 (not (equal state org-done-string)))
3996 (when org-log-done 4455 (when org-log-done
3997 (if (equal state org-done-string) 4456 (if (equal state org-done-string)
3998 (org-log-done) 4457 (org-add-planning-info 'closed (current-time) 'scheduled)
3999 (if (not this) 4458 (if (not this)
4000 (org-log-done t)))) 4459 (org-add-planning-info nil nil 'closed))))
4001 ;; Fixup tag positioning 4460 ;; Fixup tag positioning
4002 (and org-auto-align-tags (org-set-tags nil t)) 4461 (and org-auto-align-tags (org-set-tags nil t))
4003 (run-hooks 'org-after-todo-state-change-hook))) 4462 (run-hooks 'org-after-todo-state-change-hook)))
@@ -4067,25 +4526,79 @@ of `org-todo-keywords'."
4067A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] 4526A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down]
4068to modify it to the correct date." 4527to modify it to the correct date."
4069 (interactive) 4528 (interactive)
4070 (insert 4529 (org-add-planning-info 'deadline nil 'closed))
4071 org-deadline-string " "
4072 (format-time-string (car org-time-stamp-formats)
4073 (org-read-date nil 'to-time)))
4074 (message "%s" (substitute-command-keys
4075 "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date.")))
4076 4530
4077(defun org-schedule () 4531(defun org-schedule ()
4078 "Insert the SCHEDULED: string to schedule a TODO item. 4532 "Insert the SCHEDULED: string to schedule a TODO item.
4079A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] 4533A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down]
4080to modify it to the correct date." 4534to modify it to the correct date."
4081 (interactive) 4535 (interactive)
4082 (insert 4536 (org-add-planning-info 'scheduled nil 'closed))
4083 org-scheduled-string " " 4537
4084 (format-time-string (car org-time-stamp-formats) 4538(defun org-add-planning-info (what &optional time &rest remove)
4085 (org-read-date nil 'to-time))) 4539 "Insert new timestamp with keyword in the line directly after the headline.
4086 (message "%s" (substitute-command-keys 4540WHAT indicates what kind of time stamp to add. TIME indicated the time to use.
4087 "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) 4541If non is given, the user is prompted for a date.
4088 4542REMOVE indicates what kind of entries to remove. An old WHAT entry will also
4543be removed."
4544 (interactive)
4545 (when what (setq time (or time (org-read-date nil 'to-time))))
4546 (when (and org-insert-labeled-timestamps-at-point
4547 (member what '(scheduled deadline)))
4548 (insert
4549 (if (eq what 'scheduled) org-scheduled-string org-deadline-string)
4550 " "
4551 (format-time-string (car org-time-stamp-formats) time))
4552 (setq what nil))
4553 (save-excursion
4554 (let (beg end col list elt (buffer-invisibility-spec nil) ts)
4555 (org-back-to-heading t)
4556 (setq beg (point))
4557 (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"))
4558 (goto-char (match-end 1))
4559 (setq col (current-column))
4560 (goto-char (1+ (match-end 0)))
4561 (if (and (not (looking-at outline-regexp))
4562 (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp
4563 "[^\r\n]*")))
4564 (narrow-to-region (match-beginning 0) (match-end 0))
4565 (insert "\n")
4566 (backward-char 1)
4567 (narrow-to-region (point) (point))
4568 (indent-to-column col))
4569 ;; Check if we have to remove something.
4570 (setq list (cons what remove))
4571 (while list
4572 (setq elt (pop list))
4573 (goto-char (point-min))
4574 (when (or (and (eq elt 'scheduled)
4575 (re-search-forward org-scheduled-time-regexp nil t))
4576 (and (eq elt 'deadline)
4577 (re-search-forward org-deadline-time-regexp nil t))
4578 (and (eq elt 'closed)
4579 (re-search-forward org-closed-time-regexp nil t)))
4580 (replace-match "")
4581 (if (looking-at " +") (replace-match ""))))
4582 (goto-char (point-max))
4583 (when what
4584 (insert
4585 (if (not (equal (char-before) ?\ )) " " "")
4586 (cond ((eq what 'scheduled) org-scheduled-string)
4587 ((eq what 'deadline) org-deadline-string)
4588 ((eq what 'closed) org-closed-string))
4589 " ")
4590 (insert
4591 (setq ts
4592 (format-time-string
4593 (if (eq what 'closed)
4594 (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
4595 (car org-time-stamp-formats))
4596 time))))
4597 (goto-char (point-min))
4598 (widen)
4599 (if (looking-at "[ \t]+\r?\n")
4600 (replace-match ""))
4601 ts)))
4089 4602
4090(defun org-occur (regexp &optional callback) 4603(defun org-occur (regexp &optional callback)
4091 "Make a compact tree which shows all matches of REGEXP. 4604 "Make a compact tree which shows all matches of REGEXP.
@@ -4100,7 +4613,7 @@ that the match should indeed be shown."
4100 (let ((cnt 0)) 4613 (let ((cnt 0))
4101 (save-excursion 4614 (save-excursion
4102 (goto-char (point-min)) 4615 (goto-char (point-min))
4103 (hide-sublevels 1) 4616 (org-overview)
4104 (while (re-search-forward regexp nil t) 4617 (while (re-search-forward regexp nil t)
4105 (when (or (not callback) 4618 (when (or (not callback)
4106 (save-match-data (funcall callback))) 4619 (save-match-data (funcall callback)))
@@ -4340,7 +4853,7 @@ used to insert the time stamp into the buffer to include the time."
4340 ;; the range start. 4853 ;; the range start.
4341 (if (save-excursion 4854 (if (save-excursion
4342 (re-search-backward 4855 (re-search-backward
4343 (concat org-ts-regexp "--\\=") ; FIXME: exactly two minuses? 4856 (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses
4344 (- (point) 20) t)) 4857 (- (point) 20) t))
4345 (apply 4858 (apply
4346 'encode-time 4859 'encode-time
@@ -4348,8 +4861,8 @@ used to insert the time stamp into the buffer to include the time."
4348 (parse-time-string (match-string 1)))) 4861 (parse-time-string (match-string 1))))
4349 ct)) 4862 ct))
4350 (calendar-move-hook nil) 4863 (calendar-move-hook nil)
4351 (view-calendar-holidays-initially nil)
4352 (view-diary-entries-initially nil) 4864 (view-diary-entries-initially nil)
4865 (view-calendar-holidays-initially nil)
4353 (timestr (format-time-string 4866 (timestr (format-time-string
4354 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time)) 4867 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time))
4355 (prompt (format "YYYY-MM-DD [%s]: " timestr)) 4868 (prompt (format "YYYY-MM-DD [%s]: " timestr))
@@ -4761,7 +5274,6 @@ If there is already a time stamp at the cursor position, update it."
4761(defvar org-agenda-type nil) 5274(defvar org-agenda-type nil)
4762(defvar org-agenda-force-single-file nil) 5275(defvar org-agenda-force-single-file nil)
4763 5276
4764;;;###autoload
4765(defun org-agenda-mode () 5277(defun org-agenda-mode ()
4766 "Mode for time-sorted view on action items in Org-mode files. 5278 "Mode for time-sorted view on action items in Org-mode files.
4767 5279
@@ -4778,7 +5290,7 @@ The following commands are available:
4778 (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) 5290 (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local)
4779 (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) 5291 (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local)
4780 (unless org-agenda-keep-modes 5292 (unless org-agenda-keep-modes
4781 (setq org-agenda-follow-mode nil 5293 (setq org-agenda-follow-mode org-agenda-start-with-follow-mode
4782 org-agenda-show-log nil)) 5294 org-agenda-show-log nil))
4783 (easy-menu-change 5295 (easy-menu-change
4784 '("Agenda") "Agenda Files" 5296 '("Agenda") "Agenda Files"
@@ -4815,6 +5327,8 @@ The following commands are available:
4815(define-key org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-date-earlier) 5327(define-key org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-date-earlier)
4816 5328
4817(define-key org-agenda-mode-map ">" 'org-agenda-date-prompt) 5329(define-key org-agenda-mode-map ">" 'org-agenda-date-prompt)
5330(define-key org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule)
5331(define-key org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline)
4818(let ((l '(1 2 3 4 5 6 7 8 9 0))) 5332(let ((l '(1 2 3 4 5 6 7 8 9 0)))
4819 (while l (define-key org-agenda-mode-map 5333 (while l (define-key org-agenda-mode-map
4820 (int-to-string (pop l)) 'digit-argument))) 5334 (int-to-string (pop l)) 'digit-argument)))
@@ -4878,10 +5392,12 @@ The following commands are available:
4878 ("Tags" 5392 ("Tags"
4879 ["Show all Tags" org-agenda-show-tags t] 5393 ["Show all Tags" org-agenda-show-tags t]
4880 ["Set Tags" org-agenda-set-tags t]) 5394 ["Set Tags" org-agenda-set-tags t])
4881 ("Reschedule" 5395 ("Schedule"
5396 ["Schedule" org-agenda-schedule t]
5397 ["Set Deadline" org-agenda-deadline t]
5398 "--"
4882 ["Reschedule +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] 5399 ["Reschedule +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)]
4883 ["Reschedule -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] 5400 ["Reschedule -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)]
4884 "--"
4885 ["Reschedule to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) 5401 ["Reschedule to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)])
4886 ("Priority" 5402 ("Priority"
4887 ["Set Priority" org-agenda-priority t] 5403 ["Set Priority" org-agenda-priority t]
@@ -4945,6 +5461,7 @@ next use of \\[org-agenda]) restricted to the current file."
4945 (interactive "P") 5461 (interactive "P")
4946 (catch 'exit 5462 (catch 'exit
4947 (let ((restrict-ok (and buffer-file-name (eq major-mode 'org-mode))) 5463 (let ((restrict-ok (and buffer-file-name (eq major-mode 'org-mode)))
5464 (bfn buffer-file-name)
4948 (custom org-agenda-custom-commands) 5465 (custom org-agenda-custom-commands)
4949 c entry key type string) 5466 c entry key type string)
4950 (put 'org-agenda-files 'org-restrict nil) 5467 (put 'org-agenda-files 'org-restrict nil)
@@ -4979,7 +5496,7 @@ C Configure your own agenda commands")
4979 (message "") 5496 (message "")
4980 (when (equal c ?1) 5497 (when (equal c ?1)
4981 (if restrict-ok 5498 (if restrict-ok
4982 (put 'org-agenda-files 'org-restrict (list buffer-file-name)) 5499 (put 'org-agenda-files 'org-restrict (list bfn))
4983 (error "Cannot restrict agenda to current buffer")) 5500 (error "Cannot restrict agenda to current buffer"))
4984 (message "Press key for agenda command%s" 5501 (message "Press key for agenda command%s"
4985 (if restrict-ok " (restricted to current file)" "")) 5502 (if restrict-ok " (restricted to current file)" ""))
@@ -4991,18 +5508,16 @@ C Configure your own agenda commands")
4991 ((equal c ?C) (customize-variable 'org-agenda-custom-commands)) 5508 ((equal c ?C) (customize-variable 'org-agenda-custom-commands))
4992 ((equal c ?a) (call-interactively 'org-agenda-list)) 5509 ((equal c ?a) (call-interactively 'org-agenda-list))
4993 ((equal c ?t) (call-interactively 'org-todo-list)) 5510 ((equal c ?t) (call-interactively 'org-todo-list))
4994 ((equal c ?T) 5511 ((equal c ?T) (org-call-with-arg 'org-todo-list (or arg '(4))))
4995 (setq current-prefix-arg (or arg '(4)))
4996 (call-interactively 'org-todo-list))
4997 ((equal c ?m) (call-interactively 'org-tags-view)) 5512 ((equal c ?m) (call-interactively 'org-tags-view))
4998 ((equal c ?M) 5513 ((equal c ?M) (org-call-with-arg 'org-tags-view (or arg '(4))))
4999 (setq current-prefix-arg (or arg '(4)))
5000 (call-interactively 'org-tags-view))
5001 ((setq entry (assoc (char-to-string c) org-agenda-custom-commands)) 5514 ((setq entry (assoc (char-to-string c) org-agenda-custom-commands))
5002 (setq type (nth 1 entry) string (nth 2 entry)) 5515 (setq type (nth 1 entry) string (nth 2 entry))
5003 (cond 5516 (cond
5004 ((eq type 'tags) 5517 ((eq type 'tags)
5005 (org-tags-view current-prefix-arg string)) 5518 (org-tags-view current-prefix-arg string))
5519 ((eq type 'tags-todo)
5520 (org-tags-view '(4) string))
5006 ((eq type 'todo) 5521 ((eq type 'todo)
5007 (org-todo-list string)) 5522 (org-todo-list string))
5008 ((eq type 'tags-tree) 5523 ((eq type 'tags-tree)
@@ -5159,12 +5674,13 @@ dates."
5159 (beg (if (org-region-active-p) (region-beginning) (point-min))) 5674 (beg (if (org-region-active-p) (region-beginning) (point-min)))
5160 (end (if (org-region-active-p) (region-end) (point-max))) 5675 (end (if (org-region-active-p) (region-end) (point-max)))
5161 (day-numbers (org-get-all-dates beg end 'no-ranges 5676 (day-numbers (org-get-all-dates beg end 'no-ranges
5162 t doclosed)) ; always include today 5677 t doclosed ; always include today
5678 org-timeline-show-empty-dates))
5163 (today (time-to-days (current-time))) 5679 (today (time-to-days (current-time)))
5164 (org-respect-restriction t) 5680 (org-respect-restriction t)
5165 (past t) 5681 (past t)
5166 args 5682 args
5167 s e rtn d) 5683 s e rtn d emptyp)
5168 (setq org-agenda-redo-command 5684 (setq org-agenda-redo-command
5169 (list 'progn 5685 (list 'progn
5170 (list 'switch-to-buffer-other-window (current-buffer)) 5686 (list 'switch-to-buffer-other-window (current-buffer))
@@ -5184,28 +5700,35 @@ dates."
5184 (push :timestamp args) 5700 (push :timestamp args)
5185 (if dotodo (push :todo args)) 5701 (if dotodo (push :todo args))
5186 (while (setq d (pop day-numbers)) 5702 (while (setq d (pop day-numbers))
5187 (if (and (>= d today) 5703 (if (and (listp d) (eq (car d) :omitted))
5188 dopast
5189 past)
5190 (progn
5191 (setq past nil)
5192 (insert (make-string 79 ?-) "\n")))
5193 (setq date (calendar-gregorian-from-absolute d))
5194 (setq s (point))
5195 (setq rtn (apply 'org-agenda-get-day-entries
5196 entry date args))
5197 (if (or rtn (equal d today))
5198 (progn 5704 (progn
5199 (insert (calendar-day-name date) " " 5705 (setq s (point))
5200 (number-to-string (extract-calendar-day date)) " " 5706 (insert (format "\n[... %d empty days omitted]\n\n" (cdr d)))
5201 (calendar-month-name (extract-calendar-month date)) " " 5707 (put-text-property s (1- (point)) 'face 'org-level-3))
5202 (number-to-string (extract-calendar-year date)) "\n") 5708 (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil))
5203 (put-text-property s (1- (point)) 'face 5709 (if (and (>= d today)
5204 'org-level-3) 5710 dopast
5205 (if (equal d today) 5711 past)
5206 (put-text-property s (1- (point)) 'org-today t)) 5712 (progn
5207 (insert (org-finalize-agenda-entries rtn) "\n") 5713 (setq past nil)
5208 (put-text-property s (1- (point)) 'day d)))) 5714 (insert (make-string 79 ?-) "\n")))
5715 (setq date (calendar-gregorian-from-absolute d))
5716 (setq s (point))
5717 (setq rtn (and (not emptyp)
5718 (apply 'org-agenda-get-day-entries
5719 entry date args)))
5720 (if (or rtn (equal d today) org-timeline-show-empty-dates)
5721 (progn
5722 (insert (calendar-day-name date) " "
5723 (number-to-string (extract-calendar-day date)) " "
5724 (calendar-month-name (extract-calendar-month date)) " "
5725 (number-to-string (extract-calendar-year date)) "\n")
5726 (put-text-property s (1- (point)) 'face
5727 'org-level-3)
5728 (if (equal d today)
5729 (put-text-property s (1- (point)) 'org-today t))
5730 (and rtn (insert (org-finalize-agenda-entries rtn) "\n"))
5731 (put-text-property s (1- (point)) 'day d)))))
5209 (goto-char (point-min)) 5732 (goto-char (point-min))
5210 (setq buffer-read-only t) 5733 (setq buffer-read-only t)
5211 (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) 5734 (goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
@@ -5432,7 +5955,7 @@ If ERROR is non-nil, throw an error, otherwise just return nil."
5432 (if (memq org-agenda-type types) 5955 (if (memq org-agenda-type types)
5433 t 5956 t
5434 (if error 5957 (if error
5435 (error "Now allowed in %s-type agenda buffers" org-agenda-type) 5958 (error "Not allowed in %s-type agenda buffers" org-agenda-type)
5436 nil))) 5959 nil)))
5437 5960
5438(defun org-agenda-quit () 5961(defun org-agenda-quit ()
@@ -5768,14 +6291,15 @@ Optional argument FILE means, use this file instead of the current."
5768(defun org-file-menu-entry (file) 6291(defun org-file-menu-entry (file)
5769 (vector file (list 'find-file file) t)) 6292 (vector file (list 'find-file file) t))
5770 6293
5771(defun org-get-all-dates (beg end &optional no-ranges force-today inactive) 6294(defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty)
5772 "Return a list of all relevant day numbers from BEG to END buffer positions. 6295 "Return a list of all relevant day numbers from BEG to END buffer positions.
5773If NO-RANGES is non-nil, include only the start and end dates of a range, 6296If NO-RANGES is non-nil, include only the start and end dates of a range,
5774not every single day in the range. If FORCE-TODAY is non-nil, make 6297not every single day in the range. If FORCE-TODAY is non-nil, make
5775sure that TODAY is included in the list. If INACTIVE is non-nil, also 6298sure that TODAY is included in the list. If INACTIVE is non-nil, also
5776inactive time stamps (those in square brackets) are included." 6299inactive time stamps (those in square brackets) are included.
6300When EMPTY is non-nil, also include days without any entries."
5777 (let ((re (if inactive org-ts-regexp-both org-ts-regexp)) 6301 (let ((re (if inactive org-ts-regexp-both org-ts-regexp))
5778 dates date day day1 day2 ts1 ts2) 6302 dates dates1 date day day1 day2 ts1 ts2)
5779 (if force-today 6303 (if force-today
5780 (setq dates (list (time-to-days (current-time))))) 6304 (setq dates (list (time-to-days (current-time)))))
5781 (save-excursion 6305 (save-excursion
@@ -5793,7 +6317,19 @@ inactive time stamps (those in square brackets) are included."
5793 day2 (time-to-days (org-time-string-to-time ts2))) 6317 day2 (time-to-days (org-time-string-to-time ts2)))
5794 (while (< (setq day1 (1+ day1)) day2) 6318 (while (< (setq day1 (1+ day1)) day2)
5795 (or (memq day1 dates) (push day1 dates))))) 6319 (or (memq day1 dates) (push day1 dates)))))
5796 (sort dates '<)))) 6320 (setq dates (sort dates '<))
6321 (when empty
6322 (while (setq day (pop dates))
6323 (setq day2 (car dates))
6324 (push day dates1)
6325 (when (and day2 empty)
6326 (if (or (eq empty t)
6327 (and (numberp empty) (<= (- day2 day) empty)))
6328 (while (< (setq day (1+ day)) day2)
6329 (push (list day) dates1))
6330 (push (cons :omitted (- day2 day)) dates1))))
6331 (setq dates (nreverse dates1)))
6332 dates)))
5797 6333
5798;;;###autoload 6334;;;###autoload
5799(defun org-diary (&rest args) 6335(defun org-diary (&rest args)
@@ -5977,27 +6513,32 @@ the documentation of `org-diary'."
5977 "\\)\\>") 6513 "\\)\\>")
5978 org-not-done-regexp) 6514 org-not-done-regexp)
5979 "[^\n\r]*\\)")) 6515 "[^\n\r]*\\)"))
6516 (sched-re (concat ".*\n?.*?" org-scheduled-time-regexp))
5980 marker priority category tags 6517 marker priority category tags
5981 ee txt) 6518 ee txt)
5982 (goto-char (point-min)) 6519 (goto-char (point-min))
5983 (while (re-search-forward regexp nil t) 6520 (while (re-search-forward regexp nil t)
5984 (goto-char (match-beginning 1)) 6521 (when (not (and org-agenda-todo-ignore-scheduled
5985 (setq marker (org-agenda-new-marker (1+ (match-beginning 0))) 6522 (save-match-data (looking-at sched-re))))
5986 category (org-get-category) 6523 (goto-char (match-beginning 1))
5987 tags (org-get-tags-at (point)) 6524 (setq marker (org-agenda-new-marker (1+ (match-beginning 0)))
5988 txt (org-format-agenda-item "" (match-string 1) category tags) 6525 category (org-get-category)
5989 priority 6526 tags (org-get-tags-at (point))
5990 (+ (org-get-priority txt) 6527 txt (org-format-agenda-item "" (match-string 1) category tags)
5991 (if org-todo-kwd-priority-p 6528 priority
5992 (- org-todo-kwd-max-priority -2 6529 (+ (org-get-priority txt)
5993 (length 6530 (if org-todo-kwd-priority-p
5994 (member (match-string 2) org-todo-keywords))) 6531 (- org-todo-kwd-max-priority -2
5995 1))) 6532 (length
5996 (org-add-props txt props 6533 (member (match-string 2) org-todo-keywords)))
5997 'org-marker marker 'org-hd-marker marker 6534 1)))
5998 'priority priority 'category category) 6535 (org-add-props txt props
5999 (push txt ee) 6536 'org-marker marker 'org-hd-marker marker
6000 (goto-char (match-end 1))) 6537 'priority priority 'category category)
6538 (push txt ee))
6539 (if org-agenda-todo-list-sublevels
6540 (goto-char (match-end 1))
6541 (org-end-of-subtree 'invisible)))
6001 (nreverse ee))) 6542 (nreverse ee)))
6002 6543
6003(defconst org-agenda-no-heading-message 6544(defconst org-agenda-no-heading-message
@@ -6133,7 +6674,7 @@ the documentation of `org-diary'."
6133 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar 6674 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar
6134 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar 6675 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
6135 d2 diff pos pos1 category tags 6676 d2 diff pos pos1 category tags
6136 ee txt head) 6677 ee txt head face)
6137 (goto-char (point-min)) 6678 (goto-char (point-min))
6138 (while (re-search-forward regexp nil t) 6679 (while (re-search-forward regexp nil t)
6139 (setq pos (1- (match-beginning 1)) 6680 (setq pos (1- (match-beginning 1))
@@ -6160,20 +6701,16 @@ the documentation of `org-diary'."
6160 (setq txt (org-format-agenda-item 6701 (setq txt (org-format-agenda-item
6161 (format "In %3d d.: " diff) head category tags)))) 6702 (format "In %3d d.: " diff) head category tags))))
6162 (setq txt org-agenda-no-heading-message)) 6703 (setq txt org-agenda-no-heading-message))
6163 (when txt 6704 (when txt
6705 (setq face (cond ((<= diff 0) 'org-warning)
6706 ((<= diff 5) 'org-upcoming-deadline)
6707 (t nil)))
6164 (org-add-props txt props 6708 (org-add-props txt props
6165 'org-marker (org-agenda-new-marker pos) 6709 'org-marker (org-agenda-new-marker pos)
6166 'org-hd-marker (org-agenda-new-marker pos1) 6710 'org-hd-marker (org-agenda-new-marker pos1)
6167 'priority (+ (- 10 diff) (org-get-priority txt)) 6711 'priority (+ (- 10 diff) (org-get-priority txt))
6168 'category category 6712 'category category
6169 'face (cond ((<= diff 0) 'org-warning) 6713 'face face 'undone-face face 'done-face 'org-done)
6170 ((<= diff 5) 'org-scheduled-previously)
6171 (t nil))
6172 'undone-face (cond
6173 ((<= diff 0) 'org-warning)
6174 ((<= diff 5) 'org-scheduled-previously)
6175 (t nil))
6176 'done-face 'org-done)
6177 (push txt ee))))) 6714 (push txt ee)))))
6178 ee)) 6715 ee))
6179 6716
@@ -6351,14 +6888,19 @@ only the correctly processes TXT should be returned - this is used by
6351 t)) 6888 t))
6352 (setq txt (replace-match "" nil nil txt)))) 6889 (setq txt (replace-match "" nil nil txt))))
6353 ;; Normalize the time(s) to 24 hour 6890 ;; Normalize the time(s) to 24 hour
6354 (if s1 (setq s1 (org-get-time-of-day s1 'string))) 6891 (if s1 (setq s1 (org-get-time-of-day s1 'string t)))
6355 (if s2 (setq s2 (org-get-time-of-day s2 'string)))) 6892 (if s2 (setq s2 (org-get-time-of-day s2 'string t))))
6356 6893
6357 (when (and (or (eq org-agenda-remove-tags-when-in-prefix t) 6894 (when (string-match "\\([ \t]+\\)\\(:[a-zA-Z_@0-9:]+:\\)[ \t]*$" txt)
6358 (and org-agenda-remove-tags-when-in-prefix 6895 ;; Tags are in the string
6359 org-prefix-has-tag)) 6896 (if (or (eq org-agenda-remove-tags-when-in-prefix t)
6360 (string-match ":[a-zA-Z_@0-9:]+:[ \t]*$" txt)) 6897 (and org-agenda-remove-tags-when-in-prefix
6361 (setq txt (replace-match "" t t txt))) 6898 org-prefix-has-tag))
6899 (setq txt (replace-match "" t t txt))
6900 (setq txt (replace-match
6901 (concat (make-string (max (- 50 (length txt)) 1) ?\ )
6902 (match-string 2 txt))
6903 t t txt))))
6362 6904
6363 ;; Create the final string 6905 ;; Create the final string
6364 (if noprefix 6906 (if noprefix
@@ -6438,7 +6980,7 @@ The resulting form is returned and stored in the variable
6438 (setq vars (nreverse vars)) 6980 (setq vars (nreverse vars))
6439 (setq org-prefix-format-compiled `(format ,s ,@vars)))) 6981 (setq org-prefix-format-compiled `(format ,s ,@vars))))
6440 6982
6441(defun org-get-time-of-day (s &optional string) 6983(defun org-get-time-of-day (s &optional string mod24)
6442 "Check string S for a time of day. 6984 "Check string S for a time of day.
6443If found, return it as a military time number between 0 and 2400. 6985If found, return it as a military time number between 0 and 2400.
6444If not found, return nil. 6986If not found, return nil.
@@ -6451,16 +6993,19 @@ HH:MM."
6451 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) 6993 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
6452 (string-match 6994 (string-match
6453 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) 6995 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
6454 (let* ((t0 (+ (* 100 6996 (let* ((h (string-to-number (match-string 1 s)))
6455 (+ (string-to-number (match-string 1 s)) 6997 (m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
6456 (if (and (match-beginning 4) 6998 (ampm (if (match-end 4) (downcase (match-string 4 s))))
6457 (equal (downcase (match-string 4 s)) "pm")) 6999 (am-p (equal ampm "am"))
6458 12 0))) 7000 (h1 (cond ((not ampm) h)
6459 (if (match-beginning 3) 7001 ((= h 12) (if am-p 0 12))
6460 (string-to-number (match-string 3 s)) 7002 (t (+ h (if am-p 0 12)))))
6461 0))) 7003 (h2 (if (and string mod24 (not (and (= m 0) (= h1 24))))
6462 (t1 (concat " " 7004 (mod h1 24) h1))
6463 (if (< t0 100) "0" "") (if (< t0 10) "0" "") 7005 (t0 (+ (* 100 h2) m))
7006 (t1 (concat (if (>= h1 24) "+" " ")
7007 (if (< t0 100) "0" "")
7008 (if (< t0 10) "0" "")
6464 (int-to-string t0)))) 7009 (int-to-string t0))))
6465 (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) 7010 (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
6466 7011
@@ -6470,7 +7015,7 @@ HH:MM."
6470 (mapconcat 'identity (sort list 'org-entries-lessp) "\n")) 7015 (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))
6471 7016
6472(defun org-agenda-highlight-todo (x) 7017(defun org-agenda-highlight-todo (x)
6473 (let (re) 7018 (let (re pl)
6474 (if (eq x 'line) 7019 (if (eq x 'line)
6475 (save-excursion 7020 (save-excursion
6476 (beginning-of-line 1) 7021 (beginning-of-line 1)
@@ -6479,8 +7024,9 @@ HH:MM."
6479 (and (looking-at (concat "[ \t]*" re)) 7024 (and (looking-at (concat "[ \t]*" re))
6480 (add-text-properties (match-beginning 0) (match-end 0) 7025 (add-text-properties (match-beginning 0) (match-end 0)
6481 '(face org-todo)))) 7026 '(face org-todo))))
6482 (setq re (get-text-property 0 'org-not-done-regexp x)) 7027 (setq re (get-text-property 0 'org-not-done-regexp x)
6483 (and re (string-match re x) 7028 pl (get-text-property 0 'prefix-length x))
7029 (and re (equal (string-match re x pl) pl)
6484 (add-text-properties (match-beginning 0) (match-end 0) 7030 (add-text-properties (match-beginning 0) (match-end 0)
6485 '(face org-todo) x)) 7031 '(face org-todo) x))
6486 x))) 7032 x)))
@@ -6503,7 +7049,7 @@ HH:MM."
6503 7049
6504(defsubst org-cmp-time (a b) 7050(defsubst org-cmp-time (a b)
6505 "Compare the time-of-day values of strings A and B." 7051 "Compare the time-of-day values of strings A and B."
6506 (let* ((def (if org-sort-agenda-notime-is-late 2401 -1)) 7052 (let* ((def (if org-sort-agenda-notime-is-late 9901 -1))
6507 (ta (or (get-text-property 1 'time-of-day a) def)) 7053 (ta (or (get-text-property 1 'time-of-day a) def))
6508 (tb (or (get-text-property 1 'time-of-day b) def))) 7054 (tb (or (get-text-property 1 'time-of-day b) def)))
6509 (cond ((< ta tb) -1) 7055 (cond ((< ta tb) -1)
@@ -6537,7 +7083,8 @@ and by additional input from the age of a schedules or deadline entry."
6537 (interactive) 7083 (interactive)
6538 (let* ((tags (get-text-property (point-at-bol) 'tags))) 7084 (let* ((tags (get-text-property (point-at-bol) 'tags)))
6539 (if tags 7085 (if tags
6540 (message "Tags are :%s:" (mapconcat 'identity tags ":")) 7086 (message "Tags are :%s:"
7087 (org-no-properties (mapconcat 'identity tags ":")))
6541 (message "No tags associated with this line")))) 7088 (message "No tags associated with this line"))))
6542 7089
6543(defun org-agenda-goto (&optional highlight) 7090(defun org-agenda-goto (&optional highlight)
@@ -6723,7 +7270,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
6723 (beginning-of-line 1))) 7270 (beginning-of-line 1)))
6724 7271
6725(defun org-get-tags-at (&optional pos) 7272(defun org-get-tags-at (&optional pos)
6726 "Get a list of all headline targs applicable at POS. 7273 "Get a list of all headline tags applicable at POS.
6727POS defaults to point. If tags are inherited, the list contains 7274POS defaults to point. If tags are inherited, the list contains
6728the targets in the same sequence as the headlines appear, i.e. 7275the targets in the same sequence as the headlines appear, i.e.
6729the tags of the current headline come last." 7276the tags of the current headline come last."
@@ -6736,7 +7283,9 @@ the tags of the current headline come last."
6736 (condition-case nil 7283 (condition-case nil
6737 (while t 7284 (while t
6738 (if (looking-at "[^\r\n]+?:\\([a-zA-Z_@0-9:]+\\):[ \t]*\\([\n\r]\\|\\'\\)") 7285 (if (looking-at "[^\r\n]+?:\\([a-zA-Z_@0-9:]+\\):[ \t]*\\([\n\r]\\|\\'\\)")
6739 (setq tags (append (org-split-string (match-string 1) ":") tags))) 7286 (setq tags (append (org-split-string
7287 (org-match-string-no-properties 1) ":")
7288 tags)))
6740 (or org-use-tag-inheritance (error "")) 7289 (or org-use-tag-inheritance (error ""))
6741 (org-up-heading-all 1)) 7290 (org-up-heading-all 1))
6742 (error nil)))) 7291 (error nil))))
@@ -6808,6 +7357,40 @@ be used to request time specification in the time stamp."
6808 (org-time-stamp arg) 7357 (org-time-stamp arg)
6809 (message "Time stamp changed to %s" org-last-changed-timestamp)))) 7358 (message "Time stamp changed to %s" org-last-changed-timestamp))))
6810 7359
7360(defun org-agenda-schedule (arg)
7361 "Schedule the item at point."
7362 (interactive "P")
7363 (org-agenda-check-type t 'agenda 'timeline 'todo 'tags)
7364 (org-agenda-check-no-diary)
7365 (let* ((marker (or (get-text-property (point) 'org-marker)
7366 (org-agenda-error)))
7367 (buffer (marker-buffer marker))
7368 (pos (marker-position marker))
7369 (org-insert-labeled-timestamps-at-point nil)
7370 ts)
7371 (with-current-buffer buffer
7372 (widen)
7373 (goto-char pos)
7374 (setq ts (org-schedule))
7375 (message "Item scheduled for %s" ts))))
7376
7377(defun org-agenda-deadline (arg)
7378 "Schedule the item at point."
7379 (interactive "P")
7380 (org-agenda-check-type t 'agenda 'timeline 'todo 'tags)
7381 (org-agenda-check-no-diary)
7382 (let* ((marker (or (get-text-property (point) 'org-marker)
7383 (org-agenda-error)))
7384 (buffer (marker-buffer marker))
7385 (pos (marker-position marker))
7386 (org-insert-labeled-timestamps-at-point nil)
7387 ts)
7388 (with-current-buffer buffer
7389 (widen)
7390 (goto-char pos)
7391 (setq ts (org-deadline))
7392 (message "Deadline for this item set to %s" ts))))
7393
6811(defun org-get-heading () 7394(defun org-get-heading ()
6812 "Return the heading of the current entry, without the stars." 7395 "Return the heading of the current entry, without the stars."
6813 (save-excursion 7396 (save-excursion
@@ -6980,7 +7563,7 @@ are included in the output."
6980 7563
6981 (save-excursion 7564 (save-excursion
6982 (goto-char (point-min)) 7565 (goto-char (point-min))
6983 (when (eq action 'sparse-tree) (hide-sublevels 1)) 7566 (when (eq action 'sparse-tree) (org-overview))
6984 (while (re-search-forward re nil t) 7567 (while (re-search-forward re nil t)
6985 (setq todo (if (match-end 1) (match-string 2)) 7568 (setq todo (if (match-end 1) (match-string 2))
6986 tags (if (match-end 4) (match-string 4))) 7569 tags (if (match-end 4) (match-string 4)))
@@ -7108,6 +7691,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
7108 (with-current-buffer buffer 7691 (with-current-buffer buffer
7109 (unless (eq major-mode 'org-mode) 7692 (unless (eq major-mode 'org-mode)
7110 (error "Agenda file %s is not in `org-mode'" file)) 7693 (error "Agenda file %s is not in `org-mode'" file))
7694 (setq org-category-table (org-get-category-table))
7111 (save-excursion 7695 (save-excursion
7112 (save-restriction 7696 (save-restriction
7113 (if org-respect-restriction 7697 (if org-respect-restriction
@@ -7139,11 +7723,11 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
7139(defun org-set-tags (&optional arg just-align) 7723(defun org-set-tags (&optional arg just-align)
7140 "Set the tags for the current headline. 7724 "Set the tags for the current headline.
7141With prefix ARG, realign all tags in headings in the current buffer." 7725With prefix ARG, realign all tags in headings in the current buffer."
7142 (interactive) 7726 (interactive "P")
7143 (let* (;(inherit (org-get-inherited-tags)) 7727 (let* ((re (concat "^" outline-regexp))
7144 (re (concat "^" outline-regexp))
7145 (col (current-column)) 7728 (col (current-column))
7146 (current (org-get-tags)) 7729 (current (org-get-tags))
7730 table current-tags inherited-tags ; computed below when needed
7147 tags hd empty invis) 7731 tags hd empty invis)
7148 (if arg 7732 (if arg
7149 (save-excursion 7733 (save-excursion
@@ -7153,16 +7737,23 @@ With prefix ARG, realign all tags in headings in the current buffer."
7153 (message "All tags realigned to column %d" org-tags-column)) 7737 (message "All tags realigned to column %d" org-tags-column))
7154 (if just-align 7738 (if just-align
7155 (setq tags current) 7739 (setq tags current)
7156 (setq org-last-tags-completion-table 7740 (setq table (or org-tag-alist (org-get-buffer-tags))
7157 (or (org-get-buffer-tags) 7741 org-last-tags-completion-table table
7158 org-last-tags-completion-table)) 7742 current-tags (org-split-string current ":")
7159 (setq tags 7743 inherited-tags (nreverse
7160 (let ((org-add-colon-after-tag-completion t)) 7744 (nthcdr (length current-tags)
7161 (completing-read "Tags: " 'org-tags-completion-function 7745 (nreverse (org-get-tags-at))))
7162 nil nil current 'org-tags-history))) 7746 tags
7747 (if (or (eq t org-use-fast-tag-selection)
7748 (and org-use-fast-tag-selection
7749 (delq nil (mapcar 'cdr table))))
7750 (org-fast-tag-selection current-tags inherited-tags table)
7751 (let ((org-add-colon-after-tag-completion t))
7752 (completing-read "Tags: " 'org-tags-completion-function
7753 nil nil current 'org-tags-history))))
7163 (while (string-match "[-+&]+" tags) 7754 (while (string-match "[-+&]+" tags)
7164 (setq tags (replace-match ":" t t tags)))) 7755 (setq tags (replace-match ":" t t tags))))
7165 ;; FIXME: still optimize this by not checking when JUST-ALIGN? 7756
7166 (unless (setq empty (string-match "\\`[\t ]*\\'" tags)) 7757 (unless (setq empty (string-match "\\`[\t ]*\\'" tags))
7167 (unless (string-match ":$" tags) (setq tags (concat tags ":"))) 7758 (unless (string-match ":$" tags) (setq tags (concat tags ":")))
7168 (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) 7759 (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
@@ -7188,7 +7779,8 @@ With prefix ARG, realign all tags in headings in the current buffer."
7188 (move-to-column col)))) 7779 (move-to-column col))))
7189 7780
7190(defun org-tags-completion-function (string predicate &optional flag) 7781(defun org-tags-completion-function (string predicate &optional flag)
7191 (let (s1 s2 rtn (ctable org-last-tags-completion-table)) 7782 (let (s1 s2 rtn (ctable org-last-tags-completion-table)
7783 (confirm (lambda (x) (stringp (car x)))))
7192 (if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string) 7784 (if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string)
7193 (setq s1 (match-string 1 string) 7785 (setq s1 (match-string 1 string)
7194 s2 (match-string 2 string)) 7786 s2 (match-string 2 string))
@@ -7196,7 +7788,7 @@ With prefix ARG, realign all tags in headings in the current buffer."
7196 (cond 7788 (cond
7197 ((eq flag nil) 7789 ((eq flag nil)
7198 ;; try completion 7790 ;; try completion
7199 (setq rtn (try-completion s2 ctable)) 7791 (setq rtn (try-completion s2 ctable confirm))
7200 (if (stringp rtn) 7792 (if (stringp rtn)
7201 (concat s1 s2 (substring rtn (length s2)) 7793 (concat s1 s2 (substring rtn (length s2))
7202 (if (and org-add-colon-after-tag-completion 7794 (if (and org-add-colon-after-tag-completion
@@ -7205,13 +7797,133 @@ With prefix ARG, realign all tags in headings in the current buffer."
7205 ) 7797 )
7206 ((eq flag t) 7798 ((eq flag t)
7207 ;; all-completions 7799 ;; all-completions
7208 (all-completions s2 ctable) 7800 (all-completions s2 ctable confirm)
7209 ) 7801 )
7210 ((eq flag 'lambda) 7802 ((eq flag 'lambda)
7211 ;; exact match? 7803 ;; exact match?
7212 (assoc s2 ctable))) 7804 (assoc s2 ctable)))
7213 )) 7805 ))
7214 7806
7807(defun org-fast-tag-insert (kwd tags face &optional end)
7808 "Insert KDW, and the TAGS, the latter with face FACE. Also inser END."
7809 (insert (format "%-12s" (concat kwd ":"))
7810 (org-add-props (mapconcat 'identity tags " ") nil 'face face)
7811 (or end "")))
7812
7813(defun org-fast-tag-selection (current inherited table)
7814 "Fast tag selection with single keys.
7815CURRENT is the current list of tags in the headline, INHERITED is the
7816list of inherited tags, and TABLE is an alist of tags and corresponding keys,
7817possibly with grouping information.
7818If the keys are nil, a-z are automatically assigned.
7819Returns the new tags string, or nil to not change the current settings."
7820 (let* ((maxlen (apply 'max (mapcar
7821 (lambda (x)
7822 (if (stringp (car x)) (string-width (car x)) 0))
7823 table)))
7824 (fwidth (+ maxlen 3 1 3))
7825 (ncol (/ (- (window-width) 4) fwidth))
7826 (i-face 'org-done)
7827 (c-face 'org-tag)
7828 tg cnt e c char c1 c2 ntable tbl rtn
7829 groups ingroup)
7830 (save-window-excursion
7831 (delete-other-windows)
7832 (split-window-vertically)
7833 (switch-to-buffer-other-window (get-buffer-create " *Org tags*"))
7834 (erase-buffer)
7835 (org-fast-tag-insert "Inherited" inherited i-face "\n")
7836 (org-fast-tag-insert "Current" current c-face "\n\n")
7837 (setq tbl table char ?a cnt 0)
7838 (while (setq e (pop tbl))
7839 (cond
7840 ((equal e '(:startgroup))
7841 (push '() groups) (setq ingroup t)
7842 (when (not (= cnt 0))
7843 (setq cnt 0)
7844 (insert "\n"))
7845 (insert "{ "))
7846 ((equal e '(:endgroup))
7847 (setq ingroup nil cnt 0)
7848 (insert "}\n"))
7849 (t
7850 (setq tg (car e) c2 nil)
7851 (if (cdr e)
7852 (setq c (cdr e))
7853 ;; automatically assign a character.
7854 (setq c1 (string-to-char
7855 (downcase (substring
7856 tg (if (= (string-to-char tg) ?@) 1 0)))))
7857 (if (or (rassoc c1 ntable) (rassoc c1 table))
7858 (while (or (rassoc char ntable) (rassoc char table))
7859 (setq char (1+ char)))
7860 (setq c2 c1))
7861 (setq c (or c2 char)))
7862 (if ingroup (push tg (car groups)))
7863 (setq tg (org-add-props tg nil 'face
7864 (cond
7865 ((member tg current) c-face)
7866 ((member tg inherited) i-face)
7867 (t nil))))
7868 (if (and (= cnt 0) (not ingroup)) (insert " "))
7869 (insert "[" c "] " tg (make-string
7870 (- fwidth 4 (length tg)) ?\ ))
7871 (push (cons tg c) ntable)
7872 (when (= (setq cnt (1+ cnt)) ncol)
7873 (insert "\n")
7874 (if ingroup (insert " "))
7875 (setq cnt 0)))))
7876 (setq ntable (nreverse ntable))
7877 (insert "\n")
7878 (goto-char (point-min))
7879 (if (fboundp 'fit-window-to-buffer) (fit-window-to-buffer))
7880 (setq rtn
7881 (catch 'exit
7882 (while t
7883 (message "[key]:Toggle SPC: clear current RET accept%s"
7884 (if groups " [!] ignore goups" ""))
7885 (setq c (read-char-exclusive))
7886 (cond
7887 ((= c ?\r) (throw 'exit t))
7888 ((= c ?!)
7889 (setq groups nil)
7890 (goto-char (point-min))
7891 (while (re-search-forward "[{}]" nil t) (replace-match " ")))
7892 ((or (= c ?\C-g)
7893 (and (= c ?q) (not (rassoc c ntable))))
7894 (setq quit-flag t))
7895 ((= c ?\ ) (setq current nil))
7896 ((setq e (rassoc c ntable) tg (car e))
7897 (if (member tg current)
7898 (setq current (delete tg current))
7899 (loop for g in groups do
7900 (if (member tg g)
7901 (mapcar (lambda (x)
7902 (setq current (delete x current)))
7903 g)))
7904 (setq current (cons tg current)))))
7905 ;; Create a sorted list
7906 (setq current
7907 (sort current
7908 (lambda (a b)
7909 (assoc b (cdr (memq (assoc a ntable) ntable))))))
7910 (goto-char (point-min))
7911 (beginning-of-line 2)
7912 (delete-region (point) (point-at-eol))
7913 (org-fast-tag-insert "Current" current c-face)
7914 (while (re-search-forward "\\[.\\] \\([a-zA-Z0-9_@]+\\)" nil t)
7915 (setq tg (match-string 1))
7916 (add-text-properties (match-beginning 1) (match-end 1)
7917 (list 'face
7918 (cond
7919 ((member tg current) c-face)
7920 ((member tg inherited) i-face)
7921 (t nil)))))
7922 (goto-char (point-min)))))
7923 (if rtn
7924 (mapconcat 'identity current ":")
7925 nil))))
7926
7215(defun org-get-tags () 7927(defun org-get-tags ()
7216 "Get the TAGS string in the current headline." 7928 "Get the TAGS string in the current headline."
7217 (unless (org-on-heading-p) 7929 (unless (org-on-heading-p)
@@ -7234,6 +7946,50 @@ With prefix ARG, realign all tags in headings in the current buffer."
7234 7946
7235;;; Link Stuff 7947;;; Link Stuff
7236 7948
7949(defvar org-create-file-search-functions nil
7950 "List of functions to construct the right search string for a file link.
7951These functions are called in turn with point at the location to
7952which the link should point.
7953
7954A function in the hook should first test if it would like to
7955handle this file type, for example by checking the major-mode or
7956the file extension. If it decides not to handle this file, it
7957should just return nil to give other functions a chance. If it
7958does handle the file, it must return the search string to be used
7959when following the link. The search string will be part of the
7960file link, given after a double colon, and `org-open-at-point'
7961will automatically search for it. If special measures must be
7962taken to make the search successful, another function should be
7963added to the companion hook `org-execute-file-search-functions',
7964which see.
7965
7966A function in this hook may also use `setq' to set the variable
7967`description' to provide a suggestion for the descriptive text to
7968be used for this link when it gets inserted into an Org-mode
7969buffer with \\[org-insert-link].")
7970
7971(defvar org-execute-file-search-functions nil
7972 "List of functions to execute a file search triggered by a link.
7973
7974Functions added to this hook must accept a single argument, the
7975search string that was part of the file link, the part after the
7976double colon. The function must first check if it would like to
7977handle this search, for example by checking the major-mode or the
7978file extension. If it decides not to handle this search, it
7979should just return nil to give other functions a chance. If it
7980does handle the search, it must return a non-nil value to keep
7981other functions from trying.
7982
7983Each function can access the current prefix argument through the
7984variable `current-prefix-argument'. Note that a single prefix is
7985used to force opening a link in Emacs, so it may be good to only
7986use a numeric or double prefix to guide the search function.
7987
7988In case this is needed, a function in this hook can also restore
7989the window configuration before `org-open-at-point' was called using:
7990
7991 (set-window-configuration org-window-config-before-follow-link)")
7992
7237(defun org-find-file-at-mouse (ev) 7993(defun org-find-file-at-mouse (ev)
7238 "Open file link or URL at mouse." 7994 "Open file link or URL at mouse."
7239 (interactive "e") 7995 (interactive "e")
@@ -7246,6 +8002,10 @@ With prefix ARG, realign all tags in headings in the current buffer."
7246 (mouse-set-point ev) 8002 (mouse-set-point ev)
7247 (org-open-at-point)) 8003 (org-open-at-point))
7248 8004
8005(defvar org-window-config-before-follow-link nil
8006 "The window configuration before following a link.
8007This is saved in case the need arises to restore it.")
8008
7249(defun org-open-at-point (&optional in-emacs) 8009(defun org-open-at-point (&optional in-emacs)
7250 "Open link at or after point. 8010 "Open link at or after point.
7251If there is no link at point, this function will search forward up to 8011If there is no link at point, this function will search forward up to
@@ -7253,6 +8013,7 @@ the end of the current subtree.
7253Normally, files will be opened by an appropriate application. If the 8013Normally, files will be opened by an appropriate application. If the
7254optional argument IN-EMACS is non-nil, Emacs will visit the file." 8014optional argument IN-EMACS is non-nil, Emacs will visit the file."
7255 (interactive "P") 8015 (interactive "P")
8016 (setq org-window-config-before-follow-link (current-window-configuration))
7256 (org-remove-occur-highlights nil nil t) 8017 (org-remove-occur-highlights nil nil t)
7257 (if (org-at-timestamp-p) 8018 (if (org-at-timestamp-p)
7258 (org-agenda-list nil (time-to-days (org-time-string-to-time 8019 (org-agenda-list nil (time-to-days (org-time-string-to-time
@@ -7336,7 +8097,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
7336 (t nil)))) 8097 (t nil))))
7337 8098
7338 ((string= type "file") 8099 ((string= type "file")
7339 (if (string-match "::?\\([0-9]+\\)\\'" path) ;; second : optional 8100 (if (string-match "::\\([0-9]+\\)\\'" path)
7340 (setq line (string-to-number (match-string 1 path)) 8101 (setq line (string-to-number (match-string 1 path))
7341 path (substring path 0 (match-beginning 0))) 8102 path (substring path 0 (match-beginning 0)))
7342 (if (string-match "::\\(.+\\)\\'" path) 8103 (if (string-match "::\\(.+\\)\\'" path)
@@ -7350,6 +8111,9 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
7350 ((string= type "bbdb") 8111 ((string= type "bbdb")
7351 (org-follow-bbdb-link path)) 8112 (org-follow-bbdb-link path))
7352 8113
8114 ((string= type "info")
8115 (org-follow-info-link path))
8116
7353 ((string= type "gnus") 8117 ((string= type "gnus")
7354 (let (group article) 8118 (let (group article)
7355 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 8119 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
@@ -7397,8 +8161,8 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
7397 (setq cmd (replace-match "<" t t cmd))) 8161 (setq cmd (replace-match "<" t t cmd)))
7398 (while (string-match "@}" cmd) 8162 (while (string-match "@}" cmd)
7399 (setq cmd (replace-match ">" t t cmd))) 8163 (setq cmd (replace-match ">" t t cmd)))
7400 (if (or (not org-confirm-shell-links) 8164 (if (or (not org-confirm-shell-link-function)
7401 (funcall org-confirm-shell-links 8165 (funcall org-confirm-shell-link-function
7402 (format "Execute \"%s\" in shell? " 8166 (format "Execute \"%s\" in shell? "
7403 (org-add-props cmd nil 8167 (org-add-props cmd nil
7404 'face 'org-warning)))) 8168 'face 'org-warning))))
@@ -7407,6 +8171,16 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
7407 (shell-command cmd)) 8171 (shell-command cmd))
7408 (error "Abort")))) 8172 (error "Abort"))))
7409 8173
8174 ((string= type "elisp")
8175 (let ((cmd path))
8176 (if (or (not org-confirm-elisp-link-function)
8177 (funcall org-confirm-elisp-link-function
8178 (format "Execute \"%s\" as elisp? "
8179 (org-add-props cmd nil
8180 'face 'org-warning))))
8181 (message "%s => %s" cmd (eval (read cmd)))
8182 (error "Abort"))))
8183
7410 (t 8184 (t
7411 (browse-url-at-point)))))) 8185 (browse-url-at-point))))))
7412 8186
@@ -7423,73 +8197,77 @@ in all files."
7423 (pos (point)) 8197 (pos (point))
7424 (pre "") (post "") 8198 (pre "") (post "")
7425 words re0 re1 re2 re3 re4 re5 re2a reall camel) 8199 words re0 re1 re2 re3 re4 re5 re2a reall camel)
7426 (cond ((save-excursion 8200 (cond
7427 (goto-char (point-min)) 8201 ;; First check if there are any special
7428 (and 8202 ((run-hook-with-args-until-success 'org-execute-file-search-functions s))
7429 (re-search-forward 8203 ;; Now try the builtin stuff
7430 (concat "<<" (regexp-quote s0) ">>") nil t) 8204 ((save-excursion
7431 (setq pos (match-beginning 0)))) 8205 (goto-char (point-min))
7432 ;; There is an exact target for this 8206 (and
7433 (goto-char pos)) 8207 (re-search-forward
7434 ((string-match "^/\\(.*\\)/$" s) 8208 (concat "<<" (regexp-quote s0) ">>") nil t)
7435 ;; A regular expression 8209 (setq pos (match-beginning 0))))
7436 (cond 8210 ;; There is an exact target for this
7437 ((eq major-mode 'org-mode) 8211 (goto-char pos))
7438 (org-occur (match-string 1 s))) 8212 ((string-match "^/\\(.*\\)/$" s)
7439 ;;((eq major-mode 'dired-mode) 8213 ;; A regular expression
7440 ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) 8214 (cond
7441 (t (org-do-occur (match-string 1 s))))) 8215 ((eq major-mode 'org-mode)
7442 ((or (setq camel (string-match (concat "^" org-camel-regexp "$") s)) 8216 (org-occur (match-string 1 s)))
7443 t) 8217 ;;((eq major-mode 'dired-mode)
7444 ;; A camel or a normal search string 8218 ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
7445 (when (equal (string-to-char s) ?*) 8219 (t (org-do-occur (match-string 1 s)))))
7446 ;; Anchor on headlines, post may include tags. 8220 ((or (setq camel (string-match (concat "^" org-camel-regexp "$") s))
7447 (setq pre "^\\*+[ \t]*\\(\\sw+\\)?[ \t]*" 8221 t)
7448 post "[ \t]*\\([ \t]+:[a-zA-Z_@0-9:+]:[ \t]*\\)?$" 8222 ;; A camel or a normal search string
7449 s (substring s 1))) 8223 (when (equal (string-to-char s) ?*)
7450 (remove-text-properties 8224 ;; Anchor on headlines, post may include tags.
7451 0 (length s) 8225 (setq pre "^\\*+[ \t]*\\(?:\\sw+\\)?[ \t]*"
7452 '(face nil mouse-face nil keymap nil fontified nil) s) 8226 post "[ \t]*\\(?:[ \t]+:[a-zA-Z_@0-9:+]:[ \t]*\\)?$"
7453 ;; Make a series of regular expressions to find a match 8227 s (substring s 1)))
7454 (setq words 8228 (remove-text-properties
7455 (if camel 8229 0 (length s)
7456 (org-camel-to-words s) 8230 '(face nil mouse-face nil keymap nil fontified nil) s)
7457 (org-split-string s "[ \n\r\t]+")) 8231 ;; Make a series of regular expressions to find a match
7458 re0 (concat "<<" (regexp-quote s0) ">>") 8232 (setq words
7459 re2 (concat "\\<" (mapconcat 'downcase words "[ \t]+") "\\>") 8233 (if camel
7460 re2a (concat "\\<" (mapconcat 'downcase words "[ \t\r\n]+") "\\>") 8234 (org-camel-to-words s)
7461 re4 (concat "\\<" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\>") 8235 (org-split-string s "[ \n\r\t]+"))
7462 re1 (concat pre re2 post) 8236 re0 (concat "\\(<<" (regexp-quote s0) ">>\\)")
7463 re3 (concat pre re4 post) 8237 re2 (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t]+") "\\)[ \t\r\n]")
7464 re5 (concat pre ".*" re4) 8238 re2a (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]")
7465 re2 (concat pre re2) 8239 re4 (concat "[^a-zA-Z_]\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]")
7466 re2a (concat pre re2a) 8240 re1 (concat pre re2 post)
7467 re4 (concat pre re4) 8241 re3 (concat pre re4 post)
7468 reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 8242 re5 (concat pre ".*" re4)
7469 "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" 8243 re2 (concat pre re2)
7470 re5 "\\)" 8244 re2a (concat pre re2a)
7471 )) 8245 re4 (concat pre re4)
7472 (cond 8246 reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2
7473 ((eq type 'org-occur) (org-occur reall)) 8247 "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\("
7474 ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) 8248 re5 "\\)"
7475 (t (goto-char (point-min)) 8249 ))
7476 (if (or (org-search-not-link re0 nil t) 8250 (cond
7477 (org-search-not-link re1 nil t) 8251 ((eq type 'org-occur) (org-occur reall))
7478 (org-search-not-link re2 nil t) 8252 ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup))
7479 (org-search-not-link re2a nil t) 8253 (t (goto-char (point-min))
7480 (org-search-not-link re3 nil t) 8254 (if (or (org-search-not-link re0 nil t)
7481 (org-search-not-link re4 nil t) 8255 (org-search-not-link re1 nil t)
7482 (org-search-not-link re5 nil t) 8256 (org-search-not-link re2 nil t)
7483 ) 8257 (org-search-not-link re2a nil t)
7484 (goto-char (match-beginning 0)) 8258 (org-search-not-link re3 nil t)
7485 (goto-char pos) 8259 (org-search-not-link re4 nil t)
7486 (error "No match"))))) 8260 (org-search-not-link re5 nil t)
7487 (t 8261 )
7488 ;; Normal string-search 8262 (goto-char (match-beginning 1))
7489 (goto-char (point-min)) 8263 (goto-char pos)
7490 (if (search-forward s nil t) 8264 (error "No match")))))
7491 (goto-char (match-beginning 0)) 8265 (t
7492 (error "No match")))) 8266 ;; Normal string-search
8267 (goto-char (point-min))
8268 (if (search-forward s nil t)
8269 (goto-char (match-beginning 0))
8270 (error "No match"))))
7493 (and (eq major-mode 'org-mode) (org-show-hierarchy-above)))) 8271 (and (eq major-mode 'org-mode) (org-show-hierarchy-above))))
7494 8272
7495(defun org-search-not-link (&rest args) 8273(defun org-search-not-link (&rest args)
@@ -7609,6 +8387,18 @@ onto the ring."
7609 (delete-window (get-buffer-window "*BBDB*")) 8387 (delete-window (get-buffer-window "*BBDB*"))
7610 (error "No matching BBDB record"))))) 8388 (error "No matching BBDB record")))))
7611 8389
8390
8391(defun org-follow-info-link (name)
8392 "Follow an info file & node link to NAME."
8393 (if (or (string-match "\\(.*\\)::?\\(.*\\)" name)
8394 (string-match "\\(.*\\)" name))
8395 (progn
8396 (require 'info)
8397 (if (match-string 2 name) ; If there isn't a node, choose "Top"
8398 (Info-find-node (match-string 1 name) (match-string 2 name))
8399 (Info-find-node (match-string 1 name) "Top")))
8400 (message (concat "Could not open: " name))))
8401
7612(defun org-follow-gnus-link (&optional group article) 8402(defun org-follow-gnus-link (&optional group article)
7613 "Follow a Gnus link to GROUP and ARTICLE." 8403 "Follow a Gnus link to GROUP and ARTICLE."
7614 (require 'gnus) 8404 (require 'gnus)
@@ -7792,6 +8582,61 @@ folders."
7792 (kill-this-buffer) 8582 (kill-this-buffer)
7793 (error "Message not found")))) 8583 (error "Message not found"))))
7794 8584
8585;; BibTeX links
8586
8587;; Use the custom search meachnism to construct and use search strings for
8588;; file links to BibTeX database entries.
8589
8590(defun org-create-file-search-in-bibtex ()
8591 "Create the search string and description for a BibTeX database entry."
8592 (when (eq major-mode 'bibtex-mode)
8593 ;; yes, we want to construct this search string.
8594 ;; Make a good description for this entry, using names, year and the title
8595 ;; Put it into the `description' variable which is dynamically scoped.
8596 (let ((bibtex-autokey-names 1)
8597 (bibtex-autokey-names-stretch 1)
8598 (bibtex-autokey-name-case-convert-function 'identity)
8599 (bibtex-autokey-name-separator " & ")
8600 (bibtex-autokey-additional-names " et al.")
8601 (bibtex-autokey-year-length 4)
8602 (bibtex-autokey-name-year-separator " ")
8603 (bibtex-autokey-titlewords 3)
8604 (bibtex-autokey-titleword-separator " ")
8605 (bibtex-autokey-titleword-case-convert-function 'identity)
8606 (bibtex-autokey-titleword-length 'infty)
8607 (bibtex-autokey-year-title-separator ": "))
8608 (setq description (bibtex-generate-autokey)))
8609 ;; Now parse the entry, get the key and return it.
8610 (save-excursion
8611 (bibtex-beginning-of-entry)
8612 (cdr (assoc "=key=" (bibtex-parse-entry))))))
8613
8614(defun org-execute-file-search-in-bibtex (s)
8615 "Find the link search string S as a key for a database entry."
8616 (when (eq major-mode 'bibtex-mode)
8617 ;; Yes, we want to do the search in this file.
8618 ;; We construct a regexp that searches for "@entrytype{" followed by the key
8619 (goto-char (point-min))
8620 (and (re-search-forward (concat "@[a-zA-Z]+[ \t\n]*{[ \t\n]*"
8621 (regexp-quote s) "[ \t\n]*,") nil t)
8622 (goto-char (match-beginning 0)))
8623 (if (and (match-beginning 0) (equal current-prefix-arg '(16)))
8624 ;; Use double prefix to indicate that any web link should be browsed
8625 (let ((b (current-buffer)) (p (point)))
8626 ;; Restore the window configuration because we just use the web link
8627 (set-window-configuration org-window-config-before-follow-link)
8628 (save-excursion (set-buffer b) (goto-char p)
8629 (bibtex-url)))
8630 (recenter 0)) ; Move entry start to beginning of window
8631 ;; return t to indicate that the search is done.
8632 t))
8633
8634;; Finally add the functions to the right hooks.
8635(add-hook 'org-create-file-search-functions 'org-create-file-search-in-bibtex)
8636(add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex)
8637
8638;; end of Bibtex link setup
8639
7795(defun org-upgrade-old-links (&optional query-description) 8640(defun org-upgrade-old-links (&optional query-description)
7796 "Transfer old <...> style links to new [[...]] style links. 8641 "Transfer old <...> style links to new [[...]] style links.
7797With arg query-description, ask at each match for a description text to use 8642With arg query-description, ask at each match for a description text to use
@@ -7907,7 +8752,7 @@ For some link types, a prefix arg is interpreted:
7907For links to usenet articles, arg negates `org-usenet-links-prefer-google'. 8752For links to usenet articles, arg negates `org-usenet-links-prefer-google'.
7908For file links, arg negates `org-context-in-file-links'." 8753For file links, arg negates `org-context-in-file-links'."
7909 (interactive "P") 8754 (interactive "P")
7910 (let (link cpltxt desc txt (pos (point))) 8755 (let (link cpltxt desc description search txt (pos (point)))
7911 (cond 8756 (cond
7912 8757
7913 ((eq major-mode 'bbdb-mode) 8758 ((eq major-mode 'bbdb-mode)
@@ -7917,6 +8762,13 @@ For file links, arg negates `org-context-in-file-links'."
7917 (bbdb-record-company (bbdb-current-record)))) 8762 (bbdb-record-company (bbdb-current-record))))
7918 link (org-make-link cpltxt))) 8763 link (org-make-link cpltxt)))
7919 8764
8765 ((eq major-mode 'Info-mode)
8766 (setq link (org-make-link "info:"
8767 (file-name-nondirectory Info-current-file)
8768 ":" Info-current-node))
8769 (setq cpltxt (concat (file-name-nondirectory Info-current-file)
8770 ":" Info-current-node)))
8771
7920 ((eq major-mode 'calendar-mode) 8772 ((eq major-mode 'calendar-mode)
7921 (let ((cd (calendar-cursor-to-date))) 8773 (let ((cd (calendar-cursor-to-date)))
7922 (setq link 8774 (setq link
@@ -8020,6 +8872,12 @@ For file links, arg negates `org-context-in-file-links'."
8020 (setq cpltxt w3m-current-url 8872 (setq cpltxt w3m-current-url
8021 link (org-make-link cpltxt))) 8873 link (org-make-link cpltxt)))
8022 8874
8875 ((setq search (run-hook-with-args-until-success
8876 'org-create-file-search-functions))
8877 (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
8878 "::" search))
8879 (setq cpltxt (or description link)))
8880
8023 ((eq major-mode 'org-mode) 8881 ((eq major-mode 'org-mode)
8024 ;; Just link to current headline 8882 ;; Just link to current headline
8025 (setq cpltxt (concat "file:" 8883 (setq cpltxt (concat "file:"
@@ -8039,12 +8897,13 @@ For file links, arg negates `org-context-in-file-links'."
8039 ((org-region-active-p) 8897 ((org-region-active-p)
8040 (buffer-substring (region-beginning) (region-end))) 8898 (buffer-substring (region-beginning) (region-end)))
8041 (t (buffer-substring (point-at-bol) (point-at-eol))))) 8899 (t (buffer-substring (point-at-bol) (point-at-eol)))))
8042 (setq cpltxt 8900 (when (or (null txt) (string-match "\\S-" txt))
8043 (concat cpltxt "::" 8901 (setq cpltxt
8044 (if org-file-link-context-use-camel-case 8902 (concat cpltxt "::"
8045 (org-make-org-heading-camel txt) 8903 (if org-file-link-context-use-camel-case
8046 (org-make-org-heading-search-string txt))) 8904 (org-make-org-heading-camel txt)
8047 desc "NONE"))) 8905 (org-make-org-heading-search-string txt)))
8906 desc "NONE"))))
8048 (if (string-match "::\\'" cpltxt) 8907 (if (string-match "::\\'" cpltxt)
8049 (setq cpltxt (substring cpltxt 0 -2))) 8908 (setq cpltxt (substring cpltxt 0 -2)))
8050 (setq link (org-make-link cpltxt))) 8909 (setq link (org-make-link cpltxt)))
@@ -8058,12 +8917,14 @@ For file links, arg negates `org-context-in-file-links'."
8058 (setq txt (if (org-region-active-p) 8917 (setq txt (if (org-region-active-p)
8059 (buffer-substring (region-beginning) (region-end)) 8918 (buffer-substring (region-beginning) (region-end))
8060 (buffer-substring (point-at-bol) (point-at-eol)))) 8919 (buffer-substring (point-at-bol) (point-at-eol))))
8061 (setq cpltxt 8920 ;; Only use search option if there is some text.
8062 (concat cpltxt "::" 8921 (when (string-match "\\S-" txt)
8063 (if org-file-link-context-use-camel-case 8922 (setq cpltxt
8064 (org-make-org-heading-camel txt) 8923 (concat cpltxt "::"
8065 (org-make-org-heading-search-string txt))) 8924 (if org-file-link-context-use-camel-case
8066 desc "NONE")) 8925 (org-make-org-heading-camel txt)
8926 (org-make-org-heading-search-string txt)))
8927 desc "NONE")))
8067 (setq link (org-make-link cpltxt))) 8928 (setq link (org-make-link cpltxt)))
8068 8929
8069 ((interactive-p) 8930 ((interactive-p)
@@ -8287,16 +9148,39 @@ is in the current directory or below."
8287 ;; URL-like link, normalize the use of angular brackets. 9148 ;; URL-like link, normalize the use of angular brackets.
8288 (setq link (org-make-link (org-remove-angle-brackets link)))) 9149 (setq link (org-make-link (org-remove-angle-brackets link))))
8289 9150
8290 ;; Check if we are linking to the current file. If yes, simplify the link. 9151 ;; Check if we are linking to the current file with a search option
9152 ;; If yes, simplify the link by using only the search option.
8291 (when (string-match "\\<file:\\(.+?\\)::\\([^>]+\\)" link) 9153 (when (string-match "\\<file:\\(.+?\\)::\\([^>]+\\)" link)
8292 (let* ((path (match-string 1 link)) 9154 (let* ((path (match-string 1 link))
8293 (case-fold-search nil) 9155 (case-fold-search nil)
8294 (search (match-string 2 link))) 9156 (search (match-string 2 link)))
8295 (when (save-match-data 9157 (save-match-data
8296 (equal (file-truename buffer-file-name) 9158 (if (equal (file-truename buffer-file-name) (file-truename path))
8297 (file-truename path))) 9159 ;; We are linking to this same file, with a search option
8298 ;; We are linking to this same file, with a search option 9160 (setq link search)))))
8299 (setq link search)))) 9161
9162 ;; Check if we can/should use a relative path. If yes, simplify the link
9163 (when (string-match "\\<file:\\(.*\\)" link)
9164 (let* ((path (match-string 1 link))
9165 (case-fold-search nil))
9166 (cond
9167 ((eq org-link-file-path-type 'absolute)
9168 (setq path (abbreviate-file-name (expand-file-name path))))
9169 ((eq org-link-file-path-type 'noabbrev)
9170 (setq path (expand-file-name path)))
9171 ((eq org-link-file-path-type 'relative)
9172 (setq path (file-relative-name path)))
9173 (t
9174 (save-match-data
9175 (if (string-match (concat "^" (regexp-quote
9176 (file-name-as-directory
9177 (expand-file-name "."))))
9178 (expand-file-name path))
9179 ;; We are linking a file with relative path name.
9180 (setq path (substring (expand-file-name path)
9181 (match-end 0)))))))
9182 (setq link (concat "file:" path))))
9183
8300 (setq desc (read-string "Description: " desc)) 9184 (setq desc (read-string "Description: " desc))
8301 (unless (string-match "\\S-" desc) (setq desc nil)) 9185 (unless (string-match "\\S-" desc) (setq desc nil))
8302 (if remove (apply 'delete-region remove)) 9186 (if remove (apply 'delete-region remove))
@@ -8329,48 +9213,52 @@ RET on headline -> Store as sublevel entry to current headline
8329 9213
8330;;;###autoload 9214;;;###autoload
8331(defun org-remember-apply-template () 9215(defun org-remember-apply-template ()
8332 "Initialize *remember* buffer with template, invode `org-mode'. 9216 "Initialize *remember* buffer with template, invoke `org-mode'.
8333This function should be placed into `remember-mode-hook' and in fact requires 9217This function should be placed into `remember-mode-hook' and in fact requires
8334to be run from that hook to fucntion properly." 9218to be run from that hook to fucntion properly."
8335 (when org-remember-templates 9219 (if org-remember-templates
8336 (let* ((entry (if (= (length org-remember-templates) 1) 9220
8337 (cdar org-remember-templates) 9221 (let* ((entry (if (= (length org-remember-templates) 1)
8338 (message "Select template: %s" 9222 (cdar org-remember-templates)
8339 (mapconcat 9223 (message "Select template: %s"
8340 (lambda (x) (char-to-string (car x))) 9224 (mapconcat
8341 org-remember-templates " ")) 9225 (lambda (x) (char-to-string (car x)))
8342 (cdr (assoc (read-char-exclusive) org-remember-templates)))) 9226 org-remember-templates " "))
8343 (tpl (if (consp (cdr entry)) (cadr entry) (cdr entry))) 9227 (cdr (assoc (read-char-exclusive) org-remember-templates))))
8344 (file (if (consp (cdr entry)) (nth 2 entry))) 9228 (tpl (car entry))
8345 (v-t (format-time-string (car org-time-stamp-formats) (org-current-time))) 9229 (file (if (consp (cdr entry)) (nth 1 entry)))
8346 (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time))) 9230 (v-t (format-time-string (car org-time-stamp-formats) (org-current-time)))
8347 (v-u (concat "[" (substring v-t 1 -1) "]")) 9231 (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time)))
8348 (v-U (concat "[" (substring v-T 1 -1) "]")) 9232 (v-u (concat "[" (substring v-t 1 -1) "]"))
8349 (v-a annotation) ; defined in `remember-mode' 9233 (v-U (concat "[" (substring v-T 1 -1) "]"))
8350 (v-i initial) ; defined in `remember-mode' 9234 (v-a annotation) ; defined in `remember-mode'
8351 (v-n user-full-name) 9235 (v-i initial) ; defined in `remember-mode'
8352 ) 9236 (v-n user-full-name)
8353 (unless tpl (setq tpl "") (message "No template") (ding)) 9237 )
8354 (insert tpl) (goto-char (point-min)) 9238 (unless tpl (setq tpl "") (message "No template") (ding))
8355 (while (re-search-forward "%\\([tTuTai]\\)" nil t) 9239 (insert tpl) (goto-char (point-min))
8356 (when (and initial (equal (match-string 0) "%i")) 9240 (while (re-search-forward "%\\([tTuTai]\\)" nil t)
8357 (save-match-data 9241 (when (and initial (equal (match-string 0) "%i"))
8358 (let* ((lead (buffer-substring 9242 (save-match-data
8359 (point-at-bol) (match-beginning 0)))) 9243 (let* ((lead (buffer-substring
8360 (setq v-i (mapconcat 'identity 9244 (point-at-bol) (match-beginning 0))))
9245 (setq v-i (mapconcat 'identity
8361 (org-split-string initial "\n") 9246 (org-split-string initial "\n")
8362 (concat "\n" lead)))))) 9247 (concat "\n" lead))))))
8363 (replace-match 9248 (replace-match
8364 (or (eval (intern (concat "v-" (match-string 1)))) "") 9249 (or (eval (intern (concat "v-" (match-string 1)))) "")
8365 t t)) 9250 t t))
8366 (let ((org-startup-folded nil) 9251 (let ((org-startup-folded nil)
8367 (org-startup-with-deadline-check nil)) 9252 (org-startup-with-deadline-check nil))
8368 (org-mode)) 9253 (org-mode))
8369 (if (and file (string-match "\\S-" file) (not (file-directory-p file))) 9254 (if (and file (string-match "\\S-" file) (not (file-directory-p file)))
8370 (set (make-local-variable 'org-default-notes-file) file)) 9255 (set (make-local-variable 'org-default-notes-file) file))
8371 (goto-char (point-min)) 9256 (goto-char (point-min))
8372 (if (re-search-forward "%\\?" nil t) (replace-match "")) 9257 (if (re-search-forward "%\\?" nil t) (replace-match "")))
8373 (set (make-local-variable 'org-finish-function) 'remember-buffer)))) 9258 (let ((org-startup-folded nil)
9259 (org-startup-with-deadline-check nil))
9260 (org-mode)))
9261 (set (make-local-variable 'org-finish-function) 'remember-buffer))
8374 9262
8375;;;###autoload 9263;;;###autoload
8376(defun org-remember-handler () 9264(defun org-remember-handler ()
@@ -8439,6 +9327,9 @@ See also the variable `org-reverse-note-order'."
8439 (if (not visiting) 9327 (if (not visiting)
8440 (find-file-noselect file)) 9328 (find-file-noselect file))
8441 (with-current-buffer (get-file-buffer file) 9329 (with-current-buffer (get-file-buffer file)
9330 (save-excursion (and (goto-char (point-min))
9331 (not (re-search-forward "^\\* " nil t))
9332 (insert "\n* Notes\n")))
8442 (setq reversed (org-notes-order-reversed-p)) 9333 (setq reversed (org-notes-order-reversed-p))
8443 (save-excursion 9334 (save-excursion
8444 (save-restriction 9335 (save-restriction
@@ -8717,7 +9608,7 @@ This is being used to correctly align a single field after TAB or RET.")
8717 ;; Check if we have links 9608 ;; Check if we have links
8718 (goto-char beg) 9609 (goto-char beg)
8719 (setq links (re-search-forward org-bracket-link-regexp end t)) 9610 (setq links (re-search-forward org-bracket-link-regexp end t))
8720 ;; Make sure the link properties are right FIXME: Can this be optimized???? 9611 ;; Make sure the link properties are right
8721 (when links (goto-char beg) (while (org-activate-bracket-links end))) 9612 (when links (goto-char beg) (while (org-activate-bracket-links end)))
8722 ;; Check if we are narrowing any columns 9613 ;; Check if we are narrowing any columns
8723 (goto-char beg) 9614 (goto-char beg)
@@ -8866,7 +9757,7 @@ With argument TABLE-TYPE, go to the beginning of a table.el-type table."
8866 (if table-type org-table-any-border-regexp 9757 (if table-type org-table-any-border-regexp
8867 org-table-border-regexp) 9758 org-table-border-regexp)
8868 nil t)) 9759 nil t))
8869 (error "Can't find beginning of table") 9760 (progn (goto-char (point-min)) (point))
8870 (goto-char (match-beginning 0)) 9761 (goto-char (match-beginning 0))
8871 (beginning-of-line 2) 9762 (beginning-of-line 2)
8872 (point)))) 9763 (point))))
@@ -8914,7 +9805,7 @@ Optional argument NEW may specify text to replace the current field content."
8914 n (format f s)) 9805 n (format f s))
8915 (if new 9806 (if new
8916 (if (<= (length new) l) ;; FIXME: length -> str-width? 9807 (if (<= (length new) l) ;; FIXME: length -> str-width?
8917 (setq n (format f new t t)) ;; FIXME: t t? 9808 (setq n (format f new))
8918 (setq n (concat new "|") org-table-may-need-update t))) 9809 (setq n (concat new "|") org-table-may-need-update t)))
8919 (or (equal n o) 9810 (or (equal n o)
8920 (let (org-table-may-need-update) 9811 (let (org-table-may-need-update)
@@ -9213,7 +10104,7 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
9213 "Please position cursor in a data line for column operations"))))) 10104 "Please position cursor in a data line for column operations")))))
9214 10105
9215(defun org-table-delete-column () 10106(defun org-table-delete-column ()
9216 "Delete a column into the table." 10107 "Delete a column from the table."
9217 (interactive) 10108 (interactive)
9218 (if (not (org-at-table-p)) 10109 (if (not (org-at-table-p))
9219 (error "Not at a table")) 10110 (error "Not at a table"))
@@ -9352,7 +10243,7 @@ With prefix ARG, insert above the current line."
9352In particular, this does handle wide and invisible characters." 10243In particular, this does handle wide and invisible characters."
9353 (if (string-match "^[ \t]*|-" s) 10244 (if (string-match "^[ \t]*|-" s)
9354 ;; It's a hline, just map the characters 10245 ;; It's a hline, just map the characters
9355 (setq s (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) s)) 10246 (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s ""))
9356 (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s) 10247 (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s)
9357 (setq s (replace-match 10248 (setq s (replace-match
9358 (concat "|" (make-string (org-string-width (match-string 1 s)) 10249 (concat "|" (make-string (org-string-width (match-string 1 s))
@@ -9401,7 +10292,7 @@ also in table column 3. The command will prompt for the sorting method
9401 (lambda (a b) (< (car a) (car b))) 10292 (lambda (a b) (< (car a) (car b)))
9402 (lambda (a b) (string< (car a) (car b))))) 10293 (lambda (a b) (string< (car a) (car b)))))
9403 (setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x)) 10294 (setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x))
9404 (split-string (buffer-substring beg end) "\n"))) 10295 (org-split-string (buffer-substring beg end) "\n")))
9405 (if numericp 10296 (if numericp
9406 (setq lns (mapcar (lambda(x) 10297 (setq lns (mapcar (lambda(x)
9407 (cons (string-to-number (car x)) (cdr x))) 10298 (cons (string-to-number (car x)) (cdr x)))
@@ -9937,7 +10828,7 @@ the current column, to avoid unnecessary parsing."
9937 "\n"))) 10828 "\n")))
9938 10829
9939(defun org-table-get-stored-formulas () 10830(defun org-table-get-stored-formulas ()
9940 "Return an alist with the t=stored formulas directly after current table." 10831 "Return an alist with the stored formulas directly after current table."
9941 (interactive) 10832 (interactive)
9942 (let (scol eq eq-alist strings string seen) 10833 (let (scol eq eq-alist strings string seen)
9943 (save-excursion 10834 (save-excursion
@@ -10217,7 +11108,7 @@ not overwrite the stored one."
10217 (org-table-get-formula equation (equal arg '(4))))) 11108 (org-table-get-formula equation (equal arg '(4)))))
10218 (n0 (org-table-current-column)) 11109 (n0 (org-table-current-column))
10219 (modes (copy-sequence org-calc-default-modes)) 11110 (modes (copy-sequence org-calc-default-modes))
10220 n form fmt x ev orig c) 11111 n form fmt x ev orig c lispp)
10221 ;; Parse the format string. Since we have a lot of modes, this is 11112 ;; Parse the format string. Since we have a lot of modes, this is
10222 ;; a lot of work. However, I think calc still uses most of the time. 11113 ;; a lot of work. However, I think calc still uses most of the time.
10223 (if (string-match ";" formula) 11114 (if (string-match ";" formula)
@@ -10252,7 +11143,8 @@ not overwrite the stored one."
10252 (lambda (x) (number-to-string (string-to-number x))) 11143 (lambda (x) (number-to-string (string-to-number x)))
10253 fields))) 11144 fields)))
10254 (setq ndown (1- ndown)) 11145 (setq ndown (1- ndown))
10255 (setq form (copy-sequence formula)) 11146 (setq form (copy-sequence formula)
11147 lispp (equal (substring form 0 2) "'("))
10256 ;; Insert the references to fields in same row 11148 ;; Insert the references to fields in same row
10257 (while (string-match "\\$\\([0-9]+\\)?" form) 11149 (while (string-match "\\$\\([0-9]+\\)?" form)
10258 (setq n (if (match-beginning 1) 11150 (setq n (if (match-beginning 1)
@@ -10262,7 +11154,9 @@ not overwrite the stored one."
10262 (unless x (error "Invalid field specifier \"%s\"" 11154 (unless x (error "Invalid field specifier \"%s\""
10263 (match-string 0 form))) 11155 (match-string 0 form)))
10264 (if (equal x "") (setq x "0")) 11156 (if (equal x "") (setq x "0"))
10265 (setq form (replace-match (concat "(" x ")") t t form))) 11157 (setq form (replace-match
11158 (if lispp x (concat "(" x ")"))
11159 t t form)))
10266 ;; Insert ranges in current column 11160 ;; Insert ranges in current column
10267 (while (string-match "\\&[-I0-9]+" form) 11161 (while (string-match "\\&[-I0-9]+" form)
10268 (setq form (replace-match 11162 (setq form (replace-match
@@ -10270,8 +11164,11 @@ not overwrite the stored one."
10270 (org-table-get-vertical-vector (match-string 0 form) 11164 (org-table-get-vertical-vector (match-string 0 form)
10271 nil n0)) 11165 nil n0))
10272 t t form))) 11166 t t form)))
10273 (setq ev (calc-eval (cons form modes) 11167 (if lispp
10274 (if org-table-formula-numbers-only 'num))) 11168 (setq ev (eval (eval (read form)))
11169 ev (if (numberp ev) (number-to-string ev) ev))
11170 (setq ev (calc-eval (cons form modes)
11171 (if org-table-formula-numbers-only 'num))))
10275 11172
10276 (when org-table-formula-debug 11173 (when org-table-formula-debug
10277 (with-output-to-temp-buffer "*Help*" 11174 (with-output-to-temp-buffer "*Help*"
@@ -10827,6 +11724,109 @@ overwritten, and the table is not marked as requiring realignment."
10827 11724
10828(defconst org-level-max 20) 11725(defconst org-level-max 20)
10829 11726
11727(defvar org-export-html-preamble nil
11728 "Preamble, to be inserted just after <body>. Set by publishing functions.")
11729(defvar org-export-html-postamble nil
11730 "Preamble, to be inserted just before </body>. Set by publishing functions.")
11731(defvar org-export-html-auto-preamble t
11732 "Should default preamble be inserted? Set by publishing functions.")
11733(defvar org-export-html-auto-postamble t
11734 "Should default postamble be inserted? Set by publishing functions.")
11735
11736(defconst org-export-plist-vars
11737 '((:language . org-export-default-language)
11738 (:headline-levels . org-export-headline-levels)
11739 (:section-numbers . org-export-with-section-numbers)
11740 (:table-of-contents . org-export-with-toc)
11741 (:emphasize . org-export-with-emphasize)
11742 (:sub-superscript . org-export-with-sub-superscripts)
11743 (:TeX-macros . org-export-with-TeX-macros)
11744 (:fixed-width . org-export-with-fixed-width)
11745 (:timestamps . org-export-with-timestamps)
11746 (:tables . org-export-with-tables)
11747 (:table-auto-headline . org-export-highlight-first-table-line)
11748 (:style . org-export-html-style)
11749 (:convert-org-links . org-export-html-link-org-files-as-html)
11750 (:inline-images . org-export-html-inline-images)
11751 (:expand-quoted-html . org-export-html-expand)
11752 (:timestamp . org-export-html-with-timestamp)
11753 (:publishing-directory . org-export-publishing-directory)
11754 (:preamble . org-export-html-preamble)
11755 (:postamble . org-export-html-postamble)
11756 (:auto-preamble . org-export-html-auto-preamble)
11757 (:auto-postamble . org-export-html-auto-postamble)
11758 (:author . user-full-name)
11759 (:email . user-mail-address)))
11760
11761(defun org-default-export-plist ()
11762 "Return the property list with default settings for the export variables."
11763 (let ((l org-export-plist-vars) rtn e)
11764 (while (setq e (pop l))
11765 (setq rtn (cons (car e) (cons (symbol-value (cdr e)) rtn))))
11766 rtn))
11767
11768(defun org-infile-export-plist ()
11769 "Return the property list with file-local settings for export."
11770 (save-excursion
11771 (goto-char 0)
11772 (let ((re (org-make-options-regexp
11773 '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")))
11774 (text nil)
11775 p key val text options)
11776 (while (re-search-forward re nil t)
11777 (setq key (org-match-string-no-properties 1)
11778 val (org-match-string-no-properties 2))
11779 (cond
11780 ((string-equal key "TITLE") (setq p (plist-put p :title val)))
11781 ((string-equal key "AUTHOR")(setq p (plist-put p :author val)))
11782 ((string-equal key "EMAIL") (setq p (plist-put p :email val)))
11783 ((string-equal key "LANGUAGE") (setq p (plist-put p :language val)))
11784 ((string-equal key "TEXT")
11785 (setq text (if text (concat text "\n" val) val)))
11786 ((string-equal key "OPTIONS") (setq options val))))
11787 (setq p (plist-put p :text text))
11788 (when options
11789 (let ((op '(("H" . :headline-levels)
11790 ("num" . :section-numbers)
11791 ("toc" . :table-of-contents)
11792 ("\\n" . :preserve-breaks)
11793 ("@" . :expand-quoted-html)
11794 (":" . :fixed-width)
11795 ("|" . :tables)
11796 ("^" . :sub-superscript)
11797 ("*" . :emphasize)
11798 ("TeX" . :TeX-macros)))
11799 o)
11800 (while (setq o (pop op))
11801 (if (string-match (concat (regexp-quote (car o))
11802 ":\\([^ \t\n\r;,.]*\\)")
11803 options)
11804 (setq p (plist-put p (cdr o)
11805 (car (read-from-string
11806 (match-string 1 options)))))))))
11807 p)))
11808
11809(defun org-combine-plists (&rest plists)
11810 "Create a single property list from all plists in PLISTS.
11811The process starts by copying the last list, and then setting properties
11812from the other lists. Settings in the first list are the most significant
11813ones and overrule settings in the other lists."
11814 (let ((rtn (copy-sequence (pop plists)))
11815 p v ls)
11816 (while plists
11817 (setq ls (pop plists))
11818 (while ls
11819 (setq p (pop ls) v (pop ls))
11820 (setq rtn (plist-put rtn p v))))
11821 rtn))
11822
11823(defun org-export-directory (type plist)
11824 (let* ((val (plist-get plist :publishing-directory))
11825 (dir (if (listp val)
11826 (or (cdr (assoc type val)) ".")
11827 val)))
11828 dir))
11829
10830(defun org-export-find-first-heading-line (list) 11830(defun org-export-find-first-heading-line (list)
10831 "Remove all lines from LIST which are before the first headline." 11831 "Remove all lines from LIST which are before the first headline."
10832 (let ((orig-list list) 11832 (let ((orig-list list)
@@ -10854,7 +11854,10 @@ overwritten, and the table is not marked as requiring realignment."
10854 ;; an ordinary comment line 11854 ;; an ordinary comment line
10855 ) 11855 )
10856 ((and org-export-table-remove-special-lines 11856 ((and org-export-table-remove-special-lines
10857 (string-match "^[ \t]*| *[!_^] *|" line)) 11857 (string-match "^[ \t]*|" line)
11858 (or (string-match "^[ \t]*| *[!_^] *|" line)
11859 (and (string-match "| *<[0-9]+> *|" line)
11860 (not (string-match "| *[^ <|]" line)))))
10858 ;; a special table line that should be removed 11861 ;; a special table line that should be removed
10859 ) 11862 )
10860 (t (setq rtn (cons line rtn))))) 11863 (t (setq rtn (cons line rtn)))))
@@ -10862,9 +11865,6 @@ overwritten, and the table is not marked as requiring realignment."
10862 11865
10863;; ASCII 11866;; ASCII
10864 11867
10865(defconst org-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-)
10866 "Characters for underlining headings in ASCII export.")
10867
10868(defconst org-html-entities 11868(defconst org-html-entities
10869 '(("nbsp") 11869 '(("nbsp")
10870 ("iexcl") 11870 ("iexcl")
@@ -11266,6 +12266,7 @@ is signaled in this case."
11266 (if org-odd-levels-only (1+ (/ n 2)) n)) 12266 (if org-odd-levels-only (1+ (/ n 2)) n))
11267 12267
11268(defvar org-last-level nil) ; dynamically scoped variable 12268(defvar org-last-level nil) ; dynamically scoped variable
12269(defvar org-ascii-current-indentation nil) ; For communication
11269 12270
11270(defun org-export-as-ascii (arg) 12271(defun org-export-as-ascii (arg)
11271 "Export the outline as a pretty ASCII file. 12272 "Export the outline as a pretty ASCII file.
@@ -11274,7 +12275,9 @@ The prefix ARG specifies how many levels of the outline should become
11274underlined headlines. The default is 3." 12275underlined headlines. The default is 3."
11275 (interactive "P") 12276 (interactive "P")
11276 (setq-default org-todo-line-regexp org-todo-line-regexp) 12277 (setq-default org-todo-line-regexp org-todo-line-regexp)
11277 (let* ((region 12278 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
12279 (org-infile-export-plist)))
12280 (region
11278 (buffer-substring 12281 (buffer-substring
11279 (if (org-region-active-p) (region-beginning) (point-min)) 12282 (if (org-region-active-p) (region-beginning) (point-min))
11280 (if (org-region-active-p) (region-end) (point-max)))) 12283 (if (org-region-active-p) (region-end) (point-max))))
@@ -11283,21 +12286,28 @@ underlined headlines. The default is 3."
11283 (org-split-string 12286 (org-split-string
11284 (org-cleaned-string-for-export region) 12287 (org-cleaned-string-for-export region)
11285 "[\r\n]")))) 12288 "[\r\n]"))))
12289 (org-ascii-current-indentation '(0 . 0))
11286 (org-startup-with-deadline-check nil) 12290 (org-startup-with-deadline-check nil)
11287 (level 0) line txt 12291 (level 0) line txt
11288 (umax nil) 12292 (umax nil)
11289 (case-fold-search nil) 12293 (case-fold-search nil)
11290 (filename (concat (file-name-sans-extension buffer-file-name) 12294 (filename (concat (file-name-as-directory
12295 (org-export-directory :ascii opt-plist))
12296 (file-name-sans-extension
12297 (file-name-nondirectory buffer-file-name))
11291 ".txt")) 12298 ".txt"))
11292 (buffer (find-file-noselect filename)) 12299 (buffer (find-file-noselect filename))
11293 (levels-open (make-vector org-level-max nil)) 12300 (levels-open (make-vector org-level-max nil))
12301 (odd org-odd-levels-only)
11294 (date (format-time-string "%Y/%m/%d" (current-time))) 12302 (date (format-time-string "%Y/%m/%d" (current-time)))
11295 (time (format-time-string "%X" (org-current-time))) 12303 (time (format-time-string "%X" (org-current-time)))
11296 (author user-full-name) 12304 (author (plist-get opt-plist :author))
11297 (title (buffer-name)) 12305 (title (or (plist-get opt-plist :title)
12306 (file-name-sans-extension
12307 (file-name-nondirectory buffer-file-name))))
11298 (options nil) 12308 (options nil)
11299 (email user-mail-address) 12309 (email (plist-get opt-plist :email))
11300 (language org-export-default-language) 12310 (language (plist-get opt-plist :language))
11301 (text nil) 12311 (text nil)
11302 (todo nil) 12312 (todo nil)
11303 (lang-words nil)) 12313 (lang-words nil))
@@ -11307,9 +12317,6 @@ underlined headlines. The default is 3."
11307 12317
11308 (find-file-noselect filename) 12318 (find-file-noselect filename)
11309 12319
11310 ;; Search for the export key lines
11311 (org-parse-key-lines)
11312
11313 (setq lang-words (or (assoc language org-export-language-setup) 12320 (setq lang-words (or (assoc language org-export-language-setup)
11314 (assoc "en" org-export-language-setup))) 12321 (assoc "en" org-export-language-setup)))
11315 (if org-export-ascii-show-new-buffer 12322 (if org-export-ascii-show-new-buffer
@@ -11317,7 +12324,13 @@ underlined headlines. The default is 3."
11317 (set-buffer buffer)) 12324 (set-buffer buffer))
11318 (erase-buffer) 12325 (erase-buffer)
11319 (fundamental-mode) 12326 (fundamental-mode)
11320 (if options (org-parse-export-options options)) 12327 ;; create local variables for all options, to make sure all called
12328 ;; functions get the correct information
12329 (mapcar (lambda (x)
12330 (set (make-local-variable (cdr x))
12331 (plist-get opt-plist (car x))))
12332 org-export-plist-vars)
12333 (set (make-local-variable 'org-odd-levels-only) odd)
11321 (setq umax (if arg (prefix-numeric-value arg) 12334 (setq umax (if arg (prefix-numeric-value arg)
11322 org-export-headline-levels)) 12335 org-export-headline-levels))
11323 12336
@@ -11347,7 +12360,8 @@ underlined headlines. The default is 3."
11347 level (org-tr-level level) 12360 level (org-tr-level level)
11348 txt (match-string 3 line) 12361 txt (match-string 3 line)
11349 todo 12362 todo
11350 (or (and (match-beginning 2) 12363 (or (and org-export-mark-todo-in-toc
12364 (match-beginning 2)
11351 (not (equal (match-string 2 line) 12365 (not (equal (match-string 2 line)
11352 org-done-string))) 12366 org-done-string)))
11353 ; TODO, not DONE 12367 ; TODO, not DONE
@@ -11386,10 +12400,24 @@ underlined headlines. The default is 3."
11386 ;; a Headline 12400 ;; a Headline
11387 (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) 12401 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
11388 txt (match-string 2 line)) 12402 txt (match-string 2 line))
11389 (org-ascii-level-start level txt umax)) 12403 (org-ascii-level-start level txt umax lines))
11390 (t (insert line "\n")))) 12404 (t
12405 (insert (org-fix-indentation line org-ascii-current-indentation) "\n"))))
11391 (normal-mode) 12406 (normal-mode)
11392 (save-buffer) 12407 (save-buffer)
12408 ;; remove display and invisible chars
12409 (let (beg end s)
12410 (goto-char (point-min))
12411 (while (setq beg (next-single-property-change (point) 'display))
12412 (setq end (next-single-property-change beg 'display))
12413 (delete-region beg end)
12414 (goto-char beg)
12415 (insert "=>"))
12416 (goto-char (point-min))
12417 (while (setq beg (next-single-property-change (point) 'org-cwidth))
12418 (setq end (next-single-property-change beg 'org-cwidth))
12419 (delete-region beg end)
12420 (goto-char beg)))
11393 (goto-char (point-min)))) 12421 (goto-char (point-min))))
11394 12422
11395(defun org-search-todo-below (line lines level) 12423(defun org-search-todo-below (line lines level)
@@ -11409,8 +12437,6 @@ underlined headlines. The default is 3."
11409 (if (<= lv level) (throw 'exit nil)) 12437 (if (<= lv level) (throw 'exit nil))
11410 (if todo (throw 'exit t)))))))) 12438 (if todo (throw 'exit t))))))))
11411 12439
11412;; FIXME: Try to handle <b> and <i> as faces via text properties.
11413;; We could also implement *bold*,/italic/ and _underline_ for ASCII export
11414(defun org-html-expand-for-ascii (line) 12440(defun org-html-expand-for-ascii (line)
11415 "Handle quoted HTML for ASCII export." 12441 "Handle quoted HTML for ASCII export."
11416 (if org-export-html-expand 12442 (if org-export-html-expand
@@ -11428,51 +12454,80 @@ underlined headlines. The default is 3."
11428 (make-string (string-width s) underline) 12454 (make-string (string-width s) underline)
11429 "\n")))) 12455 "\n"))))
11430 12456
11431(defun org-ascii-level-start (level title umax) 12457(defun org-ascii-level-start (level title umax &optional lines)
11432 "Insert a new level in ASCII export." 12458 "Insert a new level in ASCII export."
11433 (let (char) 12459 (let (char (n (- level umax 1)) (ind 0))
11434 (if (> level umax) 12460 (if (> level umax)
11435 (insert (make-string (* 2 (- level umax 1)) ?\ ) "* " title "\n") 12461 (progn
12462 (insert (make-string (* 2 n) ?\ )
12463 (char-to-string (nth (% n (length org-export-ascii-bullets))
12464 org-export-ascii-bullets))
12465 " " title "\n")
12466 ;; find the indentation of the next non-empty line
12467 (catch 'stop
12468 (while lines
12469 (if (string-match "^\\*" (car lines)) (throw 'stop nil))
12470 (if (string-match "^\\([ \t]*\\)\\S-" (car lines))
12471 (throw 'stop (setq ind (org-get-indentation (car lines)))))
12472 (pop lines)))
12473 (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind)))
11436 (if (or (not (equal (char-before) ?\n)) 12474 (if (or (not (equal (char-before) ?\n))
11437 (not (equal (char-before (1- (point))) ?\n))) 12475 (not (equal (char-before (1- (point))) ?\n)))
11438 (insert "\n")) 12476 (insert "\n"))
11439 (setq char (nth (- umax level) (reverse org-ascii-underline))) 12477 (setq char (nth (- umax level) (reverse org-export-ascii-underline)))
11440 (if org-export-with-section-numbers 12478 (if org-export-with-section-numbers
11441 (setq title (concat (org-section-number level) " " title))) 12479 (setq title (concat (org-section-number level) " " title)))
11442 (insert title "\n" (make-string (string-width title) char) "\n")))) 12480 (insert title "\n" (make-string (string-width title) char) "\n")
11443 12481 (setq org-ascii-current-indentation '(0 . 0)))))
11444(defun org-export-copy-visible () 12482
11445 "Copy the visible part of the buffer to another buffer, for printing. 12483(defun org-export-visible (type arg)
11446Also removes the first line of the buffer if it specifies a mode, 12484 "Create a copy of the visible part of the current buffer, and export it.
11447and all options lines." 12485The copy is created in a temporary buffer and removed after use.
11448 (interactive) 12486TYPE is the final key (as a string) of the `C-c C-x' key sequence that will
11449 (let* ((filename (concat (file-name-sans-extension buffer-file-name) 12487run the export command - in interactive use, the command prompts for this
11450 ".txt")) 12488key. As a special case, if the you type SPC at the prompt, the temporary
11451 (buffer (find-file-noselect filename)) 12489org-mode file will not be removed but presented to you so that you can
11452 (ore (concat 12490continue to use it. The prefix arg ARG is passed through to the exporting
11453 (org-make-options-regexp 12491command."
11454 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" 12492 (interactive
11455 "STARTUP" "ARCHIVE" 12493 (list (progn
11456 "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) 12494 (message "Export visible: [a]SCII [h]tml [b]rowse HTML [x]OXO [ ]keep buffer")
11457 (if org-noutline-p "\\(\n\\|$\\)" ""))) 12495 (char-to-string (read-char-exclusive)))
12496 current-prefix-arg))
12497 (if (not (member type '("a" "\C-a" "b" "\C-b" "h" "x" " ")))
12498 (error "Invalid export key"))
12499 (let* ((binding (key-binding (concat "\C-c\C-x" type)))
12500 (keepp (equal type " "))
12501 (file buffer-file-name)
12502 (buffer (get-buffer-create "*Org Export Visible*"))
11458 s e) 12503 s e)
11459 (with-current-buffer buffer 12504 (with-current-buffer buffer (erase-buffer))
11460 (erase-buffer)
11461 (text-mode))
11462 (save-excursion 12505 (save-excursion
11463 (setq s (goto-char (point-min))) 12506 (setq s (goto-char (point-min)))
11464 (while (not (= (point) (point-max))) 12507 (while (not (= (point) (point-max)))
11465 (goto-char (org-find-invisible)) 12508 (goto-char (org-find-invisible))
11466 (append-to-buffer buffer s (point)) 12509 (append-to-buffer buffer s (point))
11467 (setq s (goto-char (org-find-visible))))) 12510 (setq s (goto-char (org-find-visible))))
11468 (switch-to-buffer-other-window buffer) 12511 (goto-char (point-min))
11469 (newline) 12512 (unless keepp
11470 (goto-char (point-min)) 12513 ;; Copy all comment lines to the end, to make sure #+ settings are
11471 (if (looking-at ".*-\\*- mode:.*\n") 12514 ;; still available for the second export step. Kind of a hack, but
11472 (replace-match "")) 12515 ;; does do the trick.
11473 (while (re-search-forward ore nil t) 12516 (if (looking-at "#[^\r\n]*")
11474 (replace-match "")) 12517 (append-to-buffer buffer (match-beginning 0) (1+ (match-end 0))))
11475 (goto-char (point-min)))) 12518 (while (re-search-forward "[\n\r]#[^\n\r]*" nil t)
12519 (append-to-buffer buffer (1+ (match-beginning 0))
12520 (min (point-max) (1+ (match-end 0))))))
12521 (set-buffer buffer)
12522 (let ((buffer-file-name file)
12523 (org-inhibit-startup t))
12524 (org-mode)
12525 (show-all)
12526 (unless keepp (funcall binding arg))))
12527 (if (not keepp)
12528 (kill-buffer buffer)
12529 (switch-to-buffer-other-window buffer)
12530 (goto-char (point-min)))))
11476 12531
11477(defun org-find-visible () 12532(defun org-find-visible ()
11478 (if (featurep 'noutline) 12533 (if (featurep 'noutline)
@@ -11491,6 +12546,7 @@ and all options lines."
11491 (skip-chars-forward "^\r") 12546 (skip-chars-forward "^\r")
11492 (point))) 12547 (point)))
11493 12548
12549
11494;; HTML 12550;; HTML
11495 12551
11496(defun org-get-current-options () 12552(defun org-get-current-options ()
@@ -11506,7 +12562,8 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
11506#+CATEGORY: %s 12562#+CATEGORY: %s
11507#+SEQ_TODO: %s 12563#+SEQ_TODO: %s
11508#+TYP_TODO: %s 12564#+TYP_TODO: %s
11509#+STARTUP: %s %s %s %s %s 12565#+STARTUP: %s %s %s %s %s %s
12566#+TAGS: %s
11510#+ARCHIVE: %s 12567#+ARCHIVE: %s
11511" 12568"
11512 (buffer-name) (user-full-name) user-mail-address org-export-default-language 12569 (buffer-name) (user-full-name) user-mail-address org-export-default-language
@@ -11533,6 +12590,8 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
11533 (if org-odd-levels-only "odd" "oddeven") 12590 (if org-odd-levels-only "odd" "oddeven")
11534 (if org-hide-leading-stars "hidestars" "showstars") 12591 (if org-hide-leading-stars "hidestars" "showstars")
11535 (if org-startup-align-all-tables "align" "noalign") 12592 (if org-startup-align-all-tables "align" "noalign")
12593 (if org-log-done "logging" "nologging")
12594 (if org-tag-alist (mapconcat 'car org-tag-alist " ") "")
11536 org-archive-location 12595 org-archive-location
11537 )) 12596 ))
11538 12597
@@ -11606,16 +12665,23 @@ emacs --batch
11606 --visit=MyFile --funcall org-export-as-html-batch" 12665 --visit=MyFile --funcall org-export-as-html-batch"
11607 (org-export-as-html org-export-headline-levels 'hidden)) 12666 (org-export-as-html org-export-headline-levels 'hidden))
11608 12667
11609(defun org-export-as-html (arg &optional hidden) 12668(defun org-export-as-html (arg &optional hidden ext-plist)
11610 "Export the outline as a pretty HTML file. 12669 "Export the outline as a pretty HTML file.
11611If there is an active region, export only the region. 12670If there is an active region, export only the region.
11612The prefix ARG specifies how many levels of the outline should become 12671The prefix ARG specifies how many levels of the outline should become
11613headlines. The default is 3. Lower levels will become bulleted lists." 12672headlines. The default is 3. Lower levels will become bulleted lists.
12673When HIDDEN is non-nil, don't display the HTML buffer.
12674EXT-PLIST is a property list with external parameters overriding
12675org-mode's default settings, but still inferior to file-local settings."
11614 (interactive "P") 12676 (interactive "P")
11615 (setq-default org-todo-line-regexp org-todo-line-regexp) 12677 (setq-default org-todo-line-regexp org-todo-line-regexp)
11616 (setq-default org-deadline-line-regexp org-deadline-line-regexp) 12678 (setq-default org-deadline-line-regexp org-deadline-line-regexp)
11617 (setq-default org-done-string org-done-string) 12679 (setq-default org-done-string org-done-string)
11618 (let* ((style org-export-html-style) 12680 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
12681 ext-plist
12682 (org-infile-export-plist)))
12683
12684 (style (plist-get opt-plist :style))
11619 (odd org-odd-levels-only) 12685 (odd org-odd-levels-only)
11620 (region-p (org-region-active-p)) 12686 (region-p (org-region-active-p))
11621 (region 12687 (region
@@ -11629,30 +12695,34 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11629 (lines (org-export-find-first-heading-line all_lines)) 12695 (lines (org-export-find-first-heading-line all_lines))
11630 (level 0) (line "") (origline "") txt todo 12696 (level 0) (line "") (origline "") txt todo
11631 (umax nil) 12697 (umax nil)
11632 (filename (concat (file-name-sans-extension buffer-file-name) 12698 (filename (concat (file-name-as-directory
11633 ".html")) 12699 (org-export-directory :html opt-plist))
12700 (file-name-sans-extension
12701 (file-name-nondirectory buffer-file-name))
12702 ".html"))
11634 (buffer (find-file-noselect filename)) 12703 (buffer (find-file-noselect filename))
11635 (levels-open (make-vector org-level-max nil)) 12704 (levels-open (make-vector org-level-max nil))
11636 (date (format-time-string "%Y/%m/%d" (current-time))) 12705 (date (format-time-string "%Y/%m/%d" (current-time)))
11637 (time (format-time-string "%X" (org-current-time))) 12706 (time (format-time-string "%X" (org-current-time)))
11638 (author user-full-name) 12707 (author (plist-get opt-plist :author))
11639 (title (buffer-name)) 12708 (title (or (plist-get opt-plist :title)
11640 (options nil) 12709 (file-name-sans-extension
11641 (quote-re (concat "^\\*+[ \t]*" org-quote-string "\\>")) 12710 (file-name-nondirectory buffer-file-name))))
12711 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
12712 (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)"))
11642 (inquote nil) 12713 (inquote nil)
11643 (infixed nil) 12714 (infixed nil)
11644 (in-local-list nil) 12715 (in-local-list nil)
11645 (local-list-num nil) 12716 (local-list-num nil)
11646 (local-list-indent nil) 12717 (local-list-indent nil)
11647 (llt org-plain-list-ordered-item-terminator) 12718 (llt org-plain-list-ordered-item-terminator)
11648 (email user-mail-address) 12719 (email (plist-get opt-plist :email))
11649 (language org-export-default-language) 12720 (language (plist-get opt-plist :language))
11650 (text nil) 12721 (text (plist-get opt-plist :text))
11651 (lang-words nil) 12722 (lang-words nil)
11652 (target-alist nil) tg 12723 (target-alist nil) tg
11653 (head-count 0) cnt 12724 (head-count 0) cnt
11654 (start 0) 12725 (start 0)
11655 ;; FIXME: The following returns always nil under XEmacs
11656 (coding-system (and (fboundp 'coding-system-get) 12726 (coding-system (and (fboundp 'coding-system-get)
11657 (boundp 'buffer-file-coding-system) 12727 (boundp 'buffer-file-coding-system)
11658 buffer-file-coding-system)) 12728 buffer-file-coding-system))
@@ -11663,15 +12733,14 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11663 table-open type 12733 table-open type
11664 table-buffer table-orig-buffer 12734 table-buffer table-orig-buffer
11665 ind start-is-num starter 12735 ind start-is-num starter
11666 rpl path desc desc1 desc2 link 12736 rpl path desc descp desc1 desc2 link
11667 ) 12737 )
11668 (message "Exporting...") 12738 (message "Exporting...")
11669 12739
11670 (setq org-last-level 1) 12740 (setq org-last-level 1)
11671 (org-init-section-numbers) 12741 (org-init-section-numbers)
11672 12742
11673 ;; Search for the export key lines 12743 ;; Get the language-dependent settings
11674 (org-parse-key-lines)
11675 (setq lang-words (or (assoc language org-export-language-setup) 12744 (setq lang-words (or (assoc language org-export-language-setup)
11676 (assoc "en" org-export-language-setup))) 12745 (assoc "en" org-export-language-setup)))
11677 12746
@@ -11683,38 +12752,46 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11683 (fundamental-mode) 12752 (fundamental-mode)
11684 (let ((case-fold-search nil) 12753 (let ((case-fold-search nil)
11685 (org-odd-levels-only odd)) 12754 (org-odd-levels-only odd))
11686 (if options (org-parse-export-options options)) 12755 ;; create local variables for all options, to make sure all called
12756 ;; functions get the correct information
12757 (mapcar (lambda (x)
12758 (set (make-local-variable (cdr x))
12759 (plist-get opt-plist (car x))))
12760 org-export-plist-vars)
11687 (setq umax (if arg (prefix-numeric-value arg) 12761 (setq umax (if arg (prefix-numeric-value arg)
11688 org-export-headline-levels)) 12762 org-export-headline-levels))
11689 12763
11690 ;; File header 12764 ;; File header
11691 (insert (format 12765 (insert (format
11692 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" 12766 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
11693 \"http://www.w3.org/TR/REC-html40/loose.dtd\"> 12767 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
11694<html lang=\"%s\"><head> 12768<html xmlns=\"http://www.w3.org/1999/xhtml\"
12769lang=\"%s\" xml:lang=\"%s\">
12770<head>
11695<title>%s</title> 12771<title>%s</title>
11696<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"> 12772<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
11697<meta name=generator content=\"Org-mode\"> 12773<meta name=\"generator\" content=\"Org-mode\"/>
11698<meta name=generated content=\"%s %s\"> 12774<meta name=\"generated\" content=\"%s %s\"/>
11699<meta name=author content=\"%s\"> 12775<meta name=\"author\" content=\"%s\"/>
11700%s 12776%s
11701</head><body> 12777</head><body>
11702" 12778"
11703 language (org-html-expand title) (or charset "iso-8859-1") 12779 language language (org-html-expand title) (or charset "iso-8859-1")
11704 date time author style)) 12780 date time author style))
11705 (if title (insert (concat "<H1 class=\"title\">" 12781
11706 (org-html-expand title) "</H1>\n"))) 12782
11707 (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) 12783 (insert (or (plist-get opt-plist :preamble) ""))
11708 (if email (insert (concat "<a href=\"mailto:" email "\">&lt;" 12784
11709 email "&gt;</a>\n"))) 12785 (when (plist-get opt-plist :auto-preamble)
11710 (if (or author email) (insert "<br>\n")) 12786 (if title (insert (concat "<h1 class=\"title\">"
11711 (if (and date time) (insert (concat (nth 2 lang-words) ": " 12787 (org-html-expand title) "</h1>\n")))
11712 date " " time "<br>\n"))) 12788
11713 (if text (insert (concat "<p>\n" (org-html-expand text)))) 12789 (if text (insert "<p>\n" (org-html-expand text) "</p>")))
12790
11714 (if org-export-with-toc 12791 (if org-export-with-toc
11715 (progn 12792 (progn
11716 (insert (format "<H2>%s</H2>\n" (nth 3 lang-words))) 12793 (insert (format "<h2>%s</h2>\n" (nth 3 lang-words)))
11717 (insert "<ul>\n") 12794 (insert "<ul>\n<li>")
11718 (setq lines 12795 (setq lines
11719 (mapcar '(lambda (line) 12796 (mapcar '(lambda (line)
11720 (if (string-match org-todo-line-regexp line) 12797 (if (string-match org-todo-line-regexp line)
@@ -11724,9 +12801,11 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11724 level (org-tr-level level) 12801 level (org-tr-level level)
11725 txt (save-match-data 12802 txt (save-match-data
11726 (org-html-expand 12803 (org-html-expand
11727 (match-string 3 line))) 12804 (org-html-cleanup-toc-line
12805 (match-string 3 line))))
11728 todo 12806 todo
11729 (or (and (match-beginning 2) 12807 (or (and org-export-mark-todo-in-toc
12808 (match-beginning 2)
11730 (not (equal (match-string 2 line) 12809 (not (equal (match-string 2 line)
11731 org-done-string))) 12810 org-done-string)))
11732 ; TODO, not DONE 12811 ; TODO, not DONE
@@ -11744,13 +12823,13 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11744 (progn 12823 (progn
11745 (setq cnt (- level org-last-level)) 12824 (setq cnt (- level org-last-level))
11746 (while (>= (setq cnt (1- cnt)) 0) 12825 (while (>= (setq cnt (1- cnt)) 0)
11747 (insert "<ul>")) 12826 (insert "\n<ul>\n<li>"))
11748 (insert "\n"))) 12827 (insert "\n")))
11749 (if (< level org-last-level) 12828 (if (< level org-last-level)
11750 (progn 12829 (progn
11751 (setq cnt (- org-last-level level)) 12830 (setq cnt (- org-last-level level))
11752 (while (>= (setq cnt (1- cnt)) 0) 12831 (while (>= (setq cnt (1- cnt)) 0)
11753 (insert "</ul>")) 12832 (insert "</li>\n</ul>"))
11754 (insert "\n"))) 12833 (insert "\n")))
11755 ;; Check for targets 12834 ;; Check for targets
11756 (while (string-match org-target-regexp line) 12835 (while (string-match org-target-regexp line)
@@ -11766,8 +12845,8 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11766 (insert 12845 (insert
11767 (format 12846 (format
11768 (if todo 12847 (if todo
11769 "<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>\n" 12848 "</li>\n<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>"
11770 "<li><a href=\"#sec-%d\">%s</a>\n") 12849 "</li>\n<li><a href=\"#sec-%d\">%s</a>")
11771 head-count txt)) 12850 head-count txt))
11772 12851
11773 (setq org-last-level level)) 12852 (setq org-last-level level))
@@ -11776,7 +12855,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11776 lines)) 12855 lines))
11777 (while (> org-last-level 0) 12856 (while (> org-last-level 0)
11778 (setq org-last-level (1- org-last-level)) 12857 (setq org-last-level (1- org-last-level))
11779 (insert "</ul>\n")) 12858 (insert "</li>\n</ul>\n"))
11780 )) 12859 ))
11781 (setq head-count 0) 12860 (setq head-count 0)
11782 (org-init-section-numbers) 12861 (org-init-section-numbers)
@@ -11785,7 +12864,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11785 (catch 'nextline 12864 (catch 'nextline
11786 12865
11787 ;; end of quote section? 12866 ;; end of quote section?
11788 (when (and inquote (string-match "^\\*+" line)) 12867 (when (and inquote (string-match "^\\*+" line))
11789 (insert "</pre>\n") 12868 (insert "</pre>\n")
11790 (setq inquote nil)) 12869 (setq inquote nil))
11791 ;; inside a quote section? 12870 ;; inside a quote section?
@@ -11829,8 +12908,11 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11829 "\" class=\"target\">" (match-string 1 line) "@</a> ") 12908 "\" class=\"target\">" (match-string 1 line) "@</a> ")
11830 t t line))))) 12909 t t line)))))
11831 12910
12911 (setq line (org-html-handle-time-stamps line))
12912
11832 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;" 12913 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
11833 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>") 12914 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
12915 ;; Also handle sub_superscripts and checkboxes
11834 (setq line (org-html-expand line)) 12916 (setq line (org-html-expand line))
11835 12917
11836 ;; Format the links 12918 ;; Format the links
@@ -11841,7 +12923,9 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11841 (setq path (match-string 3 line)) 12923 (setq path (match-string 3 line))
11842 (setq desc1 (if (match-end 5) (match-string 5 line)) 12924 (setq desc1 (if (match-end 5) (match-string 5 line))
11843 desc2 (if (match-end 2) (concat type ":" path) path) 12925 desc2 (if (match-end 2) (concat type ":" path) path)
12926 descp (and desc1 (not (equal desc1 desc2)))
11844 desc (or desc1 desc2)) 12927 desc (or desc1 desc2))
12928 ;; FIXME: do we need to unescape here somewhere?
11845 (cond 12929 (cond
11846 ((equal type "internal") 12930 ((equal type "internal")
11847 (setq rpl 12931 (setq rpl
@@ -11861,7 +12945,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11861 (save-match-data 12945 (save-match-data
11862 (if (string-match "::\\(.*\\)" filename) 12946 (if (string-match "::\\(.*\\)" filename)
11863 (setq search (match-string 1 filename) 12947 (setq search (match-string 1 filename)
11864 filename (replace-match "" nil nil filename))) 12948 filename (replace-match "" t nil filename)))
11865 (setq file-is-image-p 12949 (setq file-is-image-p
11866 (string-match (org-image-file-name-regexp) filename)) 12950 (string-match (org-image-file-name-regexp) filename))
11867 (setq thefile (if abs-p (expand-file-name filename) filename)) 12951 (setq thefile (if abs-p (expand-file-name filename) filename))
@@ -11877,12 +12961,18 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11877 (not (string-match "^/.*/$" search))) 12961 (not (string-match "^/.*/$" search)))
11878 (setq thefile (concat thefile "#" 12962 (setq thefile (concat thefile "#"
11879 (org-solidify-link-text 12963 (org-solidify-link-text
11880 (org-link-unescape search))))))) 12964 (org-link-unescape search)))))
11881 (setq rpl (if (and org-export-html-inline-images 12965 (when (string-match "^file:" desc)
11882 file-is-image-p) 12966 (setq desc (replace-match "" t t desc))
12967 (if (string-match "\\.org$" desc)
12968 (setq desc (replace-match "" t t desc))))))
12969 (setq rpl (if (and file-is-image-p
12970 (or (eq t org-export-html-inline-images)
12971 (and org-export-html-inline-images
12972 (not descp))))
11883 (concat "<img src=\"" thefile "\"/>") 12973 (concat "<img src=\"" thefile "\"/>")
11884 (concat "<a href=\"" thefile "\">" desc "</a>"))))) 12974 (concat "<a href=\"" thefile "\">" desc "</a>")))))
11885 ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell")) 12975 ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp"))
11886 (setq rpl (concat "<i>&lt;" type ":" 12976 (setq rpl (concat "<i>&lt;" type ":"
11887 (save-match-data (org-link-unescape path)) 12977 (save-match-data (org-link-unescape path))
11888 "&gt;</i>")))) 12978 "&gt;</i>"))))
@@ -11894,28 +12984,22 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11894 (if (equal (match-string 2 line) org-done-string) 12984 (if (equal (match-string 2 line) org-done-string)
11895 (setq line (replace-match 12985 (setq line (replace-match
11896 "<span class=\"done\">\\2</span>" 12986 "<span class=\"done\">\\2</span>"
11897 nil nil line 2)) 12987 t nil line 2))
11898 (setq line (replace-match "<span class=\"todo\">\\2</span>" 12988 (setq line (replace-match "<span class=\"todo\">\\2</span>"
11899 nil nil line 2)))) 12989 t nil line 2))))
11900 12990
11901 ;; DEADLINES
11902 (if (string-match org-deadline-line-regexp line)
11903 (progn
11904 (if (save-match-data
11905 (string-match "<a href"
11906 (substring line 0 (match-beginning 0))))
11907 nil ; Don't do the replacement - it is inside a link
11908 (setq line (replace-match "<span class=\"deadline\">\\&</span>"
11909 nil nil line 1)))))
11910 (cond 12991 (cond
11911 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) 12992 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line)
11912 ;; This is a headline 12993 ;; This is a headline
11913 (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) 12994 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
11914 txt (match-string 2 line)) 12995 txt (match-string 2 line))
12996 (if (string-match quote-re0 txt)
12997 (setq txt (replace-match "" t t txt)))
11915 (if (<= level umax) (setq head-count (+ head-count 1))) 12998 (if (<= level umax) (setq head-count (+ head-count 1)))
11916 (when in-local-list 12999 (when in-local-list
11917 ;; Close any local lists before inserting a new header line 13000 ;; Close any local lists before inserting a new header line
11918 (while local-list-num 13001 (while local-list-num
13002 (org-close-li)
11919 (insert (if (car local-list-num) "</ol>\n" "</ul>")) 13003 (insert (if (car local-list-num) "</ol>\n" "</ul>"))
11920 (pop local-list-num)) 13004 (pop local-list-num))
11921 (setq local-list-indent nil 13005 (setq local-list-indent nil
@@ -11942,19 +13026,21 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11942 (setq table-open nil 13026 (setq table-open nil
11943 table-buffer (nreverse table-buffer) 13027 table-buffer (nreverse table-buffer)
11944 table-orig-buffer (nreverse table-orig-buffer)) 13028 table-orig-buffer (nreverse table-orig-buffer))
13029 (org-close-par-maybe)
11945 (insert (org-format-table-html table-buffer table-orig-buffer)))) 13030 (insert (org-format-table-html table-buffer table-orig-buffer))))
11946 (t 13031 (t
11947 ;; Normal lines 13032 ;; Normal lines
11948 (when (and (string-match 13033 (when (string-match
11949 (cond 13034 (cond
11950 ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+[.)]\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") 13035 ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
11951 ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+\\.\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") 13036 ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
11952 ((= llt ?\)) "^\\( \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+)\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") 13037 ((= llt ?\)) "^\\( \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
11953 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) 13038 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))
11954 line)) 13039 line)
11955 (setq ind (org-get-string-indentation line) 13040 (setq ind (org-get-string-indentation line)
11956 start-is-num (match-beginning 4) 13041 start-is-num (match-beginning 4)
11957 starter (if (match-beginning 2) (match-string 2 line)) 13042 starter (if (match-beginning 2)
13043 (substring (match-string 2 line) 0 -1))
11958 line (substring line (match-beginning 5))) 13044 line (substring line (match-beginning 5)))
11959 (unless (string-match "[^ \t]" line) 13045 (unless (string-match "[^ \t]" line)
11960 ;; empty line. Pretend indentation is large. 13046 ;; empty line. Pretend indentation is large.
@@ -11963,6 +13049,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11963 (or (and (= ind (car local-list-indent)) 13049 (or (and (= ind (car local-list-indent))
11964 (not starter)) 13050 (not starter))
11965 (< ind (car local-list-indent)))) 13051 (< ind (car local-list-indent))))
13052 (org-close-li)
11966 (insert (if (car local-list-num) "</ol>\n" "</ul>")) 13053 (insert (if (car local-list-num) "</ol>\n" "</ul>"))
11967 (pop local-list-num) (pop local-list-indent) 13054 (pop local-list-num) (pop local-list-indent)
11968 (setq in-local-list local-list-indent)) 13055 (setq in-local-list local-list-indent))
@@ -11971,23 +13058,76 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11971 (or (not in-local-list) 13058 (or (not in-local-list)
11972 (> ind (car local-list-indent)))) 13059 (> ind (car local-list-indent))))
11973 ;; Start new (level of ) list 13060 ;; Start new (level of ) list
13061 (org-close-par-maybe)
11974 (insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n")) 13062 (insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n"))
11975 (push start-is-num local-list-num) 13063 (push start-is-num local-list-num)
11976 (push ind local-list-indent) 13064 (push ind local-list-indent)
11977 (setq in-local-list t)) 13065 (setq in-local-list t))
11978 (starter 13066 (starter
11979 ;; continue current list 13067 ;; continue current list
11980 (insert "<li>\n")))) 13068 (org-close-li)
13069 (insert "<li>\n")))
13070 (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line)
13071 (setq line
13072 (replace-match
13073 (if (equal (match-string 1 line) "X")
13074 "<b>[X]</b>"
13075 "<b>[<span style=\"visibility:hidden;\">X</span>]</b>")
13076 t t line))))
13077
11981 ;; Empty lines start a new paragraph. If hand-formatted lists 13078 ;; Empty lines start a new paragraph. If hand-formatted lists
11982 ;; are not fully interpreted, lines starting with "-", "+", "*" 13079 ;; are not fully interpreted, lines starting with "-", "+", "*"
11983 ;; also start a new paragraph. 13080 ;; also start a new paragraph.
11984 (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (insert "<p>")) 13081 (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
11985 (insert line (if org-export-preserve-breaks "<br>\n" "\n")))) 13082
11986 )) 13083 ;; Check if the line break needs to be conserved
13084 (cond
13085 ((string-match "\\\\\\\\[ \t]*$" line)
13086 (setq line (replace-match "<br/>" t t line)))
13087 (org-export-preserve-breaks
13088 (setq line (concat line "<br/>"))))
13089
13090 (insert line "\n")))))
13091
13092 ;; Properly close all local lists and other lists
13093 (when inquote (insert "</pre>\n"))
13094 (when in-local-list
13095 ;; Close any local lists before inserting a new header line
13096 (while local-list-num
13097 (org-close-li)
13098 (insert (if (car local-list-num) "</ol>\n" "</ul>\n"))
13099 (pop local-list-num))
13100 (setq local-list-indent nil
13101 in-local-list nil))
13102 (org-html-level-start 1 nil umax
13103 (and org-export-with-toc (<= level umax))
13104 head-count)
13105
13106 (when (plist-get opt-plist :auto-postamble)
13107 (when author
13108 (insert "<p class=\"author\"> "
13109 (nth 1 lang-words) ": " author "\n")
13110 (when email
13111 (insert "<a href=\"mailto:" email "\">&lt;"
13112 email "&gt;</a>\n"))
13113 (insert "</p>\n"))
13114 (when (and date time)
13115 (insert "<p class=\"date\"> "
13116 (nth 2 lang-words) ": "
13117 date " " time "</p>\n")))
13118
11987 (if org-export-html-with-timestamp 13119 (if org-export-html-with-timestamp
11988 (insert org-export-html-html-helper-timestamp)) 13120 (insert org-export-html-html-helper-timestamp))
13121 (insert (or (plist-get opt-plist :postamble) ""))
11989 (insert "</body>\n</html>\n") 13122 (insert "</body>\n</html>\n")
11990 (normal-mode) 13123 (normal-mode)
13124 ;; remove empty paragraphs and lists
13125 (goto-char (point-min))
13126 (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
13127 (replace-match ""))
13128 (goto-char (point-min))
13129 (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t)
13130 (replace-match ""))
11991 (save-buffer) 13131 (save-buffer)
11992 (goto-char (point-min))))) 13132 (goto-char (point-min)))))
11993 13133
@@ -12091,7 +13231,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
12091 fields html empty) 13231 fields html empty)
12092 (setq html (concat org-export-html-table-tag "\n")) 13232 (setq html (concat org-export-html-table-tag "\n"))
12093 (while (setq line (pop lines)) 13233 (while (setq line (pop lines))
12094 (setq empty "&nbsp") 13234 (setq empty "&nbsp;")
12095 (catch 'next-line 13235 (catch 'next-line
12096 (if (string-match "^[ \t]*\\+-" line) 13236 (if (string-match "^[ \t]*\\+-" line)
12097 (progn 13237 (progn
@@ -12117,7 +13257,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
12117 (if field-buffer 13257 (if field-buffer
12118 (setq field-buffer (mapcar 13258 (setq field-buffer (mapcar
12119 (lambda (x) 13259 (lambda (x)
12120 (concat x "<br>" (pop fields))) 13260 (concat x "<br/>" (pop fields)))
12121 field-buffer)) 13261 field-buffer))
12122 (setq field-buffer fields)))) 13262 (setq field-buffer fields))))
12123 (setq html (concat html "</table>\n")) 13263 (setq html (concat html "</table>\n"))
@@ -12140,6 +13280,30 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
12140 (set-buffer " org-tmp2 ") 13280 (set-buffer " org-tmp2 ")
12141 (buffer-substring (point-min) (point-max)))) 13281 (buffer-substring (point-min) (point-max))))
12142 13282
13283(defun org-html-handle-time-stamps (s)
13284 "Format time stamps in string S, or remove them."
13285 (let (r b)
13286 (while (string-match org-maybe-keyword-time-regexp s)
13287 (or b (setq b (substring s 0 (match-beginning 0))))
13288 (if (not org-export-with-timestamps)
13289 (setq r (concat r (substring s 0 (match-beginning 0)))
13290 s (substring s (match-end 0)))
13291 (setq r (concat
13292 r (substring s 0 (match-beginning 0))
13293 (if (match-end 1)
13294 (format "@<span class=\"timestamp-kwd\">%s @</span>"
13295 (match-string 1 s)))
13296 (format " @<span class=\"timestamp\">%s@</span>"
13297 (substring (match-string 3 s) 1 -1)))
13298 s (substring s (match-end 0)))))
13299 ;; Line break of line started and ended with time stamp stuff
13300 (if (not r)
13301 s
13302 (setq r (concat r s))
13303 (unless (string-match "\\S-" (concat b s))
13304 (setq r (concat r "@<br/>")))
13305 r)))
13306
12143(defun org-html-protect (s) 13307(defun org-html-protect (s)
12144 ;; convert & to &amp;, < to &lt; and > to &gt; 13308 ;; convert & to &amp;, < to &lt; and > to &gt;
12145 (let ((start 0)) 13309 (let ((start 0))
@@ -12152,6 +13316,14 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
12152 (setq s (replace-match "&gt;" t t s)))) 13316 (setq s (replace-match "&gt;" t t s))))
12153 s) 13317 s)
12154 13318
13319(defun org-html-cleanup-toc-line (s)
13320 "Remove tags and time staps from lines going into the toc."
13321 (if (string-match " +:[a-zA-Z0-9_@:]+: *$" s)
13322 (setq s (replace-match "" t t s)))
13323 (while (string-match org-maybe-keyword-time-regexp s)
13324 (setq s (replace-match "" t t s)))
13325 s)
13326
12155(defun org-html-expand (string) 13327(defun org-html-expand (string)
12156 "Prepare STRING for HTML export. Applies all active conversions. 13328 "Prepare STRING for HTML export. Applies all active conversions.
12157If there are links in the string, don't modify these." 13329If there are links in the string, don't modify these."
@@ -12170,7 +13342,7 @@ If there are links in the string, don't modify these."
12170 (setq s (org-html-protect s)) 13342 (setq s (org-html-protect s))
12171 (if org-export-html-expand 13343 (if org-export-html-expand
12172 (while (string-match "@&lt;\\([^&]*\\)&gt;" s) 13344 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
12173 (setq s (replace-match "<\\1>" nil nil s)))) 13345 (setq s (replace-match "<\\1>" t nil s))))
12174 (if org-export-with-emphasize 13346 (if org-export-with-emphasize
12175 (setq s (org-export-html-convert-emphasize s))) 13347 (setq s (org-export-html-convert-emphasize s)))
12176 (if org-export-with-sub-superscripts 13348 (if org-export-with-sub-superscripts
@@ -12239,49 +13411,30 @@ stacked delimiters is N. Escaping delimiters is not possible."
12239 (setq string (replace-match "\\1<u>\\3</u>\\4" t nil string))) 13411 (setq string (replace-match "\\1<u>\\3</u>\\4" t nil string)))
12240 string) 13412 string)
12241 13413
12242(defun org-parse-key-lines () 13414(defvar org-par-open nil)
12243 "Find the special key lines with the information for exporters." 13415(defun org-open-par ()
12244 (save-excursion 13416 "Insert <p>, but first close previous paragraph if any."
12245 (goto-char 0) 13417 (org-close-par-maybe)
12246 (let ((re (org-make-options-regexp 13418 (insert "\n<p>")
12247 '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) 13419 (setq org-par-open t))
12248 key) 13420(defun org-close-par-maybe ()
12249 (while (re-search-forward re nil t) 13421 "Close paragraph if there is one open."
12250 (setq key (match-string 1)) 13422 (when org-par-open
12251 (cond ((string-equal key "TITLE") 13423 (insert "</p>")
12252 (setq title (match-string 2))) 13424 (setq org-par-open nil)))
12253 ((string-equal key "AUTHOR") 13425(defun org-close-li ()
12254 (setq author (match-string 2))) 13426 "Close <li> if necessary."
12255 ((string-equal key "EMAIL") 13427 (org-close-par-maybe)
12256 (setq email (match-string 2))) 13428 (insert "</li>\n"))
12257 ((string-equal key "LANGUAGE") 13429; (when (save-excursion
12258 (setq language (match-string 2))) 13430; (re-search-backward "</?\\(ul\\|ol\\|li\\|[hH][0-9]\\)>" nil t))
12259 ((string-equal key "TEXT") 13431; (if (member (match-string 0) '("</ul>" "</ol>" "<li>"))
12260 (setq text (concat text "\n" (match-string 2)))) 13432; (insert "</li>"))))
12261 ((string-equal key "OPTIONS")
12262 (setq options (match-string 2))))))))
12263
12264(defun org-parse-export-options (s)
12265 "Parse the export options line."
12266 (let ((op '(("H" . org-export-headline-levels)
12267 ("num" . org-export-with-section-numbers)
12268 ("toc" . org-export-with-toc)
12269 ("\\n" . org-export-preserve-breaks)
12270 ("@" . org-export-html-expand)
12271 (":" . org-export-with-fixed-width)
12272 ("|" . org-export-with-tables)
12273 ("^" . org-export-with-sub-superscripts)
12274 ("*" . org-export-with-emphasize)
12275 ("TeX" . org-export-with-TeX-macros)))
12276 o)
12277 (while (setq o (pop op))
12278 (if (string-match (concat (regexp-quote (car o)) ":\\([^ \t\n\r;,.]*\\)")
12279 s)
12280 (set (make-local-variable (cdr o))
12281 (car (read-from-string (match-string 1 s))))))))
12282 13433
12283(defun org-html-level-start (level title umax with-toc head-count) 13434(defun org-html-level-start (level title umax with-toc head-count)
12284 "Insert a new level in HTML export." 13435 "Insert a new level in HTML export.
13436When TITLE is nil, just close all open levels."
13437 (org-close-par-maybe)
12285 (let ((l (1+ (max level umax)))) 13438 (let ((l (1+ (max level umax))))
12286 (while (<= l org-level-max) 13439 (while (<= l org-level-max)
12287 (if (aref levels-open (1- l)) 13440 (if (aref levels-open (1- l))
@@ -12289,22 +13442,42 @@ stacked delimiters is N. Escaping delimiters is not possible."
12289 (org-html-level-close l) 13442 (org-html-level-close l)
12290 (aset levels-open (1- l) nil))) 13443 (aset levels-open (1- l) nil)))
12291 (setq l (1+ l))) 13444 (setq l (1+ l)))
12292 (if (> level umax) 13445 (when title
12293 (progn 13446 ;; If title is nil, this means this function is called to close
12294 (if (aref levels-open (1- level)) 13447 ;; all levels, so the rest is done only if title is given
12295 (insert "<li>" title "<p>\n") 13448 (when (string-match "\\(:[a-zA-Z0-9_@:]+:\\)[ \t]*$" title)
12296 (aset levels-open (1- level) t) 13449 (setq title (replace-match
12297 (insert "<ul><li>" title "<p>\n"))) 13450 (if org-export-with-tags
12298 (if org-export-with-section-numbers 13451 (save-match-data
12299 (setq title (concat (org-section-number level) " " title))) 13452 (concat
12300 (setq level (+ level 1)) 13453 "&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
12301 (if with-toc 13454 (mapconcat 'identity (org-split-string
12302 (insert (format "\n<H%d><a name=\"sec-%d\">%s</a></H%d>\n" 13455 (match-string 1 title) ":")
12303 level head-count title level)) 13456 "&nbsp;")
12304 (insert (format "\n<H%d>%s</H%d>\n" level title level)))))) 13457 "</span>"))
13458 "")
13459 t t title)))
13460 (if (> level umax)
13461 (progn
13462 (if (aref levels-open (1- level))
13463 (progn
13464 (org-close-li)
13465 (insert "<li>" title "<br/>\n"))
13466 (aset levels-open (1- level) t)
13467 (org-close-par-maybe)
13468 (insert "<ul>\n<li>" title "<br/>\n")))
13469 (if org-export-with-section-numbers
13470 (setq title (concat (org-section-number level) " " title)))
13471 (setq level (+ level 1))
13472 (if with-toc
13473 (insert (format "\n<h%d><a name=\"sec-%d\">%s</a></h%d>\n"
13474 level head-count title level))
13475 (insert (format "\n<h%d>%s</h%d>\n" level title level)))
13476 (org-open-par)))))
12305 13477
12306(defun org-html-level-close (&rest args) 13478(defun org-html-level-close (&rest args)
12307 "Terminate one level in HTML export." 13479 "Terminate one level in HTML export."
13480 (org-close-li)
12308 (insert "</ul>")) 13481 (insert "</ul>"))
12309 13482
12310;; Variable holding the vector with section numbers 13483;; Variable holding the vector with section numbers
@@ -12348,9 +13521,9 @@ When LEVEL is non-nil, increase section numbers on that level."
12348 (setq idx (1+ idx))) 13521 (setq idx (1+ idx)))
12349 (save-match-data 13522 (save-match-data
12350 (if (string-match "\\`\\([@0]\\.\\)+" string) 13523 (if (string-match "\\`\\([@0]\\.\\)+" string)
12351 (setq string (replace-match "" nil nil string))) 13524 (setq string (replace-match "" t nil string)))
12352 (if (string-match "\\(\\.0\\)+\\'" string) 13525 (if (string-match "\\(\\.0\\)+\\'" string)
12353 (setq string (replace-match "" nil nil string)))) 13526 (setq string (replace-match "" t nil string))))
12354 string)) 13527 string))
12355 13528
12356 13529
@@ -12361,12 +13534,6 @@ file, but with extension `.ics'."
12361 (interactive) 13534 (interactive)
12362 (org-export-icalendar nil buffer-file-name)) 13535 (org-export-icalendar nil buffer-file-name))
12363 13536
12364(defun org-export-as-xml ()
12365 "Export current buffer as XOXO XML buffer."
12366 (interactive)
12367 (cond ((eq org-export-xml-type 'xoxo)
12368 (org-export-as-xoxo (current-buffer)))))
12369
12370(defun org-export-as-xoxo-insert-into (buffer &rest output) 13537(defun org-export-as-xoxo-insert-into (buffer &rest output)
12371 (with-current-buffer buffer 13538 (with-current-buffer buffer
12372 (apply 'insert output))) 13539 (apply 'insert output)))
@@ -12380,8 +13547,13 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
12380 ;; Output everything as XOXO 13547 ;; Output everything as XOXO
12381 (with-current-buffer (get-buffer buffer) 13548 (with-current-buffer (get-buffer buffer)
12382 (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. 13549 (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed.
12383 (let* ((filename (concat (file-name-sans-extension buffer-file-name) 13550 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
12384 ".xml")) 13551 (org-infile-export-plist)))
13552 (filename (concat (file-name-as-directory
13553 (org-export-directory :xoxo opt-plist))
13554 (file-name-sans-extension
13555 (file-name-nondirectory buffer-file-name))
13556 ".html"))
12385 (out (find-file-noselect filename)) 13557 (out (find-file-noselect filename))
12386 (last-level 1) 13558 (last-level 1)
12387 (hanging-li nil)) 13559 (hanging-li nil))
@@ -12464,19 +13636,29 @@ The file is stored under the name `org-combined-agenda-icalendar-file'."
12464If COMBINE is non-nil, combine all calendar entries into a single large 13636If COMBINE is non-nil, combine all calendar entries into a single large
12465file and store it under the name `org-combined-agenda-icalendar-file'." 13637file and store it under the name `org-combined-agenda-icalendar-file'."
12466 (save-excursion 13638 (save-excursion
12467 (let* (file ical-file ical-buffer category started org-agenda-new-buffers) 13639 (let* ((dir (org-export-directory
13640 :ical (list :publishing-directory
13641 org-export-publishing-directory)))
13642 file ical-file ical-buffer category started org-agenda-new-buffers)
13643
12468 (when combine 13644 (when combine
12469 (setq ical-file org-combined-agenda-icalendar-file 13645 (setq ical-file
13646 (if (file-name-absolute-p org-combined-agenda-icalendar-file)
13647 org-combined-agenda-icalendar-file
13648 (expand-file-name org-combined-agenda-icalendar-file dir))
12470 ical-buffer (org-get-agenda-file-buffer ical-file)) 13649 ical-buffer (org-get-agenda-file-buffer ical-file))
12471 (set-buffer ical-buffer) (erase-buffer)) 13650 (set-buffer ical-buffer) (erase-buffer))
12472 (while (setq file (pop files)) 13651 (while (setq file (pop files))
12473 (catch 'nextfile 13652 (catch 'nextfile
12474 (org-check-agenda-file file) 13653 (org-check-agenda-file file)
13654 (set-buffer (org-get-agenda-file-buffer file))
12475 (unless combine 13655 (unless combine
12476 (setq ical-file (concat (file-name-sans-extension file) ".ics")) 13656 (setq ical-file (concat (file-name-as-directory dir)
13657 (file-name-sans-extension
13658 (file-name-nondirectory buffer-file-name))
13659 ".ics"))
12477 (setq ical-buffer (org-get-agenda-file-buffer ical-file)) 13660 (setq ical-buffer (org-get-agenda-file-buffer ical-file))
12478 (set-buffer ical-buffer) (erase-buffer)) 13661 (with-current-buffer ical-buffer (erase-buffer)))
12479 (set-buffer (org-get-agenda-file-buffer file))
12480 (setq category (or org-category 13662 (setq category (or org-category
12481 (file-name-sans-extension 13663 (file-name-sans-extension
12482 (file-name-nondirectory buffer-file-name)))) 13664 (file-name-nondirectory buffer-file-name))))
@@ -12611,6 +13793,7 @@ a time), or the day by one (if it does not contain a time)."
12611 13793
12612;; Make `C-c C-x' a prefix key 13794;; Make `C-c C-x' a prefix key
12613(define-key org-mode-map "\C-c\C-x" (make-sparse-keymap)) 13795(define-key org-mode-map "\C-c\C-x" (make-sparse-keymap))
13796(define-key org-mode-map "\C-c\C-e" (make-sparse-keymap))
12614 13797
12615;; TAB key with modifiers 13798;; TAB key with modifiers
12616(define-key org-mode-map "\C-i" 'org-cycle) 13799(define-key org-mode-map "\C-i" 'org-cycle)
@@ -12708,8 +13891,8 @@ a time), or the day by one (if it does not contain a time)."
12708(define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) 13891(define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region)
12709(define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii) 13892(define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii)
12710(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii) 13893(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii)
12711(define-key org-mode-map "\C-c\C-xv" 'org-export-copy-visible) 13894(define-key org-mode-map "\C-c\C-xv" 'org-export-visible)
12712(define-key org-mode-map "\C-c\C-x\C-v" 'org-export-copy-visible) 13895(define-key org-mode-map "\C-c\C-x\C-v" 'org-export-visible)
12713;; OPML support is only an option for the future 13896;; OPML support is only an option for the future
12714;(define-key org-mode-map "\C-c\C-xo" 'org-export-as-opml) 13897;(define-key org-mode-map "\C-c\C-xo" 'org-export-as-opml)
12715;(define-key org-mode-map "\C-c\C-x\C-o" 'org-export-as-opml) 13898;(define-key org-mode-map "\C-c\C-x\C-o" 'org-export-as-opml)
@@ -12720,8 +13903,8 @@ a time), or the day by one (if it does not contain a time)."
12720(define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template) 13903(define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template)
12721(define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section) 13904(define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
12722(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) 13905(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html)
12723(define-key org-mode-map "\C-c\C-xx" 'org-export-as-xml) 13906(define-key org-mode-map "\C-c\C-xx" 'org-export-as-xoxo)
12724(define-key org-mode-map "\C-c\C-x\C-x" 'org-export-as-xml) 13907(define-key org-mode-map "\C-c\C-x\C-x" 'org-export-as-xoxo)
12725(define-key org-mode-map "\C-c\C-xb" 'org-export-as-html-and-open) 13908(define-key org-mode-map "\C-c\C-xb" 'org-export-as-html-and-open)
12726(define-key org-mode-map "\C-c\C-x\C-b" 'org-export-as-html-and-open) 13909(define-key org-mode-map "\C-c\C-x\C-b" 'org-export-as-html-and-open)
12727 13910
@@ -12730,6 +13913,18 @@ a time), or the day by one (if it does not contain a time)."
12730(define-key org-mode-map "\C-c\C-x\M-w" 'org-copy-special) 13913(define-key org-mode-map "\C-c\C-x\M-w" 'org-copy-special)
12731(define-key org-mode-map "\C-c\C-x\C-y" 'org-paste-special) 13914(define-key org-mode-map "\C-c\C-x\C-y" 'org-paste-special)
12732 13915
13916(define-key org-mode-map "\C-c\C-ef" 'org-publish-current-file)
13917(define-key org-mode-map "\C-c\C-ep" 'org-publish-current-project)
13918(define-key org-mode-map "\C-c\C-ec" 'org-publish)
13919(define-key org-mode-map "\C-c\C-ea" 'org-publish-all)
13920(define-key org-mode-map "\C-c\C-e\C-f" 'org-publish-current-file)
13921(define-key org-mode-map "\C-c\C-e\C-p" 'org-publish-current-project)
13922(define-key org-mode-map "\C-c\C-e\C-c" 'org-publish)
13923(define-key org-mode-map "\C-c\C-e\C-a" 'org-publish-all)
13924
13925(when (featurep 'xemacs)
13926 (define-key org-mode-map 'button3 'popup-mode-menu))
13927
12733(defsubst org-table-p () (org-at-table-p)) 13928(defsubst org-table-p () (org-at-table-p))
12734 13929
12735(defun org-self-insert-command (N) 13930(defun org-self-insert-command (N)
@@ -12803,7 +13998,8 @@ because, in this case the deletion might narrow the column."
12803 (goto-char pos) 13998 (goto-char pos)
12804 ;; noalign: if there were two spaces at the end, this field 13999 ;; noalign: if there were two spaces at the end, this field
12805 ;; does not determine the width of the column. 14000 ;; does not determine the width of the column.
12806 (if noalign (setq org-table-may-need-update c)))) 14001 (if noalign (setq org-table-may-need-update c)))
14002 (delete-char N))
12807 (delete-char N))) 14003 (delete-char N)))
12808 14004
12809;; How to do this: Measure non-white length of current string 14005;; How to do this: Measure non-white length of current string
@@ -12834,12 +14030,13 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
12834 14030
12835(defun org-shifttab () 14031(defun org-shifttab ()
12836 "Global visibility cycling or move to previous table field. 14032 "Global visibility cycling or move to previous table field.
12837Calls `(org-cycle t)' or `org-table-previous-field', depending on context. 14033Calls `org-cycle' with argument t, or `org-table-previous-field', depending
14034on context.
12838See the individual commands for more information." 14035See the individual commands for more information."
12839 (interactive) 14036 (interactive)
12840 (cond 14037 (cond
12841 ((org-at-table-p) (org-table-previous-field)) 14038 ((org-at-table-p) (call-interactively 'org-table-previous-field))
12842 (t (org-cycle '(4))))) 14039 (t (call-interactively 'org-global-cycle))))
12843 14040
12844(defun org-shiftmetaleft () 14041(defun org-shiftmetaleft ()
12845 "Promote subtree or delete table column. 14042 "Promote subtree or delete table column.
@@ -12847,8 +14044,8 @@ Calls `org-promote-subtree' or `org-table-delete-column', depending on context.
12847See the individual commands for more information." 14044See the individual commands for more information."
12848 (interactive) 14045 (interactive)
12849 (cond 14046 (cond
12850 ((org-at-table-p) (org-table-delete-column)) 14047 ((org-at-table-p) (call-interactively 'org-table-delete-column))
12851 ((org-on-heading-p) (org-promote-subtree)) 14048 ((org-on-heading-p) (call-interactively 'org-promote-subtree))
12852 ((org-at-item-p) (call-interactively 'org-outdent-item)) 14049 ((org-at-item-p) (call-interactively 'org-outdent-item))
12853 (t (org-shiftcursor-error)))) 14050 (t (org-shiftcursor-error))))
12854 14051
@@ -12858,8 +14055,8 @@ Calls `org-demote-subtree' or `org-table-insert-column', depending on context.
12858See the individual commands for more information." 14055See the individual commands for more information."
12859 (interactive) 14056 (interactive)
12860 (cond 14057 (cond
12861 ((org-at-table-p) (org-table-insert-column)) 14058 ((org-at-table-p) (call-interactively 'org-table-insert-column))
12862 ((org-on-heading-p) (org-demote-subtree)) 14059 ((org-on-heading-p) (call-interactively 'org-demote-subtree))
12863 ((org-at-item-p) (call-interactively 'org-indent-item)) 14060 ((org-at-item-p) (call-interactively 'org-indent-item))
12864 (t (org-shiftcursor-error)))) 14061 (t (org-shiftcursor-error))))
12865 14062
@@ -12870,9 +14067,9 @@ Calls `org-move-subtree-up' or `org-table-kill-row' or
12870for more information." 14067for more information."
12871 (interactive "P") 14068 (interactive "P")
12872 (cond 14069 (cond
12873 ((org-at-table-p) (org-table-kill-row)) 14070 ((org-at-table-p) (call-interactively 'org-table-kill-row))
12874 ((org-on-heading-p) (org-move-subtree-up arg)) 14071 ((org-on-heading-p) (call-interactively 'org-move-subtree-up))
12875 ((org-at-item-p) (org-move-item-up arg)) 14072 ((org-at-item-p) (call-interactively 'org-move-item-up))
12876 (t (org-shiftcursor-error)))) 14073 (t (org-shiftcursor-error))))
12877(defun org-shiftmetadown (&optional arg) 14074(defun org-shiftmetadown (&optional arg)
12878 "Move subtree down or insert table row. 14075 "Move subtree down or insert table row.
@@ -12881,9 +14078,9 @@ Calls `org-move-subtree-down' or `org-table-insert-row' or
12881commands for more information." 14078commands for more information."
12882 (interactive "P") 14079 (interactive "P")
12883 (cond 14080 (cond
12884 ((org-at-table-p) (org-table-insert-row arg)) 14081 ((org-at-table-p) (call-interactively 'org-table-insert-row))
12885 ((org-on-heading-p) (org-move-subtree-down arg)) 14082 ((org-on-heading-p) (call-interactively 'org-move-subtree-down))
12886 ((org-at-item-p) (org-move-item-down arg)) 14083 ((org-at-item-p) (call-interactively 'org-move-item-down))
12887 (t (org-shiftcursor-error)))) 14084 (t (org-shiftcursor-error))))
12888 14085
12889(defun org-metaleft (&optional arg) 14086(defun org-metaleft (&optional arg)
@@ -12893,9 +14090,10 @@ With no specific context, calls the Emacs default `backward-word'.
12893See the individual commands for more information." 14090See the individual commands for more information."
12894 (interactive "P") 14091 (interactive "P")
12895 (cond 14092 (cond
12896 ((org-at-table-p) (org-table-move-column 'left)) 14093 ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left))
12897 ((or (org-on-heading-p) (org-region-active-p)) (org-do-promote)) 14094 ((or (org-on-heading-p) (org-region-active-p))
12898 (t (backward-word (prefix-numeric-value arg))))) 14095 (call-interactively 'org-do-promote))
14096 (t (call-interactively 'backward-word))))
12899 14097
12900(defun org-metaright (&optional arg) 14098(defun org-metaright (&optional arg)
12901 "Demote subtree or move table column to right. 14099 "Demote subtree or move table column to right.
@@ -12904,9 +14102,10 @@ With no specific context, calls the Emacs default `forward-word'.
12904See the individual commands for more information." 14102See the individual commands for more information."
12905 (interactive "P") 14103 (interactive "P")
12906 (cond 14104 (cond
12907 ((org-at-table-p) (org-table-move-column nil)) 14105 ((org-at-table-p) (call-interactively 'org-table-move-column))
12908 ((or (org-on-heading-p) (org-region-active-p)) (org-do-demote)) 14106 ((or (org-on-heading-p) (org-region-active-p))
12909 (t (forward-word (prefix-numeric-value arg))))) 14107 (call-interactively 'org-do-demote))
14108 (t (call-interactively 'forward-word))))
12910 14109
12911(defun org-metaup (&optional arg) 14110(defun org-metaup (&optional arg)
12912 "Move subtree up or move table row up. 14111 "Move subtree up or move table row up.
@@ -12915,9 +14114,9 @@ Calls `org-move-subtree-up' or `org-table-move-row' or
12915for more information." 14114for more information."
12916 (interactive "P") 14115 (interactive "P")
12917 (cond 14116 (cond
12918 ((org-at-table-p) (org-table-move-row 'up)) 14117 ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
12919 ((org-on-heading-p) (org-move-subtree-up arg)) 14118 ((org-on-heading-p) (call-interactively 'org-move-subtree-up))
12920 ((org-at-item-p) (org-move-item-up arg)) 14119 ((org-at-item-p) (call-interactively 'org-move-item-up))
12921 (t (org-shiftcursor-error)))) 14120 (t (org-shiftcursor-error))))
12922 14121
12923(defun org-metadown (&optional arg) 14122(defun org-metadown (&optional arg)
@@ -12927,43 +14126,46 @@ Calls `org-move-subtree-down' or `org-table-move-row' or
12927commands for more information." 14126commands for more information."
12928 (interactive "P") 14127 (interactive "P")
12929 (cond 14128 (cond
12930 ((org-at-table-p) (org-table-move-row nil)) 14129 ((org-at-table-p) (call-interactively 'org-table-move-row))
12931 ((org-on-heading-p) (org-move-subtree-down arg)) 14130 ((org-on-heading-p) (call-interactively 'org-move-subtree-down))
12932 ((org-at-item-p) (org-move-item-down arg)) 14131 ((org-at-item-p) (call-interactively 'org-move-item-down))
12933 (t (org-shiftcursor-error)))) 14132 (t (org-shiftcursor-error))))
12934 14133
12935(defun org-shiftup (&optional arg) 14134(defun org-shiftup (&optional arg)
12936 "Increase item in timestamp or increase priority of current item. 14135 "Increase item in timestamp or increase priority of current headline.
12937Calls `org-timestamp-up' or `org-priority-up', depending on context. 14136Calls `org-timestamp-up' or `org-priority-up', depending on context.
12938See the individual commands for more information." 14137See the individual commands for more information."
12939 (interactive "P") 14138 (interactive "P")
12940 (cond 14139 (cond
12941 ((org-at-timestamp-p) (org-timestamp-up arg)) 14140 ((org-at-timestamp-p) (call-interactively 'org-timestamp-up))
12942 (t (org-priority-up)))) 14141 ((org-on-heading-p) (call-interactively 'org-priority-up))
14142 ((org-at-item-p) (call-interactively 'org-previous-item))
14143 (t (call-interactively 'org-beginning-of-item) (beginning-of-line 1))))
12943 14144
12944(defun org-shiftdown (&optional arg) 14145(defun org-shiftdown (&optional arg)
12945 "Decrease item in timestamp or decrease priority of current item. 14146 "Decrease item in timestamp or decrease priority of current headline.
12946Calls `org-timestamp-down' or `org-priority-down', depending on context. 14147Calls `org-timestamp-down' or `org-priority-down', depending on context.
12947See the individual commands for more information." 14148See the individual commands for more information."
12948 (interactive "P") 14149 (interactive "P")
12949 (cond 14150 (cond
12950 ((org-at-timestamp-p) (org-timestamp-down arg)) 14151 ((org-at-timestamp-p) (call-interactively 'org-timestamp-down))
12951 (t (org-priority-down)))) 14152 ((org-on-heading-p) (call-interactively 'org-priority-down))
14153 (t (call-interactively 'org-next-item))))
12952 14154
12953(defun org-shiftright () 14155(defun org-shiftright ()
12954 "Next TODO keyword or timestamp one day later, depending on context." 14156 "Next TODO keyword or timestamp one day later, depending on context."
12955 (interactive) 14157 (interactive)
12956 (cond 14158 (cond
12957 ((org-at-timestamp-p) (org-timestamp-up-day)) 14159 ((org-at-timestamp-p) (call-interactively 'org-timestamp-up-day))
12958 ((org-on-heading-p) (org-todo 'right)) 14160 ((org-on-heading-p) (org-call-with-arg 'org-todo 'right))
12959 (t (org-shiftcursor-error)))) 14161 (t (org-shiftcursor-error))))
12960 14162
12961(defun org-shiftleft () 14163(defun org-shiftleft ()
12962 "Previous TODO keyword or timestamp one day earlier, depending on context." 14164 "Previous TODO keyword or timestamp one day earlier, depending on context."
12963 (interactive) 14165 (interactive)
12964 (cond 14166 (cond
12965 ((org-at-timestamp-p) (org-timestamp-down-day)) 14167 ((org-at-timestamp-p) (call-interactively 'org-timestamp-down-day))
12966 ((org-on-heading-p) (org-todo 'left)) 14168 ((org-on-heading-p) (org-call-with-arg 'org-todo 'left))
12967 (t (org-shiftcursor-error)))) 14169 (t (org-shiftcursor-error))))
12968 14170
12969(defun org-copy-special () 14171(defun org-copy-special ()
@@ -13028,21 +14230,23 @@ This command does many different things, depending on context:
13028 ((and (local-variable-p 'org-finish-function (current-buffer)) 14230 ((and (local-variable-p 'org-finish-function (current-buffer))
13029 (fboundp org-finish-function)) 14231 (fboundp org-finish-function))
13030 (funcall org-finish-function)) 14232 (funcall org-finish-function))
13031 ((org-on-target-p) (org-update-radio-target-regexp)) 14233 ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp))
13032 ((org-on-heading-p) (org-set-tags arg)) 14234 ((org-on-heading-p) (call-interactively 'org-set-tags))
13033 ((org-at-table.el-p) 14235 ((org-at-table.el-p)
13034 (require 'table) 14236 (require 'table)
13035 (beginning-of-line 1) 14237 (beginning-of-line 1)
13036 (re-search-forward "|" (save-excursion (end-of-line 2) (point))) 14238 (re-search-forward "|" (save-excursion (end-of-line 2) (point)))
13037 (table-recognize-table)) 14239 (call-interactively 'table-recognize-table))
13038 ((org-at-table-p) 14240 ((org-at-table-p)
13039 (org-table-maybe-eval-formula) 14241 (org-table-maybe-eval-formula)
13040 (if arg 14242 (if arg
13041 (org-table-recalculate t) 14243 (call-interactively 'org-table-recalculate)
13042 (org-table-maybe-recalculate-line)) 14244 (org-table-maybe-recalculate-line))
13043 (org-table-align)) 14245 (call-interactively 'org-table-align))
14246 ((org-at-item-checkbox-p)
14247 (call-interactively 'org-toggle-checkbox))
13044 ((org-at-item-p) 14248 ((org-at-item-p)
13045 (org-renumber-ordered-list (prefix-numeric-value arg))) 14249 (call-interactively 'org-renumber-ordered-list))
13046 ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) 14250 ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)"))
13047 (cond 14251 (cond
13048 ((equal (match-string 1) "TBLFM") 14252 ((equal (match-string 1) "TBLFM")
@@ -13050,9 +14254,10 @@ This command does many different things, depending on context:
13050 (save-excursion 14254 (save-excursion
13051 (beginning-of-line 1) 14255 (beginning-of-line 1)
13052 (skip-chars-backward " \r\n\t") 14256 (skip-chars-backward " \r\n\t")
13053 (if (org-at-table-p) (org-table-recalculate t)))) 14257 (if (org-at-table-p)
14258 (org-call-with-arg 'org-table-recalculate t))))
13054 (t 14259 (t
13055 (org-mode-restart)))) 14260 (call-interactively 'org-mode-restart))))
13056 (t (error "C-c C-c can do nothing useful at this location."))))) 14261 (t (error "C-c C-c can do nothing useful at this location.")))))
13057 14262
13058(defun org-mode-restart () 14263(defun org-mode-restart ()
@@ -13070,7 +14275,7 @@ See the individual commands for more information."
13070 (cond 14275 (cond
13071 ((org-at-table-p) 14276 ((org-at-table-p)
13072 (org-table-justify-field-maybe) 14277 (org-table-justify-field-maybe)
13073 (org-table-next-row)) 14278 (call-interactively 'org-table-next-row))
13074 (t (newline)))) 14279 (t (newline))))
13075 14280
13076(defun org-meta-return (&optional arg) 14281(defun org-meta-return (&optional arg)
@@ -13080,8 +14285,8 @@ See the individual commands for more information."
13080 (interactive "P") 14285 (interactive "P")
13081 (cond 14286 (cond
13082 ((org-at-table-p) 14287 ((org-at-table-p)
13083 (org-table-wrap-region arg)) 14288 (call-interactively 'org-table-wrap-region))
13084 (t (org-insert-heading arg)))) 14289 (t (call-interactively 'org-insert-heading))))
13085 14290
13086;;; Menu entries 14291;;; Menu entries
13087 14292
@@ -13226,10 +14431,10 @@ See the individual commands for more information."
13226 "--" 14431 "--"
13227 ("Export" 14432 ("Export"
13228 ["ASCII" org-export-as-ascii t] 14433 ["ASCII" org-export-as-ascii t]
13229 ["Extract Visible Text" org-export-copy-visible t] 14434 ["Export visible part..." org-export-visible t]
13230 ["HTML" org-export-as-html t] 14435 ["HTML" org-export-as-html t]
13231 ["HTML and Open" org-export-as-html-and-open t] 14436 ["HTML and Open" org-export-as-html-and-open t]
13232 ["XML (XOXO)" org-export-as-xml t] 14437 ["XOXO" org-export-as-xoxo t]
13233 "--" 14438 "--"
13234 ["iCalendar this file" org-export-icalendar-this-file t] 14439 ["iCalendar this file" org-export-icalendar-this-file t]
13235 ["iCalendar all agenda files" org-export-icalendar-all-agenda-files 14440 ["iCalendar all agenda files" org-export-icalendar-all-agenda-files
@@ -13238,6 +14443,11 @@ See the individual commands for more information."
13238 "--" 14443 "--"
13239 ["Option Template" org-insert-export-options-template t] 14444 ["Option Template" org-insert-export-options-template t]
13240 ["Toggle Fixed Width" org-toggle-fixed-width-section t]) 14445 ["Toggle Fixed Width" org-toggle-fixed-width-section t])
14446 ("Publish"
14447 ["Current File" org-publish-current-file t]
14448 ["Current Project" org-publish-current-project t]
14449 ["Project..." org-publish t]
14450 ["All Projects" org-publish-all t])
13241 "--" 14451 "--"
13242 ("Documentation" 14452 ("Documentation"
13243 ["Show Version" org-version t] 14453 ["Show Version" org-version t]
@@ -13303,6 +14513,100 @@ With optional NODE, go directly to that node."
13303 14513
13304;;; Miscellaneous stuff 14514;;; Miscellaneous stuff
13305 14515
14516(defun org-context ()
14517 "Return a list of contexts of the current cursor position.
14518If several contexts apply, all are returned.
14519Each context entry is a list with a symbol naming the context, and
14520two positions indicating start and end of the context. Possible
14521contexts are:
14522
14523:headline anywhere in a headline
14524:headline-stars on the leading stars in a headline
14525:todo-keyword on a TODO keyword (including DONE) in a headline
14526:tags on the TAGS in a headline
14527:priority on the priority cookie in a headline
14528:item on the first line of a plain list item
14529:checkbox on the checkbox in a plain list item
14530:table in an org-mode table
14531:table-special on a special filed in a table
14532:table-table in a table.el table
14533:link on a hyperline
14534:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE.
14535:target on a <<target>>
14536:radio-target on a <<<radio-target>>>
14537
14538This function expects the position to be visible because it uses font-lock
14539faces as a help to recognize the following contexts: :table-special, :link,
14540and :keyword."
14541 (let* ((f (get-text-property (point) 'face))
14542 (faces (if (listp f) f (list f)))
14543 (p (point)) clist)
14544 ;; First the large context
14545 (cond
14546 ((org-on-heading-p)
14547 (push (list :headline (point-at-bol) (point-at-eol)) clist)
14548 (when (progn
14549 (beginning-of-line 1)
14550 (looking-at org-todo-line-tags-regexp))
14551 (push (org-point-in-group p 1 :headline-stars) clist)
14552 (push (org-point-in-group p 2 :todo-keyword) clist)
14553 (push (org-point-in-group p 4 :tags) clist))
14554 (goto-char p)
14555 (skip-chars-backward "^[\n\r \t") (or (eobp) (backward-char 1))
14556 (if (looking-at "\\[#[A-Z]\\]")
14557 (push (org-point-in-group p 0 :priority) clist)))
14558
14559 ((org-at-item-p)
14560 (push (list :item (point-at-bol)
14561 (save-excursion (org-end-of-item) (point)))
14562 clist)
14563 (and (org-at-item-checkbox-p)
14564 (push (org-point-in-group p 0 :checkbox) clist)))
14565
14566 ((org-at-table-p)
14567 (push (list :table (org-table-begin) (org-table-end)) clist)
14568 (if (memq 'org-formula faces)
14569 (push (list :table-special
14570 (previous-single-property-change p 'face)
14571 (next-single-property-change p 'face)) clist)))
14572 ((org-at-table-p 'any)
14573 (push (list :table-table) clist)))
14574 (goto-char p)
14575
14576 ;; Now the small context
14577 (cond
14578 ((org-at-timestamp-p)
14579 (push (org-point-in-group p 0 :timestamp) clist))
14580 ((memq 'org-link faces)
14581 (push (list :link
14582 (previous-single-property-change p 'face)
14583 (next-single-property-change p 'face)) clist))
14584 ((memq 'org-special-keyword faces)
14585 (push (list :keyword
14586 (previous-single-property-change p 'face)
14587 (next-single-property-change p 'face)) clist))
14588 ((org-on-target-p)
14589 (push (org-point-in-group p 0 :target) clist)
14590 (goto-char (1- (match-beginning 0)))
14591 (if (looking-at org-radio-target-regexp)
14592 (push (org-point-in-group p 0 :radio-target) clist))
14593 (goto-char p)))
14594
14595 (setq clist (nreverse (delq nil clist)))
14596 clist))
14597
14598(defun org-point-in-group (point group &optional context)
14599 "Check if POINT is in match-group GROUP.
14600If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the
14601match. If the match group does ot exist or point is not inside it,
14602return nil."
14603 (and (match-beginning group)
14604 (>= point (match-beginning group))
14605 (<= point (match-end group))
14606 (if context
14607 (list context (match-beginning group) (match-end group))
14608 t)))
14609
13306(defun org-move-line-down (arg) 14610(defun org-move-line-down (arg)
13307 "Move the current line down. With prefix argument, move it past ARG lines." 14611 "Move the current line down. With prefix argument, move it past ARG lines."
13308 (interactive "p") 14612 (interactive "p")
@@ -13331,8 +14635,6 @@ With optional NODE, go directly to that node."
13331 14635
13332;; Paragraph filling stuff. 14636;; Paragraph filling stuff.
13333;; We want this to be just right, so use the full arsenal. 14637;; We want this to be just right, so use the full arsenal.
13334;; FIXME: This very likely does not work correctly for XEmacs, because the
13335;; filladapt package works slightly differently.
13336 14638
13337(defun org-set-autofill-regexps () 14639(defun org-set-autofill-regexps ()
13338 (interactive) 14640 (interactive)
@@ -13451,7 +14753,7 @@ that can be added."
13451;; The following functions capture almost the entire compatibility code 14753;; The following functions capture almost the entire compatibility code
13452;; between the different versions of outline-mode. The only other 14754;; between the different versions of outline-mode. The only other
13453;; places where this is important are the font-lock-keywords, and in 14755;; places where this is important are the font-lock-keywords, and in
13454;; `org-export-copy-visible'. Search for `org-noutline-p' to find them. 14756;; `org-export-visible'. Search for `org-noutline-p' to find them.
13455 14757
13456;; C-a should go to the beginning of a *visible* line, also in the 14758;; C-a should go to the beginning of a *visible* line, also in the
13457;; new outline.el. I guess this should be patched into Emacs? 14759;; new outline.el. I guess this should be patched into Emacs?
@@ -13471,8 +14773,6 @@ to a visible line beginning. This makes the function of C-a more intuitive."
13471 14773
13472(when org-noutline-p 14774(when org-noutline-p
13473 (define-key org-mode-map "\C-a" 'org-beginning-of-line)) 14775 (define-key org-mode-map "\C-a" 'org-beginning-of-line))
13474;; FIXME: should I use substitute-key-definition to reach other bindings
13475;; of beginning-of-line?
13476 14776
13477(defun org-invisible-p () 14777(defun org-invisible-p ()
13478 "Check if point is at a character currently not visible." 14778 "Check if point is at a character currently not visible."
@@ -13503,15 +14803,15 @@ to a visible line beginning. This makes the function of C-a more intuitive."
13503Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." 14803Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
13504 (if org-noutline-p 14804 (if org-noutline-p
13505 (outline-back-to-heading invisible-ok) 14805 (outline-back-to-heading invisible-ok)
13506 (if (and (memq (char-before) '(?\n ?\r)) 14806 (if (and (or (bobp) (memq (char-before) '(?\n ?\r)))
13507 (looking-at outline-regexp)) 14807 (looking-at outline-regexp))
13508 t 14808 t
13509 (if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^") 14809 (if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^")
13510 outline-regexp) 14810 outline-regexp)
13511 nil t) 14811 nil t)
13512 (if invisible-ok 14812 (if invisible-ok
13513 (progn (goto-char (match-end 1)) 14813 (progn (goto-char (or (match-end 1) (match-beginning 0)))
13514 (looking-at outline-regexp))) 14814 (looking-at outline-regexp)))
13515 (error "Before first heading"))))) 14815 (error "Before first heading")))))
13516 14816
13517(defun org-on-heading-p (&optional invisible-ok) 14817(defun org-on-heading-p (&optional invisible-ok)
@@ -13585,10 +14885,9 @@ When ENTRY is non-nil, show the entire entry."
13585 (if entry 14885 (if entry
13586 (progn 14886 (progn
13587 (org-show-entry) 14887 (org-show-entry)
13588 (save-excursion ;; FIXME: Is this the fix for points in the -| 14888 (save-excursion
13589 ;; middle of text? | 14889 (and (outline-next-heading)
13590 (and (outline-next-heading) ;; | 14890 (org-flag-heading nil))))
13591 (org-flag-heading nil)))) ; show the next heading _|
13592 (outline-flag-region (max 1 (1- (point))) 14891 (outline-flag-region (max 1 (1- (point)))
13593 (save-excursion (outline-end-of-heading) (point)) 14892 (save-excursion (outline-end-of-heading) (point))
13594 (if org-noutline-p 14893 (if org-noutline-p
@@ -13630,7 +14929,7 @@ Show the heading too, if it is currently invisible."
13630 (save-excursion 14929 (save-excursion
13631 (org-back-to-heading t) 14930 (org-back-to-heading t)
13632 (outline-flag-region 14931 (outline-flag-region
13633 (1- (point)) 14932 (max 1 (1- (point)))
13634 (save-excursion 14933 (save-excursion
13635 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) 14934 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move)
13636 (or (match-beginning 1) (point-max))) 14935 (or (match-beginning 1) (point-max)))
@@ -13669,6 +14968,10 @@ Show the heading too, if it is currently invisible."
13669 14968
13670(run-hooks 'org-load-hook) 14969(run-hooks 'org-load-hook)
13671 14970
14971
13672;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd 14972;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
13673;;; org.el ends here 14973;;; org.el ends here
13674 14974
14975
14976
14977
diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el
index 07b9ba1a2b1..eac1cb94105 100644
--- a/lisp/textmodes/po.el
+++ b/lisp/textmodes/po.el
@@ -41,15 +41,21 @@
41Contains canonical charset names that don't correspond to coding systems.") 41Contains canonical charset names that don't correspond to coding systems.")
42 42
43(defun po-find-charset (filename) 43(defun po-find-charset (filename)
44 "Return PO charset value for FILENAME." 44 "Return PO charset value for FILENAME.
45If FILENAME is a cons, the cdr part is a buffer that already contains
46the PO file (but not yet decoded)."
45 (let ((charset-regexp 47 (let ((charset-regexp
46 "^\"Content-Type:[ \t]*text/plain;[ \t]*charset=\\(.*\\)\\\\n\"") 48 "^\"Content-Type:[ \t]*text/plain;[ \t]*charset=\\(.*\\)\\\\n\"")
49 (buf (and (consp filename) (cdr filename)))
47 (short-read nil)) 50 (short-read nil))
51 (when buf
52 (set-buffer buf)
53 (goto-char (point-min)))
48 ;; Try the first 4096 bytes. In case we cannot find the charset value 54 ;; Try the first 4096 bytes. In case we cannot find the charset value
49 ;; within the first 4096 bytes (the PO file might start with a long 55 ;; within the first 4096 bytes (the PO file might start with a long
50 ;; comment) try the next 4096 bytes repeatedly until we'll know for sure 56 ;; comment) try the next 4096 bytes repeatedly until we'll know for sure
51 ;; we've checked the empty header entry entirely. 57 ;; we've checked the empty header entry entirely.
52 (while (not (or short-read (re-search-forward "^msgid" nil t))) 58 (while (not (or short-read (re-search-forward "^msgid" nil t) buf))
53 (save-excursion 59 (save-excursion
54 (goto-char (point-max)) 60 (goto-char (point-max))
55 (let ((pair (insert-file-contents-literally filename nil 61 (let ((pair (insert-file-contents-literally filename nil
@@ -57,7 +63,7 @@ Contains canonical charset names that don't correspond to coding systems.")
57 (1- (+ (point) 4096))))) 63 (1- (+ (point) 4096)))))
58 (setq short-read (< (nth 1 pair) 4096))))) 64 (setq short-read (< (nth 1 pair) 4096)))))
59 (cond ((re-search-forward charset-regexp nil t) (match-string 1)) 65 (cond ((re-search-forward charset-regexp nil t) (match-string 1))
60 (short-read nil) 66 ((or short-read buf) nil)
61 ;; We've found the first msgid; maybe, only a part of the msgstr 67 ;; We've found the first msgid; maybe, only a part of the msgstr
62 ;; value was loaded. Load the next 1024 bytes; if charset still 68 ;; value was loaded. Load the next 1024 bytes; if charset still
63 ;; isn't available, give up. 69 ;; isn't available, give up.
@@ -71,10 +77,13 @@ Contains canonical charset names that don't correspond to coding systems.")
71 77
72(defun po-find-file-coding-system-guts (operation filename) 78(defun po-find-file-coding-system-guts (operation filename)
73 "Return a (DECODING . ENCODING) pair for OPERATION on PO file FILENAME. 79 "Return a (DECODING . ENCODING) pair for OPERATION on PO file FILENAME.
74Do so according to FILENAME's declared charset." 80Do so according to FILENAME's declared charset.
81FILENAME may be a cons (NAME . BUFFER). In that case, detect charset
82in BUFFER."
75 (and 83 (and
76 (eq operation 'insert-file-contents) 84 (eq operation 'insert-file-contents)
77 (file-exists-p filename) 85 (or (if (consp filename) (buffer-live-p (cdr filename)))
86 (file-exists-p filename))
78 (with-temp-buffer 87 (with-temp-buffer
79 (let* ((coding-system-for-read 'no-conversion) 88 (let* ((coding-system-for-read 'no-conversion)
80 (charset (or (po-find-charset filename) "ascii")) 89 (charset (or (po-find-charset filename) "ascii"))
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 416a3efb684..18f0c980929 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -49,13 +49,14 @@
49 :type 'integer 49 :type 'integer
50 :group 'sgml) 50 :group 'sgml)
51 51
52(defcustom sgml-transformation 'identity 52(defcustom sgml-transformation-function 'identity
53 "*Default value for `skeleton-transformation' (which see) in SGML mode." 53 "*Default value for `skeleton-transformation-function' in SGML mode."
54 :type 'function 54 :type 'function
55 :group 'sgml) 55 :group 'sgml)
56 56
57(put 'sgml-transformation 'variable-interactive 57(put 'sgml-transformation-function 'variable-interactive
58 "aTransformation function: ") 58 "aTransformation function: ")
59(defvaralias 'sgml-transformation 'sgml-transformation-function)
59 60
60(defcustom sgml-mode-hook nil 61(defcustom sgml-mode-hook nil
61 "Hook run by command `sgml-mode'. 62 "Hook run by command `sgml-mode'.
@@ -333,6 +334,7 @@ an optional alist of possible values."
333 :type '(repeat (cons (string :tag "Tag Name") 334 :type '(repeat (cons (string :tag "Tag Name")
334 (repeat :tag "Tag Rule" sexp))) 335 (repeat :tag "Tag Rule" sexp)))
335 :group 'sgml) 336 :group 'sgml)
337(put 'sgml-tag-alist 'risky-local-variable t)
336 338
337(defcustom sgml-tag-help 339(defcustom sgml-tag-help
338 '(("!" . "Empty declaration for comment") 340 '(("!" . "Empty declaration for comment")
@@ -389,7 +391,7 @@ a DOCTYPE or an XML declaration."
389(defun sgml-mode-facemenu-add-face-function (face end) 391(defun sgml-mode-facemenu-add-face-function (face end)
390 (if (setq face (cdr (assq face sgml-face-tag-alist))) 392 (if (setq face (cdr (assq face sgml-face-tag-alist)))
391 (progn 393 (progn
392 (setq face (funcall skeleton-transformation face)) 394 (setq face (funcall skeleton-transformation-function face))
393 (setq facemenu-end-add-face (concat "</" face ">")) 395 (setq facemenu-end-add-face (concat "</" face ">"))
394 (concat "<" face ">")) 396 (concat "<" face ">"))
395 (error "Face not configured for %s mode" mode-name))) 397 (error "Face not configured for %s mode" mode-name)))
@@ -413,8 +415,8 @@ An argument of N to a tag-inserting command means to wrap it around
413the next N words. In Transient Mark mode, when the mark is active, 415the next N words. In Transient Mark mode, when the mark is active,
414N defaults to -1, which means to wrap it around the current region. 416N defaults to -1, which means to wrap it around the current region.
415 417
416If you like upcased tags, put (setq sgml-transformation 'upcase) in 418If you like upcased tags, put (setq sgml-transformation-function 'upcase)
417your `.emacs' file. 419in your `.emacs' file.
418 420
419Use \\[sgml-validate] to validate your document with an SGML parser. 421Use \\[sgml-validate] to validate your document with an SGML parser.
420 422
@@ -458,7 +460,8 @@ Do \\[describe-key] on the following bindings to discover what they do.
458 (sgml-xml-guess) 460 (sgml-xml-guess)
459 (if sgml-xml-mode 461 (if sgml-xml-mode
460 (setq mode-name "XML") 462 (setq mode-name "XML")
461 (set (make-local-variable 'skeleton-transformation) sgml-transformation)) 463 (set (make-local-variable 'skeleton-transformation-function)
464 sgml-transformation-function))
462 ;; This will allow existing comments within declarations to be 465 ;; This will allow existing comments within declarations to be
463 ;; recognized. 466 ;; recognized.
464 (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*") 467 (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")
@@ -602,9 +605,9 @@ This only works for Latin-1 input."
602 (if sgml-name-8bit-mode "ON" "OFF"))) 605 (if sgml-name-8bit-mode "ON" "OFF")))
603 606
604;; When an element of a skeleton is a string "str", it is passed 607;; When an element of a skeleton is a string "str", it is passed
605;; through skeleton-transformation and inserted. If "str" is to be 608;; through `skeleton-transformation-function' and inserted.
606;; inserted literally, one should obtain it as the return value of a 609;; If "str" is to be inserted literally, one should obtain it as
607;; function, e.g. (identity "str"). 610;; the return value of a function, e.g. (identity "str").
608 611
609(defvar sgml-tag-last nil) 612(defvar sgml-tag-last nil)
610(defvar sgml-tag-history nil) 613(defvar sgml-tag-history nil)
@@ -612,9 +615,10 @@ This only works for Latin-1 input."
612 "Prompt for a tag and insert it, optionally with attributes. 615 "Prompt for a tag and insert it, optionally with attributes.
613Completion and configuration are done according to `sgml-tag-alist'. 616Completion and configuration are done according to `sgml-tag-alist'.
614If you like tags and attributes in uppercase do \\[set-variable] 617If you like tags and attributes in uppercase do \\[set-variable]
615skeleton-transformation RET upcase RET, or put this in your `.emacs': 618`skeleton-transformation-function' RET `upcase' RET, or put this
616 (setq sgml-transformation 'upcase)" 619in your `.emacs':
617 (funcall (or skeleton-transformation 'identity) 620 (setq sgml-transformation-function 'upcase)"
621 (funcall (or skeleton-transformation-function 'identity)
618 (setq sgml-tag-last 622 (setq sgml-tag-last
619 (completing-read 623 (completing-read
620 (if (> (length sgml-tag-last) 0) 624 (if (> (length sgml-tag-last) 0)
@@ -637,7 +641,7 @@ skeleton-transformation RET upcase RET, or put this in your `.emacs':
637 ;; For xhtml's `tr' tag, we should maybe use \n instead. 641 ;; For xhtml's `tr' tag, we should maybe use \n instead.
638 (if (eq v2 t) (setq v2 nil)) 642 (if (eq v2 t) (setq v2 nil))
639 ;; We use `identity' to prevent skeleton from passing 643 ;; We use `identity' to prevent skeleton from passing
640 ;; `str' through skeleton-transformation a second time. 644 ;; `str' through `skeleton-transformation-function' a second time.
641 '(("") v2 _ v2 "</" (identity ',str) ?>)) 645 '(("") v2 _ v2 "</" (identity ',str) ?>))
642 ((eq (car v2) t) 646 ((eq (car v2) t)
643 (cons '("") (cdr v2))) 647 (cons '("") (cdr v2)))
@@ -668,12 +672,12 @@ If QUIET, do not print a message when there are no attributes for TAG."
668 (if (stringp (car alist)) 672 (if (stringp (car alist))
669 (progn 673 (progn
670 (insert (if (eq (preceding-char) ?\s) "" ?\s) 674 (insert (if (eq (preceding-char) ?\s) "" ?\s)
671 (funcall skeleton-transformation (car alist))) 675 (funcall skeleton-transformation-function (car alist)))
672 (sgml-value alist)) 676 (sgml-value alist))
673 (setq i (length alist)) 677 (setq i (length alist))
674 (while (> i 0) 678 (while (> i 0)
675 (insert ?\s) 679 (insert ?\s)
676 (insert (funcall skeleton-transformation 680 (insert (funcall skeleton-transformation-function
677 (setq attribute 681 (setq attribute
678 (skeleton-read '(completing-read 682 (skeleton-read '(completing-read
679 "Attribute: " 683 "Attribute: "
@@ -1979,12 +1983,12 @@ Can be used as a value for `html-mode-hook'."
1979 "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: "))) 1983 "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: ")))
1980 "\" value=\"" str ?\" 1984 "\" value=\"" str ?\"
1981 (when (y-or-n-p "Set \"checked\" attribute? ") 1985 (when (y-or-n-p "Set \"checked\" attribute? ")
1982 (funcall skeleton-transformation 1986 (funcall skeleton-transformation-function
1983 (if sgml-xml-mode " checked=\"checked\"" " checked"))) 1987 (if sgml-xml-mode " checked=\"checked\"" " checked")))
1984 (if sgml-xml-mode " />" ">") 1988 (if sgml-xml-mode " />" ">")
1985 (skeleton-read "Text: " (capitalize str)) 1989 (skeleton-read "Text: " (capitalize str))
1986 (or v2 (setq v2 (if (y-or-n-p "Newline after text? ") 1990 (or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
1987 (funcall skeleton-transformation 1991 (funcall skeleton-transformation-function
1988 (if sgml-xml-mode "<br />" "<br>")) 1992 (if sgml-xml-mode "<br />" "<br>"))
1989 ""))) 1993 "")))
1990 \n)) 1994 \n))
@@ -1999,12 +2003,12 @@ Can be used as a value for `html-mode-hook'."
1999 "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: "))) 2003 "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: ")))
2000 "\" value=\"" str ?\" 2004 "\" value=\"" str ?\"
2001 (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? "))) 2005 (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
2002 (funcall skeleton-transformation 2006 (funcall skeleton-transformation-function
2003 (if sgml-xml-mode " checked=\"checked\"" " checked"))) 2007 (if sgml-xml-mode " checked=\"checked\"" " checked")))
2004 (if sgml-xml-mode " />" ">") 2008 (if sgml-xml-mode " />" ">")
2005 (skeleton-read "Text: " (capitalize str)) 2009 (skeleton-read "Text: " (capitalize str))
2006 (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ") 2010 (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
2007 (funcall skeleton-transformation 2011 (funcall skeleton-transformation-function
2008 (if sgml-xml-mode "<br />" "<br>")) 2012 (if sgml-xml-mode "<br />" "<br>"))
2009 ""))) 2013 "")))
2010 \n)) 2014 \n))
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 6c9463fe11e..dab08902769 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -6,7 +6,7 @@
6;; Keywords: wp, convenience 6;; Keywords: wp, convenience
7;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com> 7;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com>
8;; Created: Sat Jul 08 2000 13:28:45 (PST) 8;; Created: Sat Jul 08 2000 13:28:45 (PST)
9;; Revised: Sat Aug 06 2005 19:42:54 (CEST) 9;; Revised: Tue May 30 2006 10:01:43 (PDT)
10 10
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12 12
@@ -3104,10 +3104,10 @@ CALS (DocBook DTD):
3104 (cond 3104 (cond
3105 ((eq language 'html) 3105 ((eq language 'html)
3106 (insert (format "<!-- This HTML table template is generated by emacs %s -->\n" emacs-version) 3106 (insert (format "<!-- This HTML table template is generated by emacs %s -->\n" emacs-version)
3107 (format "<TABLE %s>\n" table-html-table-attribute) 3107 (format "<table %s>\n" table-html-table-attribute)
3108 (if (and (stringp caption) 3108 (if (and (stringp caption)
3109 (not (string= caption ""))) 3109 (not (string= caption "")))
3110 (format " <CAPTION>%s</CAPTION>\n" caption) 3110 (format " <caption>%s</caption>\n" caption)
3111 ""))) 3111 "")))
3112 ((eq language 'latex) 3112 ((eq language 'latex)
3113 (insert (format "%% This LaTeX table template is generated by emacs %s\n" emacs-version) 3113 (insert (format "%% This LaTeX table template is generated by emacs %s\n" emacs-version)
@@ -3131,7 +3131,7 @@ CALS (DocBook DTD):
3131 (with-current-buffer dest-buffer 3131 (with-current-buffer dest-buffer
3132 (cond 3132 (cond
3133 ((eq language 'html) 3133 ((eq language 'html)
3134 (insert "</TABLE>\n")) 3134 (insert "</table>\n"))
3135 ((eq language 'latex) 3135 ((eq language 'latex)
3136 (insert "\\end{tabular}\n")) 3136 (insert "\\end{tabular}\n"))
3137 ((eq language 'cals) 3137 ((eq language 'cals)
@@ -3152,7 +3152,7 @@ CALS (DocBook DTD):
3152 (with-current-buffer dest-buffer 3152 (with-current-buffer dest-buffer
3153 (cond 3153 (cond
3154 ((eq language 'html) 3154 ((eq language 'html)
3155 (insert " <TR>\n")) 3155 (insert " <tr>\n"))
3156 ((eq language 'cals) 3156 ((eq language 'cals)
3157 (insert " <row>\n")) 3157 (insert " <row>\n"))
3158 )) 3158 ))
@@ -3160,7 +3160,7 @@ CALS (DocBook DTD):
3160 (with-current-buffer dest-buffer 3160 (with-current-buffer dest-buffer
3161 (cond 3161 (cond
3162 ((eq language 'html) 3162 ((eq language 'html)
3163 (insert " </TR>\n")) 3163 (insert " </tr>\n"))
3164 ((eq language 'cals) 3164 ((eq language 'cals)
3165 (insert " </row>\n") 3165 (insert " </row>\n")
3166 (unless (/= (table-get-source-info 'current-row) table-cals-thead-rows) 3166 (unless (/= (table-get-source-info 'current-row) table-cals-thead-rows)
@@ -3207,7 +3207,7 @@ CALS (DocBook DTD):
3207 'cell-type 3207 'cell-type
3208 (if (or (<= (table-get-source-info 'current-row) table-html-th-rows) 3208 (if (or (<= (table-get-source-info 'current-row) table-html-th-rows)
3209 (<= (table-get-source-info 'current-column) table-html-th-columns)) 3209 (<= (table-get-source-info 'current-column) table-html-th-columns))
3210 "TH" "TD")))) 3210 "th" "td"))))
3211 (if (and table-html-cell-attribute (not (string= table-html-cell-attribute ""))) 3211 (if (and table-html-cell-attribute (not (string= table-html-cell-attribute "")))
3212 (insert " " table-html-cell-attribute)) 3212 (insert " " table-html-cell-attribute))
3213 (if (> colspan 1) (insert (format " colspan=\"%d\"" colspan))) 3213 (if (> colspan 1) (insert (format " colspan=\"%d\"" colspan)))
@@ -3266,7 +3266,7 @@ CALS (DocBook DTD):
3266 (goto-char (point-min)) 3266 (goto-char (point-min))
3267 (while (and (re-search-forward "$" nil t) 3267 (while (and (re-search-forward "$" nil t)
3268 (not (eobp))) 3268 (not (eobp)))
3269 (insert "<BR />") 3269 (insert "<br />")
3270 (forward-char 1))) 3270 (forward-char 1)))
3271 (unless (and table-html-delegate-spacing-to-user-agent 3271 (unless (and table-html-delegate-spacing-to-user-agent
3272 (progn 3272 (progn
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index a4b67057676..9263c48f18b 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -33,7 +33,7 @@
33(defcustom text-mode-hook nil 33(defcustom text-mode-hook nil
34 "Normal hook run when entering Text mode and many related modes." 34 "Normal hook run when entering Text mode and many related modes."
35 :type 'hook 35 :type 'hook
36 :options '(turn-on-auto-fill flyspell-mode) 36 :options '(turn-on-auto-fill turn-on-flyspell)
37 :group 'data) 37 :group 'data)
38 38
39(defvar text-mode-variant nil 39(defvar text-mode-variant nil