/[emacs]/emacs/lisp/textmodes/org.el
ViewVC logotype

Diff of /emacs/lisp/textmodes/org.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.14 by cdominik, Sat Apr 16 14:50:10 2005 UTC revision 1.15 by cdominik, Fri Apr 29 08:40:22 2005 UTC
# Line 5  Line 5 
5  ;; Author: Carsten Dominik <dominik at science dot uva dot nl>  ;; Author: Carsten Dominik <dominik at science dot uva dot nl>
6  ;; Keywords: outlines, hypermedia, calendar  ;; Keywords: outlines, hypermedia, calendar
7  ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/  ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8  ;; Version: 3.06  ;; Version: 3.08
9  ;;  ;;
10  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
11  ;;  ;;
# Line 79  Line 79 
79  ;;  ;;
80  ;; Changes:  ;; Changes:
81  ;; -------  ;; -------
82    ;; Version 3.08
83    ;;    - "|" no longer allowed as part of a link, to allow links in tables.
84    ;;    - The prefix of items in the agenda buffer can be configured.
85    ;;    - Cleanup.
86    ;;
87    ;; Version 3.07
88    ;;    - Some folding incinsistencies removed.
89    ;;    - BBDB links to company-only entries.
90    ;;    - Bug fixes and global cleanup.
91    ;;
92  ;; Version 3.06  ;; Version 3.06
93  ;;    - M-S-RET inserts a new TODO heading.  ;;    - M-S-RET inserts a new TODO heading.
94  ;;    - New startup option `content'.  ;;    - New startup option `content'.
# Line 131  Line 141 
141    
142  ;;; Code:  ;;; Code:
143    
144  (eval-when-compile (require 'cl))  (eval-when-compile (require 'cl) (require 'calendar))
145  (require 'outline)  (require 'outline)
146  (require 'time-date)  (require 'time-date)
147  (require 'easymenu)  (require 'easymenu)
148    
149  ;;; Customization variables  ;;; Customization variables
150    
151  (defvar org-version "3.06"  (defvar org-version "3.08"
152    "The version number of the file org.el.")    "The version number of the file org.el.")
153  (defun org-version ()  (defun org-version ()
154    (interactive)    (interactive)
# Line 194  This can also be configured on a per-fil Line 204  This can also be configured on a per-fil
204  the following lines anywhere in the buffer:  the following lines anywhere in the buffer:
205    
206     #+STARTUP: dlcheck     #+STARTUP: dlcheck
207     #+STARTUP: nodlcheck     #+STARTUP: nodlcheck"
 "  
208    :group 'org-startup    :group 'org-startup
209    :type 'boolean)    :type 'boolean)
210    
# Line 215  has been set." Line 224  has been set."
224    :group 'org)    :group 'org)
225    
226  (defcustom org-todo-keywords '("TODO" "DONE")  (defcustom org-todo-keywords '("TODO" "DONE")
227    "List of TODO entry keywords.\\<org-mode-map>    "List of TODO entry keywords.
228  By default, this is '(\"TODO\" \"DONE\").  The last entry in the list is  \\<org-mode-map>By default, this is '(\"TODO\" \"DONE\").  The last entry in the list is
229  considered to mean that the entry is \"done\".  All the other mean that  considered to mean that the entry is \"done\".  All the other mean that
230  action is required, and will make the entry show up in todo lists, diaries  action is required, and will make the entry show up in todo lists, diaries
231  etc.  etc.
# Line 228  Changes become only effective after rest Line 237  Changes become only effective after rest
237    :type '(repeat (string :tag "Keyword")))    :type '(repeat (string :tag "Keyword")))
238    
239  (defcustom org-todo-interpretation 'sequence  (defcustom org-todo-interpretation 'sequence
240    "Controls how TODO keywords are interpreted.\\<org-mode-map>    "Controls how TODO keywords are interpreted.
241  Possible values are `sequence' and `type'.  \\<org-mode-map>Possible values are `sequence' and `type'.
242  This variable is only relevant if `org-todo-keywords' contains more than two  This variable is only relevant if `org-todo-keywords' contains more than two
243  states.  There are two ways how these keywords can be used:  states.  There are two ways how these keywords can be used:
244    
# Line 256  RELAXED.  If you later return to this en Line 265  RELAXED.  If you later return to this en
265  RELAXED will not be changed REMIND, but directly to DONE.  RELAXED will not be changed REMIND, but directly to DONE.
266    
267  You can create a large number of types.  To initially select a  You can create a large number of types.  To initially select a
268  type, it is then best to use C-u \\[org-todo] in order to specify the  type, it is then best to use \\[universal-argument] \\[org-todo] in order to specify the
269  type with completion.  Of course, you can also type the keyword  type with completion.  Of course, you can also type the keyword
270  directly into the buffer.  M-TAB completes TODO keywords at the  directly into the buffer.  M-TAB completes TODO keywords at the
271  beginning of a headline."  beginning of a headline."
# Line 304  Changes become only effective after rest Line 313  Changes become only effective after rest
313  (defcustom org-after-todo-state-change-hook nil  (defcustom org-after-todo-state-change-hook nil
314    "Hook which is run after the state of a TODO item was changed.    "Hook which is run after the state of a TODO item was changed.
315  The new state (a string with a todo keyword, or nil) is available in the  The new state (a string with a todo keyword, or nil) is available in the
316  lisp variable `state'."  Lisp variable `state'."
317    :group 'org-keywords    :group 'org-keywords
318    :type 'hook)    :type 'hook)
319    
# Line 313  lisp variable `state'." Line 322  lisp variable `state'."
322    "Do TODO items have priorities?")    "Do TODO items have priorities?")
323  (make-variable-buffer-local 'org-todo-kwd-priority-p)  (make-variable-buffer-local 'org-todo-kwd-priority-p)
324  (defvar org-todo-kwd-max-priority nil  (defvar org-todo-kwd-max-priority nil
325    "Maximum priority of TODO items")    "Maximum priority of TODO items.")
326  (make-variable-buffer-local 'org-todo-kwd-max-priority)  (make-variable-buffer-local 'org-todo-kwd-max-priority)
327  (defvar org-ds-keyword-length 12  (defvar org-ds-keyword-length 12
328    "Maximum length of the Deadline and SCHEDULED keywords.")    "Maximum length of the Deadline and SCHEDULED keywords.")
# Line 352  lisp variable `state'." Line 361  lisp variable `state'."
361    "Matches the SCHEDULED keyword together with a time stamp.")    "Matches the SCHEDULED keyword together with a time stamp.")
362  (make-variable-buffer-local 'org-scheduled-time-regexp)  (make-variable-buffer-local 'org-scheduled-time-regexp)
363    
364    (defvar org-category nil
365      "Variable used by org files to set a category for agenda display.
366    Such files should use a file variable to set it, for example
367    
368       -*- mode: org; org-category: \"ELisp\"
369    
370    If the file does not specify a category, the file's base name
371    is used instead.")
372    
373  (defun org-set-regexps-and-options ()  (defun org-set-regexps-and-options ()
374    "Precompute regular expressions for current buffer."    "Precompute regular expressions for current buffer."
375    (when (eq major-mode 'org-mode)    (when (eq major-mode 'org-mode)
# Line 359  lisp variable `state'." Line 377  lisp variable `state'."
377                 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "STARTUP")))                 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "STARTUP")))
378            (splitre "[ \t]+")            (splitre "[ \t]+")
379            kwds int key value cat)            kwds int key value cat)
380        (save-restriction        (save-excursion
381          (save-excursion          (save-restriction
382            (widen)            (widen)
383            (goto-char (point-min))            (goto-char (point-min))
384            (while (re-search-forward re nil t)            (while (re-search-forward re nil t)
# Line 383  lisp variable `state'." Line 401  lisp variable `state'."
401                (let ((opts (org-split-string value splitre))                (let ((opts (org-split-string value splitre))
402                      (set '(("fold" org-startup-folded t)                      (set '(("fold" org-startup-folded t)
403                             ("nofold" org-startup-folded nil)                             ("nofold" org-startup-folded nil)
404                             ("content" org-startup-folded 'content)                             ("content" org-startup-folded content)
405                             ("dlcheck" org-startup-with-deadline-check t)                             ("dlcheck" org-startup-with-deadline-check t)
406                             ("nodlcheck" org-startup-with-deadline-check nil)))                             ("nodlcheck" org-startup-with-deadline-check nil)))
407                      l var val)                      l var val)
# Line 515  the entries for specific days." Line 533  the entries for specific days."
533    :type 'boolean)    :type 'boolean)
534    
535  (defcustom org-agenda-include-diary nil  (defcustom org-agenda-include-diary nil
536    "Non-nil means, when preparing the agenda, also get the    "If non-nil, include in the agenda entries from the Emacs Calendar's diary."
 entries from the emacs calendars diary."  
537    :group 'org-agenda    :group 'org-agenda
538    :type 'boolean)    :type 'boolean)
539    
# Line 566  categories by priority." Line 583  categories by priority."
583             (const priority-up)             (const priority-up)
584             (const priority-down))))             (const priority-down))))
585    
586    (defcustom org-agenda-prefix-format "  %-12:c% s"
587      "Format specification for the prefix of items in the agenda buffer.
588    This format works similar to a printf format, with the following meaning:
589    
590      %c   the category of the item, \"Diary\" for entries from the diary, or
591           as given by the CATEGORY keyword or derived from the file name.
592      %t   the time-of-day specification if one applies to the entry, in the
593           format HH:MM
594      %s   Scheduling/Deadline information, a short string
595    
596    In addition to the normal printf field modifiers like field width and
597    padding instructions, in this format you can also add an additional
598    punctuation or whitespace character just before the final format letter.
599    This character will be appended to the field value if the value is not
600    empty.  For example, the format \"%-12:c\" leads to \"Diary:    \" if
601    the category is \"Diary\".  If the category were be empty, no additional
602    colon would be interted.
603    
604    Including `%t' in the format string leads to a double time specification
605    because the headline/diary item will contain the time specification as
606    well.  However, using `%t' in the format will result in a canonical 24
607    hour time specification at a consistent position in the prefix, while the
608    time specification in the headline/diary item may be at any position and in
609    various formats.
610    Example:
611      (setq org-agenda-prefix-format \"  %-12:c% t% s\")"
612      :type 'string
613      :group 'org-agenda)
614    
615    (defcustom org-timeline-prefix-format "  % s"
616      "Like `org-agenda-prefix-format', but for the timeline of a single file."
617      :type 'string
618      :group 'org-agenda)
619    
620    (defvar org-prefix-format-compiled nil
621      "The compiled version of `org-???-prefix-format'.")
622    
623  (defcustom org-sort-agenda-notime-is-late t  (defcustom org-sort-agenda-notime-is-late t
624    "Non-nil means, items without time are considered late.    "Non-nil means, items without time are considered late.
625  This is only relevant for sorting.  When t, items which have no explicit  This is only relevant for sorting.  When t, items which have no explicit
# Line 574  do have a time.  When nil, the default t Line 628  do have a time.  When nil, the default t
628    :group 'org-agenda    :group 'org-agenda
629    :type 'boolean)    :type 'boolean)
630    
 (defvar org-category nil  
   "Variable used by org files to set a category for agenda display.  
 Such files should use a file variable to set it, for example  
   
    -*- mode: org; org-category: \"ELisp\"  
   
 If the file does not specify a category, the file's base name  
 is used instead.")  
   
631  (defgroup org-structure nil  (defgroup org-structure nil
632    "Options concerning structure editing in Org-mode."    "Options concerning structure editing in Org-mode."
633    :tag "Org Structure"    :tag "Org Structure"
# Line 647  unnecessary clutter." Line 692  unnecessary clutter."
692    
693  (defcustom org-allow-space-in-links t  (defcustom org-allow-space-in-links t
694    "Non-nil means, file names in links may contain space characters.    "Non-nil means, file names in links may contain space characters.
695  When nil, it becomes possible to put several links into a line."  When nil, it becomes possible to put several links into a line.
696    Note that in tables, a link never extends accross fields, so in a table
697    it is always possible to put several links into a line.
698    Changing this varable requires a re-launch of Emacs of become effective."
699    :group 'org-link    :group 'org-link
700    :type 'boolean)    :type 'boolean)
701    
# Line 667  The command `org-store-link' adds a link Line 715  The command `org-store-link' adds a link
715  location to an internal list. These links accumulate during a session.  location to an internal list. These links accumulate during a session.
716  The command `org-insert-link' can be used to insert links into any  The command `org-insert-link' can be used to insert links into any
717  Org-mode file (offering completion for all stored links).  When this  Org-mode file (offering completion for all stored links).  When this
718  option is nil, every link which has been inserted once using `C-c C-l'  option is nil, every link which has been inserted once using \\[org-insert-link]
719  will be removed from the list, to make completing the unused links  will be removed from the list, to make completing the unused links
720  more efficient."  more efficient."
721    :group 'org-link    :group 'org-link
# Line 682  When following a link with Emacs, it may Line 730  When following a link with Emacs, it may
730  this link in another window or frame.  This variable can be used to  this link in another window or frame.  This variable can be used to
731  set this up for the different types of links.  set this up for the different types of links.
732  For VM, use any of  For VM, use any of
733      vm-visit-folder      `vm-visit-folder'
734      vm-visit-folder-other-frame      `vm-visit-folder-other-frame'
735  For Gnus, use any of  For Gnus, use any of
736      gnus      `gnus'
737      gnus-other-frame      `gnus-other-frame'
738  For FILE, use any of  For FILE, use any of
739      find-file      `find-file'
740      find-file-other-window      `find-file-other-window'
741      find-file-other-frame      `find-file-other-frame'
742  For the calendar, use the variable `calendar-setup'.  For the calendar, use the variable `calendar-setup'.
743  For BBDB, it is currently only possible to display the matches in  For BBDB, it is currently only possible to display the matches in
744  another window."  another window."
# Line 792  extension.  The entries in this list are Line 840  extension.  The entries in this list are
840  and the corresponding command.  Possible values for the command are:  and the corresponding command.  Possible values for the command are:
841   `emacs'     The file will be visited by the current Emacs process.   `emacs'     The file will be visited by the current Emacs process.
842   `default'   Use the default application for this file type.   `default'   Use the default application for this file type.
843   string      A command to be executed by a shell. %s will be replaced   string      A command to be executed by a shell; %s will be replaced
844               by the path to the file.               by the path to the file.
845   sexp        A lisp form which will be evaluated.  The file path will   sexp        A Lisp form which will be evaluated.  The file path will
846               be available in the lisp variable `file'.               be available in the Lisp variable `file'.
847  For more examples, see the system specific constants  For more examples, see the system specific constants
848  `org-file-apps-defaults-macosx'  `org-file-apps-defaults-macosx'
849  `org-file-apps-defaults-windowsnt'  `org-file-apps-defaults-windowsnt'
# Line 1076  This option can also be set with the +OP Line 1124  This option can also be set with the +OP
1124    :type 'boolean)    :type 'boolean)
1125    
1126  (defcustom org-export-with-tables t  (defcustom org-export-with-tables t
1127    "Non-nil means, lines starting with \"|\" define a table    "If non-nil, lines starting with \"|\" define a table
1128  For example:  For example:
1129    
1130    | Name        | Address  | Birthday  |    | Name        | Address  | Birthday  |
# Line 1150  This option can also be set with the +OP Line 1198  This option can also be set with the +OP
1198    :type 'boolean)    :type 'boolean)
1199    
1200  (defcustom org-export-html-with-timestamp nil  (defcustom org-export-html-with-timestamp nil
1201    "Non-nil means,  write `org-export-html-html-helper-timestamp'    "If non-nil, write `org-export-html-html-helper-timestamp'
1202  into the exported html text.  Otherwise, the buffer will just be saved  into the exported html text.  Otherwise, the buffer will just be saved
1203  to a file."  to a file."
1204    :group 'org-export    :group 'org-export
# Line 1348  When this is non-nil, the headline after Line 1396  When this is non-nil, the headline after
1396    (defvar org-cursor-color)    (defvar org-cursor-color)
1397    (defvar org-time-was-given)    (defvar org-time-was-given)
1398    (defvar org-ts-what)    (defvar org-ts-what)
1399      (defvar mark-active)
1400    (defvar timecnt)    (defvar timecnt)
1401    (defvar levels-open)    (defvar levels-open)
1402    (defvar title)    (defvar title)
# Line 1383  When this is non-nil, the headline after Line 1432  When this is non-nil, the headline after
1432  (defvar org-struct-menu)  (defvar org-struct-menu)
1433  (defvar org-org-menu)  (defvar org-org-menu)
1434    
1435    ;; We use a before-change function to check if a table might need
1436    ;; an update.
1437    (defvar org-table-may-need-update t
1438      "Indicates of a table might need an update.
1439    This variable is set by `org-before-change-function'. `org-table-align'
1440    sets it back to nil.")
1441    
1442    (defvar org-mode-hook nil)
1443    (defvar org-inhibit-startup nil)        ; Dynamically-scoped param.
1444    
1445    
1446  ;;;###autoload  ;;;###autoload
1447  (defun org-mode (&optional arg)  (defun org-mode (&optional arg)
1448    "Outline-based notes management and organizer, alias    "Outline-based notes management and organizer, alias
# Line 1437  The following commands are available: Line 1497  The following commands are available:
1497          (goto-char (point-min))          (goto-char (point-min))
1498          (insert "    -*- mode: org -*-\n\n")))          (insert "    -*- mode: org -*-\n\n")))
1499    (run-hooks 'org-mode-hook)    (run-hooks 'org-mode-hook)
1500    (unless (boundp 'org-inhibit-startup)    (unless org-inhibit-startup
1501      (if org-startup-with-deadline-check      (if org-startup-with-deadline-check
1502          (call-interactively 'org-check-deadlines)          (call-interactively 'org-check-deadlines)
1503        (cond        (cond
1504         ((eq org-startup-folded t)         ((eq org-startup-folded t)
1505          (org-cycle))          (org-cycle '(4)))
1506         ((eq org-startup-folded 'contents)         ((eq org-startup-folded 'content)
1507          (org-cycle) (org-cycle))))))          (let ((this-command 'org-cycle) (last-command 'org-cycle))
1508              (org-cycle '(4)) (org-cycle '(4))))))))
1509    
1510  ;;; Font-Lock stuff  ;;; Font-Lock stuff
1511    
# Line 1456  The following commands are available: Line 1517  The following commands are available:
1517    
1518  (require 'font-lock)  (require 'font-lock)
1519    
1520    (defconst org-non-link-chars "\t\n\r|")
1521  (defconst org-link-regexp  (defconst org-link-regexp
1522    (if org-allow-space-in-links    (if org-allow-space-in-links
1523        "\\(https?\\|ftp\\|mailto\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^\t\n\r]+[^ \t\n\r]\\)"        (concat
1524      "\\(https?\\|ftp\\|mailto\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^ \t\n\r]+\\)"         "\\(https?\\|ftp\\|mailto|\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^" org-non-link-chars "]+[^ " org-non-link-chars "]\\)")
1525        (concat
1526         "\\(https?\\|ftp\\|mailto\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^ " org-non-link-chars "]+\\)")
1527      )      )
1528    "Regular expression for matching links.")    "Regular expression for matching links.")
1529  (defconst org-ts-lengths  (defconst org-ts-lengths
# Line 1502  The following commands are available: Line 1566  The following commands are available:
1566      (org-back-to-heading t)      (org-back-to-heading t)
1567      (- (match-end 0) (match-beginning 0))))      (- (match-end 0) (match-beginning 0))))
1568    
1569    (defvar org-font-lock-keywords nil)
1570    
1571  (defun org-set-font-lock-defaults ()  (defun org-set-font-lock-defaults ()
1572    (let ((org-font-lock-extra-keywords    (let ((org-font-lock-extra-keywords
1573           (list           (list
# Line 1550  The following commands are available: Line 1616  The following commands are available:
1616           '(org-font-lock-keywords t nil nil backward-paragraph))           '(org-font-lock-keywords t nil nil backward-paragraph))
1617      (kill-local-variable 'font-lock-keywords) nil))      (kill-local-variable 'font-lock-keywords) nil))
1618            
 (defvar org-font-lock-keywords nil)  
   
1619  (defun org-unfontify-region (beg end &optional maybe_loudly)  (defun org-unfontify-region (beg end &optional maybe_loudly)
1620    "Remove fontification and activation overlays from links."    "Remove fontification and activation overlays from links."
1621    (font-lock-default-unfontify-region beg end)    (font-lock-default-unfontify-region beg end)
1622    (let* ((modified (buffer-modified-p)) ;; FIXME: Why did I add this???    (let* ((buffer-undo-list t)
          (buffer-undo-list t)  
1623           (inhibit-read-only t) (inhibit-point-motion-hooks t)           (inhibit-read-only t) (inhibit-point-motion-hooks t)
1624           (inhibit-modification-hooks t)           (inhibit-modification-hooks t)
1625           deactivate-mark buffer-file-name buffer-file-truename)           deactivate-mark buffer-file-name buffer-file-truename)
# Line 1651  The following commands are available: Line 1714  The following commands are available:
1714      (save-excursion      (save-excursion
1715        (org-back-to-heading)        (org-back-to-heading)
1716        (outline-up-heading arg)        (outline-up-heading arg)
1717        (show-subtree)))        (org-show-subtree)))
1718    
1719     ((save-excursion (beginning-of-line 1) (looking-at outline-regexp))     ((save-excursion (beginning-of-line 1) (looking-at outline-regexp))
1720      ;; At a heading: rotate between three different views      ;; At a heading: rotate between three different views
1721      (org-back-to-heading)      (org-back-to-heading)
1722      (let ((goal-column 0) beg eoh eol eos nxh)      (let ((goal-column 0) eoh eol eos)
1723        ;; First, some boundaries        ;; First, some boundaries
1724        (save-excursion        (save-excursion
1725          (org-back-to-heading)  (setq beg (point))          (org-back-to-heading)
1726          (save-excursion          (save-excursion
1727            (beginning-of-line 2)            (beginning-of-line 2)
1728            (while (and (not (eobp))   ;; this is like `next-line'            (while (and (not (eobp))   ;; this is like `next-line'
# Line 1667  The following commands are available: Line 1730  The following commands are available:
1730              (beginning-of-line 2)) (setq eol (point)))              (beginning-of-line 2)) (setq eol (point)))
1731          (outline-end-of-heading)   (setq eoh (point))          (outline-end-of-heading)   (setq eoh (point))
1732          (outline-end-of-subtree)   (setq eos (point))          (outline-end-of-subtree)   (setq eos (point))
1733          (outline-next-heading)     (setq nxh (point)))          (outline-next-heading))
1734        ;; Find out what to do next and set `this-command'        ;; Find out what to do next and set `this-command'
1735        (cond        (cond
1736         ((= eos eoh)         ((= eos eoh)
# Line 1676  The following commands are available: Line 1739  The following commands are available:
1739          (setq org-cycle-subtree-status nil))          (setq org-cycle-subtree-status nil))
1740         ((>= eol eos)         ((>= eol eos)
1741          ;; Entire subtree is hidden in one line: open it          ;; Entire subtree is hidden in one line: open it
1742          (show-entry)          (org-show-entry)
1743          (show-children)          (show-children)
1744          (message "CHILDREN")          (message "CHILDREN")
1745          (setq org-cycle-subtree-status 'children)          (setq org-cycle-subtree-status 'children)
# Line 1684  The following commands are available: Line 1747  The following commands are available:
1747         ((and (eq last-command this-command)         ((and (eq last-command this-command)
1748               (eq org-cycle-subtree-status 'children))               (eq org-cycle-subtree-status 'children))
1749          ;; We just showed the children, now show everything.          ;; We just showed the children, now show everything.
1750          (show-subtree)          (org-show-subtree)
1751          (message "SUBTREE")          (message "SUBTREE")
1752          (setq org-cycle-subtree-status 'subtree)          (setq org-cycle-subtree-status 'subtree)
1753          (run-hook-with-args 'org-cycle-hook 'subtree))          (run-hook-with-args 'org-cycle-hook 'subtree))
# Line 1733  This function is the default value of th Line 1796  This function is the default value of th
1796    "Move cursor to the first headline and recenter the headline.    "Move cursor to the first headline and recenter the headline.
1797  Optional argument N means, put the headline into the Nth line of the window."  Optional argument N means, put the headline into the Nth line of the window."
1798    (goto-char (point-min))    (goto-char (point-min))
1799    (re-search-forward (concat "^" outline-regexp))    (when (re-search-forward (concat "^" outline-regexp) nil t)
1800    (beginning-of-line)      (beginning-of-line)
1801    (recenter (prefix-numeric-value N)))      (recenter (prefix-numeric-value N))))
1802    
1803  (defvar org-goto-window-configuration nil)  (defvar org-goto-window-configuration nil)
1804  (defvar org-goto-marker nil)  (defvar org-goto-marker nil)
# Line 1836  or nil." Line 1899  or nil."
1899          current-prefix-arg arg)          current-prefix-arg arg)
1900    (throw 'exit nil))    (throw 'exit nil))
1901    
1902  (defun org-goto-left (&optional arg)  (defun org-goto-left ()
1903    "Finish org-goto by going to the new location."    "Finish org-goto by going to the new location."
1904    (interactive "P")    (interactive)
1905    (if (org-on-heading-p)    (if (org-on-heading-p)
1906        (progn        (progn
1907          (beginning-of-line 1)          (beginning-of-line 1)
# Line 1847  or nil." Line 1910  or nil."
1910          (throw 'exit nil))          (throw 'exit nil))
1911      (error "Not on a heading")))      (error "Not on a heading")))
1912    
1913  (defun org-goto-right (&optional arg)  (defun org-goto-right ()
1914    "Finish org-goto by going to the new location."    "Finish org-goto by going to the new location."
1915    (interactive "P")    (interactive)
1916    (if (org-on-heading-p)    (if (org-on-heading-p)
1917        (progn        (progn
1918          (outline-end-of-subtree)          (outline-end-of-subtree)
# Line 1870  or nil." Line 1933  or nil."
1933  (defvar org-ignore-region nil  (defvar org-ignore-region nil
1934    "To temporarily disable the active region.")    "To temporarily disable the active region.")
1935    
1936  (defun org-insert-heading (&optional arg)  (defun org-insert-heading ()
1937    "Insert a new heading with same depth at point."    "Insert a new heading with same depth at point."
1938    (interactive "P")    (interactive)
1939    (let* ((head (save-excursion    (let* ((head (save-excursion
1940                   (condition-case nil                   (condition-case nil
1941                       (org-back-to-heading)                       (org-back-to-heading)
# Line 1903  state (TODO by default).  Also with pref Line 1966  state (TODO by default).  Also with pref
1966        (insert (car org-todo-keywords) " ")        (insert (car org-todo-keywords) " ")
1967      (insert (match-string 2) " ")))      (insert (match-string 2) " ")))
1968    
1969  (defun org-promote-subtree (&optional arg)  (defun org-promote-subtree ()
1970    "Promote the entire subtree.    "Promote the entire subtree.
1971  See also `org-promote'."  See also `org-promote'."
1972    (interactive "P")    (interactive)
1973    (org-map-tree 'org-promote))    (save-excursion
1974        (org-map-tree 'org-promote)))
1975    
1976  (defun org-demote-subtree (&optional arg)  (defun org-demote-subtree ()
1977    "Demote the entire subtree.  See `org-demote'.    "Demote the entire subtree.  See `org-demote'.
1978  See also `org-promote'."  See also `org-promote'."
1979    (interactive "P")    (interactive)
1980    (org-map-tree 'org-demote))    (save-excursion
1981        (org-map-tree 'org-demote)))
1982    
1983  (defun org-do-promote (&optional arg)  (defun org-do-promote ()
1984    "Promote the current heading higher up the tree.    "Promote the current heading higher up the tree.
1985  If the region is active in transient-mark-mode, promote all headings  If the region is active in t`ransient-mark-mode', promote all headings
1986  in the region."  in the region."
1987    (interactive "P")    (interactive)
1988    (save-excursion    (save-excursion
1989      (if (org-region-active-p)      (if (org-region-active-p)
1990          (org-map-region 'org-promote (region-beginning) (region-end))          (org-map-region 'org-promote (region-beginning) (region-end))
1991        (org-promote)))        (org-promote)))
1992    (org-fix-position-after-promote))    (org-fix-position-after-promote))
1993    
1994  (defun org-do-demote (&optional arg)  (defun org-do-demote ()
1995    "Demote the current heading lower down the tree.    "Demote the current heading lower down the tree.
1996  If the region is active in transient-mark-mode, demote all headings  If the region is active in `transient-mark-mode', demote all headings
1997  in the region."  in the region."
1998    (interactive "P")    (interactive)
1999    (save-excursion    (save-excursion
2000      (if (org-region-active-p)      (if (org-region-active-p)
2001          (org-map-region 'org-demote (region-beginning) (region-end))          (org-map-region 'org-demote (region-beginning) (region-end))
# Line 1945  in the region." Line 2010  in the region."
2010    
2011  (defun org-promote ()  (defun org-promote ()
2012    "Promote the current heading higher up the tree.    "Promote the current heading higher up the tree.
2013  If the region is active in transient-mark-mode, promote all headings  If the region is active in `transient-mark-mode', promote all headings
2014  in the region."  in the region."
2015    (org-back-to-heading t)    (org-back-to-heading t)
2016    (let* ((level (save-match-data (funcall outline-level)))    (let* ((level (save-match-data (funcall outline-level)))
# Line 1957  in the region." Line 2022  in the region."
2022    
2023  (defun org-demote ()  (defun org-demote ()
2024    "Demote the current heading lower down the tree.    "Demote the current heading lower down the tree.
2025  If the region is active in transient-mark-mode, demote all headings  If the region is active in `transient-mark-mode', demote all headings
2026  in the region."  in the region."
2027    (org-back-to-heading t)    (org-back-to-heading t)
2028    (let* ((level (save-match-data (funcall outline-level)))    (let* ((level (save-match-data (funcall outline-level)))
# Line 2066  ring.  We need it to check if the kill w Line 2131  ring.  We need it to check if the kill w
2131    "Was the last copied subtree folded?    "Was the last copied subtree folded?
2132  This is used to fold the tree back after pasting.")  This is used to fold the tree back after pasting.")
2133    
2134  (defun org-cut-subtree (&optional arg)  (defun org-cut-subtree ()
2135    "Cut the current subtree into the clipboard.    "Cut the current subtree into the clipboard.
2136  This is a short-hand for marking the subtree and then cutting it."  This is a short-hand for marking the subtree and then cutting it."
2137    (interactive "p")    (interactive)
2138    (org-copy-subtree arg 'cut))    (org-copy-subtree 'cut))
2139    
2140  (defun org-copy-subtree (&optional arg cut)  (defun org-copy-subtree (&optional cut)
2141    "Cut the current subtree into the clipboard.    "Cut the current subtree into the clipboard.
2142  This is a short-hand for marking the subtree and then copying it.  This is a short-hand for marking the subtree and then copying it.
2143  If CUT is non nil, actually cut the subtree."  If CUT is non nil, actually cut the subtree."
2144    (interactive "p")    (interactive)
2145    (let (beg end folded)    (let (beg end folded)
2146      (org-back-to-heading)      (org-back-to-heading)
2147      (setq beg (point))      (setq beg (point))
# Line 2338  prefix arg, switch to that state." Line 2403  prefix arg, switch to that state."
2403    ;; Fixup cursor location if close to the keyword    ;; Fixup cursor location if close to the keyword
2404    (if (and (outline-on-heading-p)    (if (and (outline-on-heading-p)
2405             (not (bolp))             (not (bolp))
2406             (save-excursion (goto-char (point-at-bol))             (save-excursion (beginning-of-line 1)
2407                             (looking-at org-todo-line-regexp))                             (looking-at org-todo-line-regexp))
2408             (< (point) (+ 2 (or (match-end 2) (match-end 1)))))             (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
2409        (progn        (progn
# Line 2681  This is used by `org-read-date' in a tem Line 2746  This is used by `org-read-date' in a tem
2746  A deadline is considered due if it happens within `org-deadline-warning-days'  A deadline is considered due if it happens within `org-deadline-warning-days'
2747  days from today's date.  If the deadline appears in an entry marked DONE,  days from today's date.  If the deadline appears in an entry marked DONE,
2748  it is not shown.  The prefix arg NDAYS can be used to test that many  it is not shown.  The prefix arg NDAYS can be used to test that many
2749  days.  If the prefix is a raw C-u prefix, all deadlines are shown."  days.  If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown."
2750    (interactive "P")    (interactive "P")
2751    (let* ((org-warn-days    (let* ((org-warn-days
2752            (cond            (cond
# Line 2718  days in order to avoid rounding problems Line 2783  days in order to avoid rounding problems
2783          (error "Not at a time-stamp range, and none found in current line.")))          (error "Not at a time-stamp range, and none found in current line.")))
2784    (let* ((ts1 (match-string 1))    (let* ((ts1 (match-string 1))
2785           (ts2 (match-string 2))           (ts2 (match-string 2))
2786             (havetime (or (> (length ts1) 15) (> (length ts2) 15)))
2787           (match-end (match-end 0))           (match-end (match-end 0))
2788           (time1 (org-time-string-to-time ts1))           (time1 (org-time-string-to-time ts1))
2789           (time2 (org-time-string-to-time ts2))           (time2 (org-time-string-to-time ts2))
# Line 2725  days in order to avoid rounding problems Line 2791  days in order to avoid rounding problems
2791           (t2 (time-to-seconds time2))           (t2 (time-to-seconds time2))
2792           (diff (abs (- t2 t1)))           (diff (abs (- t2 t1)))
2793           (negative (< (- t2 t1) 0))           (negative (< (- t2 t1) 0))
2794           (ys (floor (* 365 24 60 60)))           ;; (ys (floor (* 365 24 60 60)))
2795           (ds (* 24 60 60))           (ds (* 24 60 60))
2796           (hs (* 60 60))           (hs (* 60 60))
2797           (fy "%dy %dd %02d:%02d")           (fy "%dy %dd %02d:%02d")
2798             (fy1 "%dy %dd")
2799           (fd "%dd %02d:%02d")           (fd "%dd %02d:%02d")
2800             (fd1 "%dd")
2801           (fh "%02d:%02d")           (fh "%02d:%02d")
2802           y d h m align)           y d h m align)
2803      (setq y (floor (/ diff ys))  diff (mod diff ys)      ;; FIXME:  Should I re-introduce years, make year refer to same date?
2804            d (floor (/ diff ds))  diff (mod diff ds)      ;; This would be the only useful way to have years, actually.
2805            h (floor (/ diff hs))  diff (mod diff hs)      (if havetime
2806            m (floor (/ diff 60)))          (setq ; y (floor (/ diff ys))  diff (mod diff ys)
2807             y 0
2808             d (floor (/ diff ds))  diff (mod diff ds)
2809             h (floor (/ diff hs))  diff (mod diff hs)
2810             m (floor (/ diff 60)))
2811          (setq ; y (floor (/ diff ys))  diff (mod diff ys)
2812           y 0
2813           d (floor (+ (/ diff ds) 0.5))
2814           h 0 m 0))
2815      (if (not to-buffer)      (if (not to-buffer)
2816          (message (org-make-tdiff-string y d h m))          (message (org-make-tdiff-string y d h m))
2817        (when (org-at-table-p)        (when (org-at-table-p)
# Line 2746  days in order to avoid rounding problems Line 2822  days in order to avoid rounding problems
2822             "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")             "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
2823            (replace-match ""))            (replace-match ""))
2824        (if negative (insert " -"))        (if negative (insert " -"))
2825        (if (> y 0) (insert " " (format fy y d h m))        (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m))
2826          (if (> d 0) (insert " " (format fd d h m))          (if (> d 0) (insert " " (format (if havetime fd fd1) d h m))
2827            (insert " " (format fh h m))))            (insert " " (format fh h m))))
2828        (if align (org-table-align))        (if align (org-table-align))
2829        (message "Time difference inserted"))))        (message "Time difference inserted"))))
# Line 2770  days in order to avoid rounding problems Line 2846  days in order to avoid rounding problems
2846    
2847  (defun org-parse-time-string (s)  (defun org-parse-time-string (s)
2848    "Parse the standard Org-mode time string.    "Parse the standard Org-mode time string.
2849  This should be a lot faster than the normal parse-time-string."  This should be a lot faster than the normal `parse-time-string'."
2850    (if (string-match org-ts-regexp1 s)    (if (string-match org-ts-regexp1 s)
2851        (list 0        (list 0
2852              (string-to-number (or (match-string 8 s) "0"))              (string-to-number (or (match-string 8 s) "0"))
# Line 2927  If there is already a time stamp at the Line 3003  If there is already a time stamp at the
3003  ;;; Define the mode  ;;; Define the mode
3004    
3005  (defvar org-agenda-mode-map (make-sparse-keymap)  (defvar org-agenda-mode-map (make-sparse-keymap)
3006    "Keymap for org-agenda-mode.")    "Keymap for `org-agenda-mode'.")
3007    
3008  (defvar org-agenda-menu)  (defvar org-agenda-menu)
3009  (defvar org-agenda-follow-mode nil)  (defvar org-agenda-follow-mode nil)
# Line 2949  The following commands are available: Line 3025  The following commands are available:
3025    (easy-menu-add org-agenda-menu)    (easy-menu-add org-agenda-menu)
3026    (if org-startup-truncated (setq truncate-lines t))    (if org-startup-truncated (setq truncate-lines t))
3027    (add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local)    (add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local)
3028      (add-hook 'pre-command-hook 'org-unhighlight nil 'local)
3029    (setq org-agenda-follow-mode nil)    (setq org-agenda-follow-mode nil)
3030    (easy-menu-change    (easy-menu-change
3031     '("Agenda") "Agenda Files"     '("Agenda") "Agenda Files"
# Line 2968  The following commands are available: Line 3045  The following commands are available:
3045  (define-key org-agenda-mode-map "l" 'org-agenda-recenter)  (define-key org-agenda-mode-map "l" 'org-agenda-recenter)
3046  (define-key org-agenda-mode-map "t" 'org-agenda-todo)  (define-key org-agenda-mode-map "t" 'org-agenda-todo)
3047  (define-key org-agenda-mode-map "." 'org-agenda-goto-today)  (define-key org-agenda-mode-map "." 'org-agenda-goto-today)
3048  (define-key org-agenda-mode-map "w" 'org-agenda-week-view)  (define-key org-agenda-mode-map "w" 'org-agenda-toggle-week-view)
3049  (define-key org-agenda-mode-map [(shift right)] 'org-agenda-date-later)  (define-key org-agenda-mode-map [(shift right)] 'org-agenda-date-later)
3050  (define-key org-agenda-mode-map [(shift left)] 'org-agenda-date-earlier)  (define-key org-agenda-mode-map [(shift left)] 'org-agenda-date-earlier)
3051    
# Line 3043  The following commands are available: Line 3120  The following commands are available:
3120      ["Next Dates" org-agenda-later (local-variable-p 'starting-day)]      ["Next Dates" org-agenda-later (local-variable-p 'starting-day)]
3121      ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)]      ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)]
3122      "--"      "--"
3123      ["Week/Day View" org-agenda-week-view (local-variable-p 'starting-day)]      ["Week/Day View" org-agenda-toggle-week-view
3124         (local-variable-p 'starting-day)]
3125      ["Include Diary" org-agenda-toggle-diary      ["Include Diary" org-agenda-toggle-diary
3126       :style toggle :selected org-agenda-include-diary :active t]       :style toggle :selected org-agenda-include-diary :active t]
3127      "--"      "--"
# Line 3060  The following commands are available: Line 3138  The following commands are available:
3138      ))      ))
3139    
3140  (defvar org-agenda-markers nil  (defvar org-agenda-markers nil
3141    "List of all currently active markers created by org-agenda")    "List of all currently active markers created by `org-agenda'.")
3142  (defvar org-agenda-last-marker-time (time-to-seconds (current-time))  (defvar org-agenda-last-marker-time (time-to-seconds (current-time))
3143    "Creation time of the last agenda marker.")    "Creation time of the last agenda marker.")
3144    
# Line 3074  no longer in use." Line 3152  no longer in use."
3152      m))      m))
3153    
3154  (defun org-agenda-maybe-reset-markers (&optional force)  (defun org-agenda-maybe-reset-markers (&optional force)
3155    "Reset markers created by org-agenda.  But only if they are old enough."    "Reset markers created by `org-agenda'.  But only if they are old enough."
3156    (if (or force    (if (or force
3157            (> (- (time-to-seconds (current-time))            (> (- (time-to-seconds (current-time))
3158                  org-agenda-last-marker-time)                  org-agenda-last-marker-time)
# Line 3106  When a buffer is unmodified, it is just Line 3184  When a buffer is unmodified, it is just
3184        (when (and (buffer-modified-p buf)        (when (and (buffer-modified-p buf)
3185                   file                   file
3186                   (y-or-n-p (format "Save file %s? " file)))                   (y-or-n-p (format "Save file %s? " file)))
3187          (save-excursion          (with-current-buffer buf (save-buffer)))
           (set-buffer buf) (save-buffer)))  
3188        (kill-buffer buf))))        (kill-buffer buf))))
3189    
3190    (defvar org-respect-restriction nil)    ; Dynamically-scoped param.
3191    
3192  (defun org-timeline (&optional include-all)  (defun org-timeline (&optional include-all)
3193    "Show a time-sorted view of the entries in the current org file.    "Show a time-sorted view of the entries in the current org file.
3194  Only entries with a time stamp of today or later will be listed.  With  Only entries with a time stamp of today or later will be listed.  With
3195  one C-u prefix argument, past entries will also be listed.  one \\[universal-argument] prefix argument, past entries will also be listed.
3196  With two C-u prefixes, all unfinished TODO items will also be shown,  With two \\[universal-argument] prefixes, all unfinished TODO items will also be shown,
3197  under the current date.  under the current date.
3198  If the buffer contains an active region, only check the region for  If the buffer contains an active region, only check the region for
3199  dates."  dates."
3200    (interactive "P")    (interactive "P")
3201    (require 'calendar)    (require 'calendar)
3202    (org-agenda-maybe-reset-markers 'force)    (org-agenda-maybe-reset-markers 'force)
3203      (org-compile-prefix-format org-timeline-prefix-format)
3204    (let* ((dopast include-all)    (let* ((dopast include-all)
3205           (dotodo (equal include-all '(16)))           (dotodo (equal include-all '(16)))
3206           (entry (buffer-file-name))           (entry (buffer-file-name))
# Line 3135  dates." Line 3215  dates."
3215           (today (time-to-days (current-time)))           (today (time-to-days (current-time)))
3216           (org-respect-restriction t)           (org-respect-restriction t)
3217           (past t)           (past t)
3218           s e rtn d pos)           s e rtn d)
3219      (setq org-agenda-redo-command      (setq org-agenda-redo-command
3220            (list 'progn            (list 'progn
3221                  (list 'switch-to-buffer-other-window (current-buffer))                  (list 'switch-to-buffer-other-window (current-buffer))
# Line 3188  dates." Line 3268  dates."
3268    "Produce a weekly view from all files in variable `org-agenda-files'.    "Produce a weekly view from all files in variable `org-agenda-files'.
3269  The view will be for the current week, but from the overview buffer you  The view will be for the current week, but from the overview buffer you
3270  will be able to go to other weeks.  will be able to go to other weeks.
3271  With one C-u prefix argument INCLUDE-ALL, all unfinished TODO items will  With one \\[universal-argument] prefix argument INCLUDE-ALL, all unfinished TODO items will
3272  also be shown, under the current date.  also be shown, under the current date.
3273  START-DAY defaults to TODAY, or to the most recent match for the weekday  START-DAY defaults to TODAY, or to the most recent match for the weekday
3274  given in `org-agenda-start-on-weekday'.  given in `org-agenda-start-on-weekday'.
3275  NDAYS defaults to `org-agenda-ndays'."  NDAYS defaults to `org-agenda-ndays'."
3276    (interactive "P")    (interactive "P")
3277    (org-agenda-maybe-reset-markers 'force)    (org-agenda-maybe-reset-markers 'force)
3278      (org-compile-prefix-format org-agenda-prefix-format)
3279    (require 'calendar)    (require 'calendar)
3280    (let* ((org-agenda-start-on-weekday    (let* ((org-agenda-start-on-weekday
3281            (if (or (equal ndays 1)            (if (or (equal ndays 1)
# Line 3306  NDAYS defaults to `org-agenda-ndays'." Line 3387  NDAYS defaults to `org-agenda-ndays'."
3387          (throw 'nextfile t))          (throw 'nextfile t))
3388         (t (error "Abort"))))))         (t (error "Abort"))))))
3389    
3390  (defun org-agenda-quit (arg)  (defun org-agenda-quit ()
3391    "Exit agenda by removing the window or the buffer."    "Exit agenda by removing the window or the buffer."
3392    (interactive "P")    (interactive)
3393    (let ((buf (current-buffer)))    (let ((buf (current-buffer)))
3394      (if (not (one-window-p)) (delete-window))      (if (not (one-window-p)) (delete-window))
3395      (kill-buffer buf)      (kill-buffer buf)
3396      (org-agenda-maybe-reset-markers 'force)))      (org-agenda-maybe-reset-markers 'force)))
3397    
3398  (defun org-agenda-exit (arg)  (defun org-agenda-exit ()
3399    "Exit agenda by removing the window or the buffer.    "Exit agenda by removing the window or the buffer.
3400  Also kill all Org-mode buffers which have been loaded by `org-agenda'.  Also kill all Org-mode buffers which have been loaded by `org-agenda'.
3401  Org-mode buffers visited directly by the user will not be touched."  Org-mode buffers visited directly by the user will not be touched."
3402    (interactive "P")    (interactive)
3403    (org-release-buffers org-agenda-new-buffers)    (org-release-buffers org-agenda-new-buffers)
3404    (setq org-agenda-new-buffers nil)    (setq org-agenda-new-buffers nil)
3405    (org-agenda-quit arg))    (org-agenda-quit))
3406    
3407  (defun org-agenda-redo (&optional arg)  (defun org-agenda-redo ()
3408    "Rebuild Agenda"    "Rebuild Agenda."
3409    (interactive "P")    (interactive)
3410    (eval org-agenda-redo-command))    (eval org-agenda-redo-command))
3411    
3412  (defun org-agenda-goto-today (arg)  (defun org-agenda-goto-today ()
3413    "Go to today."    "Go to today."
3414    (interactive "P")    (interactive)
3415    (if (boundp 'starting-day)    (if (boundp 'starting-day)
3416        (let ((cmd (car org-agenda-redo-command))        (let ((cmd (car org-agenda-redo-command))
3417              (iall (nth 1 org-agenda-redo-command))              (iall (nth 1 org-agenda-redo-command))
# Line 3357  With prefix ARG, go back that many times Line 3438  With prefix ARG, go back that many times
3438    (org-agenda (if (boundp 'include-all-loc) include-all-loc nil)    (org-agenda (if (boundp 'include-all-loc) include-all-loc nil)
3439                (- starting-day (* arg org-agenda-ndays))))                (- starting-day (* arg org-agenda-ndays))))
3440    
3441  (defun org-agenda-day-view (arg)  (defun org-agenda-toggle-week-view ()
3442    "Switch agenda to single day view."    "Toggle weekly/daily view for aagenda."
3443    (interactive "P")    (interactive)
   (unless (boundp 'starting-day)  
     (error "Not allowed"))  
   (setq org-agenda-ndays 1)  
   (org-agenda include-all-loc starting-day 1))  
   
 (defun org-agenda-week-view (arg)  
   "Switch agenda to week view."  
   (interactive "P")  
3444    (unless (boundp 'starting-day)    (unless (boundp 'starting-day)
3445      (error "Not allowed"))      (error "Not allowed"))
3446    (setq org-agenda-ndays    (setq org-agenda-ndays
# Line 3397  With prefix ARG, go back that many times Line 3470  With prefix ARG, go back that many times
3470    (if (not (re-search-backward "^\\S-" nil t arg))    (if (not (re-search-backward "^\\S-" nil t arg))
3471        (error "No previous date before this line in this buffer.")))        (error "No previous date before this line in this buffer.")))
3472    
3473    ;; Initialize the highlight
3474    (defvar org-hl (funcall (if org-xemacs-p 'make-extent 'make-overlay) 1 1))
3475    (funcall (if org-xemacs-p 'set-extent-property 'overlay-put) org-hl
3476             'face 'highlight)
3477    
3478    (defun org-highlight (begin end &optional buffer)
3479      "Highlight a region with overlay."
3480      (funcall (if org-xemacs-p 'set-extent-endpoints 'move-overlay)
3481               org-hl begin end (or buffer (current-buffer))))
3482    
3483    (defun org-unhighlight ()
3484      "Detach overlay INDEX."
3485      (funcall (if org-xemacs-p 'detach-extent 'delete-overlay) org-hl))
3486    
3487    
3488  (defun org-agenda-follow-mode ()  (defun org-agenda-follow-mode ()
3489    "Toggle follow mode in an agenda buffer."    "Toggle follow mode in an agenda buffer."
3490    (interactive)    (interactive)
# Line 3430  With prefix ARG, go back that many times Line 3518  With prefix ARG, go back that many times
3518             (get-text-property (point) 'org-marker))             (get-text-property (point) 'org-marker))
3519        (org-agenda-show)))        (org-agenda-show)))
3520    
3521    (defvar org-disable-diary nil)          ;Dynamically-scoped param.
3522    
3523  (defun org-get-entries-from-diary (date)  (defun org-get-entries-from-diary (date)
3524    "Get the (emacs calendar) diary entries for DATE."    "Get the (Emacs Calendar) diary entries for DATE."
3525    (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")    (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")
3526           (diary-display-hook '(fancy-diary-display))           (diary-display-hook '(fancy-diary-display))
3527           (list-diary-entries-hook           (list-diary-entries-hook
3528            (cons 'org-diary-default-entry list-diary-entries-hook))            (cons 'org-diary-default-entry list-diary-entries-hook))
3529           entries           entries tod tods
3530           (disable-org-diary t))           (org-disable-diary t))
3531      (save-excursion      (save-excursion
3532        (save-window-excursion        (save-window-excursion
3533          (list-diary-entries date 1)))          (list-diary-entries date 1)))
3534      (if (not (get-buffer fancy-diary-buffer))      (if (not (get-buffer fancy-diary-buffer))
3535          (setq entries nil)          (setq entries nil)
3536        (save-excursion        (with-current-buffer fancy-diary-buffer
         (switch-to-buffer fancy-diary-buffer)  
3537          (setq buffer-read-only nil)          (setq buffer-read-only nil)
3538          (if (= (point-max) 1)          (if (= (point-max) 1)
3539              ;; No entries              ;; No entries
# Line 3452  With prefix ARG, go back that many times Line 3541  With prefix ARG, go back that many times
3541            ;; Omit the date and other unnecessary stuff            ;; Omit the date and other unnecessary stuff
3542            (org-agenda-cleanup-fancy-diary)            (org-agenda-cleanup-fancy-diary)
3543            ;; Add prefix to each line and extend the text properties            ;; Add prefix to each line and extend the text properties
           (goto-char (point-min))  
           (while (and (re-search-forward "^" nil t) (not (eobp)))  
             (replace-match "  Diary:     ")  
             (add-text-properties (point-at-bol) (point)  
                                  (text-properties-at (point))))  
3544            (if (= (point-max) 1)            (if (= (point-max) 1)
3545                (setq entries nil)                (setq entries nil)
3546              (setq entries (buffer-substring (point-min) (- (point-max) 1)))))              (setq entries (buffer-substring (point-min) (- (point-max) 1)))))
# Line 3467  With prefix ARG, go back that many times Line 3551  With prefix ARG, go back that many times
3551        (setq entries        (setq entries
3552              (mapcar              (mapcar
3553               (lambda (x)               (lambda (x)
3554                 (if (string-match "\\<\\([012][0-9]\\):\\([0-6][0-9]\\)" x)                 (setq x (org-format-agenda-item "" x "Diary"))
3555                     (add-text-properties                 ;; Extend the text properties to the beginning of the line
3556                      1 (length x)                 (add-text-properties
3557                      (list 'time-of-day                  0 (length x)
3558                            (+ (* 100 (string-to-number                  (text-properties-at (1- (length x)) x)
3559                                       (match-string 1 x)))                  x)
                              (string-to-number (match-string 2 x))))  
                     x))  
3560                 x)                 x)
3561               entries)))))               entries)))))
3562    
3563  (defun org-agenda-cleanup-fancy-diary ()  (defun org-agenda-cleanup-fancy-diary ()
3564    "Remove unwanted stuff in buffer created by fancy-diary-display.    "Remove unwanted stuff in buffer created by fancy-diary-display.
3565  This gets rid of the date, the underline under the date, and  This gets rid of the date, the underline under the date, and
3566  the dummy entry installed by org-mode to ensure non-empty diary for each  the dummy entry installed by `org-mode' to ensure non-empty diary for each
3567  date."  date.  Itt also removes lines that contain only whitespace."
3568    (goto-char (point-min))    (goto-char (point-min))
3569    (if (looking-at ".*?:[ \t]*")    (if (looking-at ".*?:[ \t]*")
3570        (progn        (progn
3571          (replace-match "")          (replace-match "")
3572          (re-search-forward "\n=+$" nil t)          (re-search-forward "\n=+$" nil t)
3573          (replace-match "")          (replace-match "")
3574          (while (re-search-backward "^ +" nil t) (replace-match "")))          (while (re-search-backward "^ +\n?" nil t) (replace-match "")))
3575      (re-search-forward "\n=+$" nil t)      (re-search-forward "\n=+$" nil t)
3576      (delete-region (point-min) (min (point-max) (1+ (match-end 0)))))      (delete-region (point-min) (min (point-max) (1+ (match-end 0)))))
3577      (goto-char (point-min))
3578      (while (re-search-forward "^ +\n" nil t)
3579        (replace-match ""))
3580      (goto-char (point-min))
3581    (if (re-search-forward "^Org-mode dummy\n?" nil t)    (if (re-search-forward "^Org-mode dummy\n?" nil t)
3582        (replace-match "")))        (replace-match "")))
3583    
# Line 3501  date." Line 3587  date."
3587  (eval-after-load "diary-lib"  (eval-after-load "diary-lib"
3588    '(defadvice add-to-diary-list (before org-mark-diary-entry activate)    '(defadvice add-to-diary-list (before org-mark-diary-entry activate)
3589       "Make the position visible."       "Make the position visible."
3590       (if (and (boundp 'disable-org-diary)  ;; called from org-agenda       (if (and org-disable-diary  ;; called from org-agenda
3591                (stringp string)                (stringp string)
3592                (buffer-file-name))                (buffer-file-name))
3593           (add-text-properties           (add-text-properties
# Line 3606  sure that TODAY is included in the list. Line 3692  sure that TODAY is included in the list.
3692    
3693  ;;;###autoload  ;;;###autoload
3694  (defun org-diary (&rest args)  (defun org-diary (&rest args)
3695    "Returns diary information from org-files.    "Return diary information from org-files.
3696  This function can be used in a \"sexp\" diary entry in the Emacs calendar.  This function can be used in a \"sexp\" diary entry in the Emacs calendar.
3697  It accesses org files and extracts information from those files to be  It accesses org files and extracts information from those files to be
3698  listed in the diary.  The function accepts arguments specifying what  listed in the diary.  The function accepts arguments specifying what
# Line 3649  The function expects the lisp variables Line 3735  The function expects the lisp variables
3735  by the caller, because this is how the calendar works.  Don't use this  by the caller, because this is how the calendar works.  Don't use this
3736  function from a program - use `org-agenda-get-day-entries' instead."  function from a program - use `org-agenda-get-day-entries' instead."
3737    (org-agenda-maybe-reset-markers)    (org-agenda-maybe-reset-markers)
3738      (org-compile-agenda-prefix-format org-agenda-prefix-format)
3739    (setq args (or args '(:deadline :scheduled :timestamp)))    (setq args (or args '(:deadline :scheduled :timestamp)))
3740    (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))    (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
3741                      (list entry)                      (list entry)
# Line 3656  function from a program - use `org-agend Line 3743  function from a program - use `org-agend
3743           file rtn results)           file rtn results)
3744      ;; If this is called during org-agenda, don't return any entries to      ;; If this is called during org-agenda, don't return any entries to
3745      ;; the calendar.  Org Agenda will list these entries itself.      ;; the calendar.  Org Agenda will list these entries itself.
3746      (if (boundp 'disable-org-diary) (setq files nil))      (if org-disable-diary (setq files nil))
3747      (while (setq file (pop files))      (while (setq file (pop files))
3748        (setq rtn (apply 'org-agenda-get-day-entries file date args))        (setq rtn (apply 'org-agenda-get-day-entries file date args))
3749        (setq results (append results rtn)))        (setq results (append results rtn)))
3750      (concat (org-finalize-agenda-entries results) "\n")))      (concat (org-finalize-agenda-entries results) "\n")))
3751    
3752  (defun org-agenda-get-day-entries (file date &rest args)  (defun org-agenda-get-day-entries (file date &rest args)
3753    "Does the work for `org-diary' and `org-agenda'    "Does the work for `org-diary' and `org-agenda'.
3754  FILE is the path to a file to be checked for entries.  DATE is date like  FILE is the path to a file to be checked for entries.  DATE is date like
3755  the one returned by `calendar-current-date'.  ARGS are symbols indicating  the one returned by `calendar-current-date'.  ARGS are symbols indicating
3756  which kind of entries should be extracted.  For details about these, see  which kind of entries should be extracted.  For details about these, see
# Line 3672  the documentation of `org-diary'." Line 3759  the documentation of `org-diary'."
3759    (let* ((org-startup-with-deadline-check nil)    (let* ((org-startup-with-deadline-check nil)
3760           (org-startup-folded nil)           (org-startup-folded nil)
3761           (buffer (if (file-exists-p file)           (buffer (if (file-exists-p file)
 ;                     (find-file-noselect file)  
3762                       (org-get-agenda-file-buffer file)                       (org-get-agenda-file-buffer file)
3763                     (error "No such file %s" file)))                     (error "No such file %s" file)))
          (respect-narrow-p (boundp 'org-respect-restriction))  
3764           arg results rtn)           arg results rtn)
3765      (if (not buffer)      (if (not buffer)
3766          ;; If file does not exist, make sure an error message ends up in diary          ;; If file does not exist, make sure an error message ends up in diary
3767          (format "ORG-AGENDA-ERROR: No such org-file %s" file)          (format "ORG-AGENDA-ERROR: No such org-file %s" file)
3768        (save-excursion        (with-current-buffer buffer
3769          (set-buffer buffer)          (unless (eq major-mode 'org-mode)
3770              (error "Agenda file %s is not in `org-mode'" file))
3771          (let ((case-fold-search nil))          (let ((case-fold-search nil))
3772            (save-excursion            (save-excursion
3773              (save-restriction              (save-restriction
3774                (if respect-narrow-p                (if org-respect-restriction
3775                    (if (org-region-active-p)                    (if (org-region-active-p)
3776                        ;; Respect a region to restrict search                        ;; Respect a region to restrict search
3777                        (narrow-to-region (region-beginning) (region-end)))                        (narrow-to-region (region-beginning) (region-end)))
3778                  ;; If we work for the calendar or many files,                  ;; If we work for the calendar or many files,
3779                  ;; get rid of any restriction                  ;; get rid of any restriction
3780                  (widen))                  (widen))
3781                  ;; The way we repeatedly append to `results' makes it O(n^2) :-(
3782                (while (setq arg (pop args))                (while (setq arg (pop args))
3783                  (cond                  (cond
3784                   ((and (eq arg :todo)                   ((and (eq arg :todo)
# Line 3748  the documentation of `org-diary'." Line 3835  the documentation of `org-diary'."
3835           (regexp (concat "[\n\r]\\*+ *\\(" org-not-done-regexp           (regexp (concat "[\n\r]\\*+ *\\(" org-not-done-regexp
3836                           "[^\n\r]*\\)"))                           "[^\n\r]*\\)"))
3837           marker priority           marker priority
3838           ee txt pl)           ee txt)
3839      (goto-char (point-min))      (goto-char (point-min))
3840      (while (re-search-forward regexp nil t)      (while (re-search-forward regexp nil t)
3841        (goto-char (match-beginning 1))        (goto-char (match-beginning 1))
# Line 3855  the documentation of `org-diary'." Line 3942  the documentation of `org-diary'."
3942           (todayp (equal date (calendar-current-date))) ; DATE bound by calendar           (todayp (equal date (calendar-current-date))) ; DATE bound by calendar
3943           (d1 (calendar-absolute-from-gregorian date))  ; DATE bound by calendar           (d1 (calendar-absolute-from-gregorian date))  ; DATE bound by calendar
3944           d2 diff pos pos1           d2 diff pos pos1
3945           ee txt head hdmarker)           ee txt head)
3946      (goto-char (point-min))      (goto-char (point-min))
3947      (while (re-search-forward regexp nil t)      (while (re-search-forward regexp nil t)
3948        (setq pos (1- (match-beginning 1))        (setq pos (1- (match-beginning 1))
# Line 3913  the documentation of `org-diary'." Line 4000  the documentation of `org-diary'."
4000           (regexp org-scheduled-time-regexp)           (regexp org-scheduled-time-regexp)
4001           (todayp (equal date (calendar-current-date))) ; DATE bound by calendar           (todayp (equal date (calendar-current-date))) ; DATE bound by calendar
4002           (d1 (calendar-absolute-from-gregorian date))  ; DATE bound by calendar           (d1 (calendar-absolute-from-gregorian date))  ; DATE bound by calendar
4003           d2 diff marker hdmarker pos pos1           d2 diff pos pos1
4004           ee txt head)           ee txt head)
4005      (goto-char (point-min))      (goto-char (point-min))
4006      (while (re-search-forward regexp nil t)      (while (re-search-forward regexp nil t)
# Line 3990  the documentation of `org-diary'." Line 4077  the documentation of `org-diary'."
4077      ;; Sort the entries by expiration date.      ;; Sort the entries by expiration date.
4078      (nreverse ee)))      (nreverse ee)))
4079    
4080    (defun org-format-agenda-item (prefix txt &optional category)
 (defun org-format-agenda-item (prefix txt)  
4081    "Format TXT to be inserted into the agenda buffer.    "Format TXT to be inserted into the agenda buffer.
4082  In particular, this indents the line and adds a category."  In particular, this indents the line and adds a category."
4083    (let ((cat (or org-category    (let* ((category (or category
4084                   (file-name-sans-extension                         org-category
4085                    (file-name-nondirectory (buffer-file-name)))))                         (file-name-sans-extension
4086          time rtn)                          (file-name-nondirectory (buffer-file-name)))))
4087      (if (symbolp cat) (setq cat (symbol-name cat)))           (extra prefix)
4088      (setq rtn (format "  %-10s %s%s" (concat cat ":") prefix txt))           (time-of-day (org-get-time-of-day txt))
4089      (add-text-properties           (t1 (if time-of-day (concat "0" (int-to-string time-of-day)) "0000"))
4090       0 2 (list 'category (downcase cat)           (time (if time-of-day
4091                 'prefix-length (- (length rtn) (length txt))                     (concat (substring t1 -4 -2)
4092                 'time-of-day (org-get-time-of-day rtn))                             ":" (substring t1 -2))
4093                     ""))
4094             rtn)
4095        (if (symbolp category) (setq category (symbol-name category)))
4096        (setq rtn (concat (eval org-prefix-format-compiled) txt))
4097        (add-text-properties
4098         0 (length rtn) (list 'category (downcase category)
4099                              'prefix-length (- (length rtn) (length txt))
4100                              'time-of-day time-of-day)
4101       rtn)       rtn)
4102      rtn))      rtn))
4103        
4104  ;; FIXME:  Should this be restricted to beginning of string?  (defun org-compile-prefix-format (format)
4105      "Compile the prefix format into a Lisp form that can be evaluated.
4106    The resulting form is returned and stored in the variable
4107    `org-prefix-format-compiled'."
4108      (let ((start 0) varform vars (s format) c)
4109        (while (string-match "%\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)"
4110                             s start)
4111          (setq var (cdr (assoc (match-string 3 s)
4112                                '(("c" . category) ("t" . time) ("s" . extra))))
4113                c (match-string 2 s)
4114                start (1+ (match-beginning 0)))
4115          (if (= (length c) 1)
4116              (setq varform `(if (equal "" ,var) "" (concat ,var ,c)))
4117            (setq varform var))
4118          (setq s (replace-match "%\\1s" t nil s))
4119          (push varform vars))
4120        (setq vars (nreverse vars))
4121        (setq org-prefix-format-compiled `(format ,s ,@vars))))
4122    
4123  (defun org-get-time-of-day (s)  (defun org-get-time-of-day (s)
4124    "Check string S for a time of day."    "Check string S for a time of day.
4125    If found, return it as a military time number between 0 and 2400.
4126    If not found, return nil."
4127    (save-match-data    (save-match-data
4128    (when (and      (when (or
4129           (string-match             (string-match
4130            "\\<\\([012][0-9]\\)\\(:\\([0-6][0-9]\\)\\)?\\([AaPp][Mm]\\)?\\>" s)              "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\>" s)
4131           (or (match-beginning 2) (match-beginning 4)))             (string-match
4132      (+ (* 100 (+ (string-to-number (match-string 1 s))              "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\>" s))
4133                   (if (and (match-beginning 4)        (+ (* 100 (+ (string-to-number (match-string 1 s))
4134                            (equal (downcase (match-string 4 s)) "pm"))                     (if (and (match-beginning 4)
4135                       12 0)))                              (equal (downcase (match-string 4 s)) "pm"))
4136         (if (match-beginning 3)                         12 0)))
4137             (string-to-number (match-string 3 s))           (if (match-beginning 3)
4138           0)))))               (string-to-number (match-string 3 s))
4139               0)))))
4140    
4141  (defun org-finalize-agenda-entries (list)  (defun org-finalize-agenda-entries (list)
4142    "Sort and concatenate the agenda items."    "Sort and concatenate the agenda items."
# Line 4073  and by additional input from the age of Line 4188  and by additional input from the age of
4188    (let* ((pri (get-text-property (point-at-bol) 'priority)))    (let* ((pri (get-text-property (point-at-bol) 'priority)))
4189      (message "Priority is %d" (if pri pri -1000))))      (message "Priority is %d" (if pri pri -1000))))
4190    
4191  (defun org-agenda-goto ()  (defun org-agenda-goto (&optional highlight)
4192    "Go to the Org-mode file which contains the item at point."    "Go to the Org-mode file which contains the item at point."
4193    (interactive)    (interactive)
4194    (let* ((marker (or (get-text-property (point) 'org-marker)    (let* ((marker (or (get-text-property (point) 'org-marker)
# Line 4087  and by additional input from the age of Line 4202  and by additional input from the age of
4202        (org-show-hidden-entry)        (org-show-hidden-entry)
4203        (save-excursion        (save-excursion
4204          (and (outline-next-heading)          (and (outline-next-heading)
4205               (org-flag-heading nil))))))  ; show the next heading               (org-flag-heading nil)))) ; show the next heading
4206        (and highlight (org-highlight (point-at-bol) (point-at-eol)))))
4207    
4208  (defun org-agenda-switch-to ()  (defun org-agenda-switch-to ()
4209    "Go to the Org-mode file which contains the item at point."    "Go to the Org-mode file which contains the item at point."
# Line 4116  and by additional input from the age of Line 4232  and by additional input from the age of
4232    "Display the Org-mode file which contains the item at point."    "Display the Org-mode file which contains the item at point."
4233    (interactive)    (interactive)
4234    (let ((win (selected-window)))    (let ((win (selected-window)))
4235      (org-agenda-goto)      (org-agenda-goto t)
4236      (select-window win)))      (select-window win)))
4237    
4238  (defun org-agenda-recenter (arg)  (defun org-agenda-recenter (arg)
4239    "Display the Org-mode file which contains the item at point and recenter."    "Display the Org-mode file which contains the item at point and recenter."
4240    (interactive "P")    (interactive "P")
4241    (let ((win (selected-window)))    (let ((win (selected-window)))
4242      (org-agenda-goto)      (org-agenda-goto t)
4243      (recenter arg)      (recenter arg)
4244      (select-window win)))      (select-window win)))
4245    
# Line 4159  the same tree node, and the headline of Line 4275  the same tree node, and the headline of
4275           (hdmarker (get-text-property (point) 'org-hd-marker))           (hdmarker (get-text-property (point) 'org-hd-marker))
4276           (buffer-read-only nil)           (buffer-read-only nil)
4277           newhead)           newhead)
4278      (save-excursion      (with-current-buffer buffer
       (set-buffer buffer)  
4279        (widen)        (widen)
4280        (goto-char pos)        (goto-char pos)
4281        (org-show-hidden-entry)        (org-show-hidden-entry)
# Line 4225  This changes the line at point, all othe Line 4340  This changes the line at point, all othe
4340  the same tree node, and the headline of the tree node in the Org-mode file."  the same tree node, and the headline of the tree node in the Org-mode file."
4341    (interactive)    (interactive)
4342    (org-agenda-check-no-diary)    (org-agenda-check-no-diary)
4343    (let* ((props (text-properties-at (point)))    (let* ((marker (or (get-text-property (point) 'org-marker)
          (col (current-column))  
          (marker (or (get-text-property (point) 'org-marker)  
4344                       (org-agenda-error)))                       (org-agenda-error)))
          (pl (get-text-property (point-at-bol) 'prefix-length))  
4345           (buffer (marker-buffer marker))           (buffer (marker-buffer marker))
4346           (pos (marker-position marker))           (pos (marker-position marker))
4347           (hdmarker (get-text-property (point) 'org-hd-marker))           (hdmarker (get-text-property (point) 'org-hd-marker))
4348           (buffer-read-only nil)           (buffer-read-only nil)
4349           newhead)           newhead)
4350      (save-excursion      (with-current-buffer buffer
       (set-buffer buffer)  
4351        (widen)        (widen)
4352        (goto-char pos)        (goto-char pos)
4353        (org-show-hidden-entry)        (org-show-hidden-entry)
# Line 4271  the same tree node, and the headline of Line 4382  the same tree node, and the headline of
4382    (org-agenda-date-later (- arg) what))    (org-agenda-date-later (- arg) what))
4383    
4384  (defun org-agenda-date-prompt (arg)  (defun org-agenda-date-prompt (arg)
4385    "Change the date of this item.  Date is prompted for, with default today."    "Change the date of this item.  Date is prompted for, with default today.
4386    (interactive "p")  The prefix ARG is passed to the `org-time-stamp' command and can therefore
4387    be used to request time specification in the time stamp."
4388      (interactive "P")
4389    (org-agenda-check-no-diary)    (org-agenda-check-no-diary)
4390    (let* ((marker (or (get-text-property (point) 'org-marker)    (let* ((marker (or (get-text-property (point) 'org-marker)
4391                       (org-agenda-error)))                       (org-agenda-error)))
4392           (buffer (marker-buffer marker))           (buffer (marker-buffer marker))
4393           (pos (marker-position marker)))           (pos (marker-position marker)))
4394      (save-excursion      (with-current-buffer buffer
       (set-buffer buffer)  
4395        (widen)        (widen)
4396        (goto-char pos)        (goto-char pos)
4397        (if (not (org-at-timestamp-p))        (if (not (org-at-timestamp-p))
4398            (error "Cannot find time stamp"))            (error "Cannot find time stamp"))
4399        (org-time-stamp nil)        (org-time-stamp arg)
4400        (message "Time stamp changed to %s" org-last-changed-timestamp))))        (message "Time stamp changed to %s" org-last-changed-timestamp))))
4401    
4402  (defun org-get-heading ()  (defun org-get-heading ()
# Line 4295  the same tree node, and the headline of Line 4407  the same tree node, and the headline of
4407          (match-string 1)          (match-string 1)
4408        "")))        "")))
4409    
4410  (defun org-agenda-diary-entry (arg)  (defun org-agenda-diary-entry ()
4411    "Make a diary entry, like the `i' command from the calendar.    "Make a diary entry, like the `i' command from the calendar.
4412  All the standard commands work: block, weekly etc"  All the standard commands work: block, weekly etc"
4413    (interactive "P")    (interactive)
4414    (require 'diary-lib)    (require 'diary-lib)
4415    (let* ((char (progn    (let* ((char (progn
4416                   (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")                   (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
# Line 4344  the cursor position." Line 4456  the cursor position."
4456      (error "Don't know which date to use for calendar command"))      (error "Don't know which date to use for calendar command"))
4457    (let* ((oldf (symbol-function 'calendar-cursor-to-date))    (let* ((oldf (symbol-function 'calendar-cursor-to-date))
4458           (point (point))           (point (point))
          (mark (or (mark t) (point)))  
4459           (date (calendar-gregorian-from-absolute           (date (calendar-gregorian-from-absolute
4460                  (get-text-property point 'day)))                  (get-text-property point 'day)))
4461           (displayed-day (extract-calendar-day date))           (displayed-day (extract-calendar-day date))
# Line 4527  optional argument IN-EMACS is non-nil, E Line 4638  optional argument IN-EMACS is non-nil, E
4638  (defun org-follow-bbdb-link (name)  (defun org-follow-bbdb-link (name)
4639    "Follow a BBDB link to NAME."    "Follow a BBDB link to NAME."
4640    (require 'bbdb)    (require 'bbdb)
4641    ;; First try an exact match    (let ((inhibit-redisplay t))
4642    (bbdb-name (concat "\\`" name "\\'") nil)      (catch 'exit
4643    (if (= 0 (buffer-size (get-buffer "*BBDB*")))        ;; Exact match on name
4644        ;; No exact match - try partial match        (bbdb-name (concat "\\`" name "\\'") nil)
4645        (bbdb-name name nil)))        (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
4646          ;; Exact match on name
4647          (bbdb-company (concat "\\`" name "\\'") nil)
4648          (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
4649          ;; Partial match on name
4650          (bbdb-name name nil)
4651          (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
4652          ;; Partial match on company
4653          (bbdb-company name nil)
4654          (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
4655          ;; General match including network address and notes
4656          (bbdb name nil)
4657          (when (= 0 (buffer-size (get-buffer "*BBDB*")))
4658            (delete-window (get-buffer-window "*BBDB*"))
4659            (error "No matching BBDB record")))))
4660    
4661  (defun org-follow-gnus-link (&optional group article)  (defun org-follow-gnus-link (&optional group article)
4662    "Follow a Gnus link to GROUP and ARTICLE."    "Follow a Gnus link to GROUP and ARTICLE."
# Line 4545  optional argument IN-EMACS is non-nil, E Line 4670  optional argument IN-EMACS is non-nil, E
4670                  (gnus-summary-insert-cached-articles)                  (gnus-summary-insert-cached-articles)
4671                  (gnus-summary-goto-article article nil 'force))                  (gnus-summary-goto-article article nil 'force))
4672              (message "Message could not be found.")))))              (message "Message could not be found.")))))
 ;;  (if article (gnus-summary-goto-article article nil 'force)))  
4673    
4674  (defun org-follow-vm-link (&optional folder article readonly)  (defun org-follow-vm-link (&optional folder article readonly)
4675    "Follow a VM link to FOLDER and ARTICLE."    "Follow a VM link to FOLDER and ARTICLE."
# Line 4681  For file links, arg negates `org-line-nu Line 4805  For file links, arg negates `org-line-nu
4805    
4806       ((eq major-mode 'bbdb-mode)       ((eq major-mode 'bbdb-mode)
4807        (setq link (concat "bbdb:"        (setq link (concat "bbdb:"
4808                           (bbdb-record-name (bbdb-current-record)))))                           (or (bbdb-record-name (bbdb-current-record))
4809                                 (bbdb-record-company (bbdb-current-record))))))
4810        
4811       ((eq major-mode 'calendar-mode)       ((eq major-mode 'calendar-mode)
4812        (let ((cd (calendar-cursor-to-date)))        (let ((cd (calendar-cursor-to-date)))
4813          (setq link          (setq link
# Line 4702  For file links, arg negates `org-line-nu Line 4827  For file links, arg negates `org-line-nu
4827                (folder (buffer-file-name))                (folder (buffer-file-name))
4828                (subject (vm-su-subject message))                (subject (vm-su-subject message))
4829                (author (vm-su-full-name message))                (author (vm-su-full-name message))
               (address (vm-su-from message))  
4830                (message-id (vm-su-message-id message)))                (message-id (vm-su-message-id message)))
4831           (setq folder (abbreviate-file-name folder))           (setq folder (abbreviate-file-name folder))
4832           (if (string-match (concat "^" (regexp-quote vm-folder-directory))           (if (string-match (concat "^" (regexp-quote vm-folder-directory))
# Line 4747  For file links, arg negates `org-line-nu Line 4871  For file links, arg negates `org-line-nu
4871                                 group))                                 group))
4872            (setq link (concat "gnus:" group)))))            (setq link (concat "gnus:" group)))))
4873    
4874       ((or (eq major-mode 'gnus-summary-mode)       ((memq major-mode '(gnus-summary-mode gnus-article-mode))
4875            (eq major-mode 'gnus-article-mode))        (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
       (gnus-article-show-summary)  
4876        (gnus-summary-beginning-of-article)        (gnus-summary-beginning-of-article)
4877        (let* ((group (car gnus-article-current))        (let* ((group (car gnus-article-current))
4878               (article (cdr gnus-article-current))               (article (cdr gnus-article-current))
# Line 4825  For file links, arg negates `org-line-nu Line 4948  For file links, arg negates `org-line-nu
4948    
4949    
4950  (defun org-fixup-message-id-for-http (s)  (defun org-fixup-message-id-for-http (s)
4951    "Replace special characters in a message id, so that it can be used    "Replace special characters in a message id, so it can be used in an http query."
 in an http query."  
4952    (while (string-match "<" s)    (while (string-match "<" s)
4953      (setq s (replace-match "%3C" t t s)))      (setq s (replace-match "%3C" t t s)))
4954    (while (string-match ">" s)    (while (string-match ">" s)
# Line 4843  Completion can be used to select a link Line 4965  Completion can be used to select a link
4965  press RET at the prompt), the link defaults to the most recently  press RET at the prompt), the link defaults to the most recently
4966  stored link.  stored link.
4967    
4968  With a C-u prefix, prompts for a file to link to.  The file name can be  With a \\[universal-argument] prefix, prompts for a file to link to.  The file name can be
4969  selected using completion.  The path to the file will be relative to  selected using completion.  The path to the file will be relative to
4970  the current directory if the file is in the current directory or a  the current directory if the file is in the current directory or a
4971  subdirectory.  Otherwise, the link will be the absolute path as  subdirectory.  Otherwise, the link will be the absolute path as
4972  completed in the minibuffer (i.e. normally ~/path/to/file).  completed in the minibuffer (i.e. normally ~/path/to/file).
4973    
4974  With two C-u prefixes, enforce an absolute path even if the file  With two \\[universal-argument] prefixes, enforce an absolute path even if the file
4975  is in the current directory or below."  is in the current directory or below."
4976    (interactive "P")    (interactive "P")
4977    (let ((link (if complete-file    (let ((link (if complete-file
# Line 4970  See also the variable `org-reverse-note- Line 5092  See also the variable `org-reverse-note-
5092        ;; Find the file        ;; Find the file
5093        (if (not visiting)        (if (not visiting)
5094            (find-file-noselect file))            (find-file-noselect file))
5095        (save-excursion        (with-current-buffer (get-file-buffer file)
         (set-buffer (get-file-buffer file))  
5096          (setq reversed (org-notes-order-reversed-p))          (setq reversed (org-notes-order-reversed-p))
5097          (save-restriction          (save-excursion
5098            (save-excursion            (save-restriction
5099              (widen)              (widen)
5100              ;; Ask the User for a location              ;; Ask the User for a location
5101              (setq spos (if fastp 1 (org-get-location              (setq spos (if fastp 1 (org-get-location
# Line 5038  See also the variable `org-reverse-note- Line 5159  See also the variable `org-reverse-note-
5159  ;; Emacs package.  We call the former org-type tables, and the latter  ;; Emacs package.  We call the former org-type tables, and the latter
5160  ;; table.el-type tables.  ;; table.el-type tables.
5161    
 ;; We use a before-change function to check if a table might need  
 ;; an update.  
 (defvar org-table-may-need-update t  
   "Indicates of a table might need an update.  
 This variable is set by `org-before-change-function'. `org-table-align'  
 sets it back to nil.")  
5162    
5163  (defun org-before-change-function (beg end)  (defun org-before-change-function (beg end)
5164    "Every change indicates that a table might need an update."    "Every change indicates that a table might need an update."
# Line 5058  sets it back to nil.") Line 5173  sets it back to nil.")
5173  (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"  (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
5174    "Detects a table-type table hline.")    "Detects a table-type table hline.")
5175  (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"  (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"
5176    "Detects an org-type or table-type table")    "Detects an org-type or table-type table.")
5177  (defconst org-table-border-regexp "^[ \t]*[^| \t]"  (defconst org-table-border-regexp "^[ \t]*[^| \t]"
5178    "Searching from within a table (any type) this finds the first line    "Searching from within a table (any type) this finds the first line
5179  outside the table.")  outside the table.")
# Line 5210  This is being used to correctly align a Line 5325  This is being used to correctly align a
5325  This is being used to correctly align a single field after TAB or RET.")  This is being used to correctly align a single field after TAB or RET.")
5326    
5327    
5328  (defun org-table-align (&optional arg)  (defun org-table-align ()
5329    "Align the table at point by aligning all vertical bars."    "Align the table at point by aligning all vertical bars."
5330    (interactive "P")    (interactive)
5331    (let* (    (let* (
5332           ;; Limits of table           ;; Limits of table
5333           (beg (org-table-begin))           (beg (org-table-begin))
# Line 5366  With argument TABLE-TYPE, go to the end Line 5481  With argument TABLE-TYPE, go to the end
5481            (setq org-table-may-need-update t))            (setq org-table-may-need-update t))
5482          (goto-char pos))))))          (goto-char pos))))))
5483    
5484  (defun org-table-next-field (&optional arg)  (defun org-table-next-field ()
5485    "Go to the next field in the current table.    "Go to the next field in the current table.
5486  Before doing so, re-align the table if necessary."  Before doing so, re-align the table if necessary."
5487    (interactive "P")    (interactive)
5488    (if (and org-table-automatic-realign    (if (and org-table-automatic-realign
5489             org-table-may-need-update)             org-table-may-need-update)
5490        (org-table-align))        (org-table-align))
# Line 5388  Before doing so, re-align the table if n Line 5503  Before doing so, re-align the table if n
5503      (error      (error
5504       (org-table-insert-row 'below))))       (org-table-insert-row 'below))))
5505    
5506  (defun org-table-previous-field (&optional arg)  (defun org-table-previous-field ()
5507    "Go to the previous field in the table.    "Go to the previous field in the table.
5508  Before doing so, re-align the table if necessary."  Before doing so, re-align the table if necessary."
5509    (interactive "P")    (interactive)
5510    (if (and org-table-automatic-realign    (if (and org-table-automatic-realign
5511             org-table-may-need-update)             org-table-may-need-update)
5512        (org-table-align))        (org-table-align))
# Line 5404  Before doing so, re-align the table if n Line 5519  Before doing so, re-align the table if n
5519    (if (looking-at "| ?")    (if (looking-at "| ?")
5520        (goto-char (match-end 0))))        (goto-char (match-end 0))))
5521    
5522  (defun org-table-next-row (&optional arg)  (defun org-table-next-row ()
5523    "Go to the next row (same column) in the current table.    "Go to the next row (same column) in the current table.
5524  Before doing so, re-align the table if necessary."  Before doing so, re-align the table if necessary."
5525    (interactive "P")    (interactive)
5526    (if (or (looking-at "[ \t]*$")    (if (or (looking-at "[ \t]*$")
5527            (save-excursion (skip-chars-backward " \t") (bolp)))            (save-excursion (skip-chars-backward " \t") (bolp)))
5528        (newline)        (newline)
# Line 5470  I.e. not on a hline or before the first Line 5585  I.e. not on a hline or before the first
5585            (looking-at "[ \t]*$"))            (looking-at "[ \t]*$"))
5586        (error "Not in table data field")))        (error "Not in table data field")))
5587    
5588    (defvar org-table-clip nil
5589      "Clipboard for table regions")
5590    
5591  (defun org-table-blank-field ()  (defun org-table-blank-field ()
5592    "Blank the current table field or active region."    "Blank the current table field or active region."
5593    (interactive)    (interactive)
# Line 5497  is always the old value." Line 5615  is always the old value."
5615    (backward-char 1)    (backward-char 1)
5616    (if (looking-at "|[^|\r\n]*")    (if (looking-at "|[^|\r\n]*")
5617        (let* ((pos (match-beginning 0))        (let* ((pos (match-beginning 0))
              (len (length (match-string 0)))  
5618               (val (buffer-substring (1+ pos) (match-end 0))))               (val (buffer-substring (1+ pos) (match-end 0))))
5619          (if replace          (if replace
5620              (replace-match (concat "|" replace)))              (replace-match (concat "|" replace)))
# Line 5591  However, when FORCE is non-nil, create n Line 5708  However, when FORCE is non-nil, create n
5708          (looking-at org-table-hline-regexp))          (looking-at org-table-hline-regexp))
5709      nil))      nil))
5710    
5711  (defun org-table-insert-column (&optional arg)  (defun org-table-insert-column ()
5712    "Insert a new column into the table."    "Insert a new column into the table."
5713    (interactive "P")    (interactive)
5714    (if (not (org-at-table-p))    (if (not (org-at-table-p))
5715        (error "Not at a table"))        (error "Not at a table"))
5716    (org-table-find-dataline)    (org-table-find-dataline)
# Line 5634  However, when FORCE is non-nil, create n Line 5751  However, when FORCE is non-nil, create n
5751          (error          (error
5752           "Please position cursor in a data line for column operations")))))           "Please position cursor in a data line for column operations")))))
5753    
5754  (defun org-table-delete-column (&optional arg)  (defun org-table-delete-column ()
5755    "Delete a column into the table."    "Delete a column into the table."
5756    (interactive "P")    (interactive)
5757    (if (not (org-at-table-p))    (if (not (org-at-table-p))
5758        (error "Not at a table"))        (error "Not at a table"))
5759    (org-table-find-dataline)    (org-table-find-dataline)
# Line 5777  With prefix ARG, insert above the curren Line 5894  With prefix ARG, insert above the curren
5894      (beginning-of-line 0)      (beginning-of-line 0)
5895      (move-to-column col)))      (move-to-column col)))
5896    
5897  (defun org-table-kill-row (&optional arg)  (defun org-table-kill-row ()
5898    "Delete the current row or horizontal line from the table."    "Delete the current row or horizontal line from the table."
5899    (interactive "P")    (interactive)
5900    (if (not (org-at-table-p))    (if (not (org-at-table-p))
5901        (error "Not at a table"))        (error "Not at a table"))
5902    (let ((col (current-column)))    (let ((col (current-column)))
# Line 5788  With prefix ARG, insert above the curren Line 5905  With prefix ARG, insert above the curren
5905      (move-to-column col)))      (move-to-column col)))
5906    
5907    
5908  (defun org-table-cut-region (&optional arg)  (defun org-table-cut-region ()
5909    "Copy region in table to the clipboard and blank all relevant fields."    "Copy region in table to the clipboard and blank all relevant fields."
5910    (interactive "P")    (interactive)
5911    (org-table-copy-region 'cut))    (org-table-copy-region 'cut))
5912    
 (defvar org-table-clip nil  
   "Clipboard for table regions")  
   
5913  (defun org-table-copy-region (&optional cut)  (defun org-table-copy-region (&optional cut)
5914    "Copy rectangular region in table to clipboard.    "Copy rectangular region in table to clipboard.
5915  A special clipboard is used which can only be accessed  A special clipboard is used which can only be accessed
# Line 5832  with `org-table-paste-rectangle'" Line 5946  with `org-table-paste-rectangle'"
5946      (setq org-table-clip (nreverse region))      (setq org-table-clip (nreverse region))
5947      (if cut (org-table-align))))      (if cut (org-table-align))))
5948        
5949  (defun org-table-paste-rectangle (&optional arg)  (defun org-table-paste-rectangle ()
5950    "Paste a rectangular region into a table.    "Paste a rectangular region into a table.
5951  The upper right corner ends up in the current field.  All involved fields  The upper right corner ends up in the current field.  All involved fields
5952  will be overwritten.  If the rectangle does not fit into the present table,  will be overwritten.  If the rectangle does not fit into the present table,
5953  the table is enlarged as needed.  The process ignores horizontal separator  the table is enlarged as needed.  The process ignores horizontal separator
5954  lines."  lines."
5955    (interactive "P")    (interactive)
5956    (unless (and org-table-clip (listp org-table-clip))    (unless (and org-table-clip (listp org-table-clip))
5957      (error "First cut/copy a region to paste!"))      (error "First cut/copy a region to paste!"))
5958    (org-table-check-inside-data-field)    (org-table-check-inside-data-field)
5959    (let* ((clip org-table-clip)    (let* ((clip org-table-clip)
5960           (line (count-lines (point-min) (point)))           (line (count-lines (point-min) (point)))
5961           (col (org-table-current-column))           (col (org-table-current-column))
          (l line)  
5962           (org-enable-table-editor t)           (org-enable-table-editor t)
5963           (org-table-automatic-realign nil)           (org-table-automatic-realign nil)
5964           c cols field)           c cols field)
# Line 5864  lines." Line 5977  lines."
5977      (org-table-align)))      (org-table-align)))
5978    
5979  (defun org-table-convert ()  (defun org-table-convert ()
5980    "Convert from org-mode table to table.el and back.    "Convert from `org-mode' table to table.el and back.
5981  Obviously, this only works within limits.  When an Org-mode table is  Obviously, this only works within limits.  When an Org-mode table is
5982  converted to table.el, all horizontal separator lines get lost, because  converted to table.el, all horizontal separator lines get lost, because
5983  table.el uses these as cell boundaries and has no notion of horizontal lines.  table.el uses these as cell boundaries and has no notion of horizontal lines.
# Line 5915  lines, in order to keep the table compac Line 6028  lines, in order to keep the table compac
6028  If there is an active region, and both point and mark are in the same column,  If there is an active region, and both point and mark are in the same column,
6029  the text in the column is wrapped to minimum width for the given number of  the text in the column is wrapped to minimum width for the given number of
6030  lines.  Generally, this makes the table more compact.  A prefix ARG may be  lines.  Generally, this makes the table more compact.  A prefix ARG may be
6031  used to change the number of desired lines.  For example, `C-2 C-c C-q'  used to change the number of desired lines.  For example, `C-2 \\[org-table-wrap]'
6032  formats the selected text to two lines.  If the region was longer than 2  formats the selected text to two lines.  If the region was longer than 2
6033  lines, the remaining lines remain empty.  A negative prefix argument reduces  lines, the remaining lines remain empty.  A negative prefix argument reduces
6034  the current number of lines by that amount.  The wrapped text is pasted back  the current number of lines by that amount.  The wrapped text is pasted back
# Line 5984  many lines, whatever width that takes. Line 6097  many lines, whatever width that takes.
6097  The return value is a list of lines, without newlines at the end."  The return value is a list of lines, without newlines at the end."
6098    (let* ((words (org-split-string string "[ \t\n]+"))    (let* ((words (org-split-string string "[ \t\n]+"))
6099           (maxword (apply 'max (mapcar 'length words)))           (maxword (apply 'max (mapcar 'length words)))
          (black (apply '+ (mapcar 'length words)))  
          (total (+ black (length words)))  
6100           w ll)           w ll)
6101      (cond (width      (cond (width
6102             (org-do-wrap words (max maxword width)))             (org-do-wrap words (max maxword width)))
# Line 6003  The return value is a list of lines, wit Line 6114  The return value is a list of lines, wit
6114                        
6115    
6116  (defun org-do-wrap (words width)  (defun org-do-wrap (words width)
6117    "Creates lines of maximum width WIDTH (in characters) from word list WORDS."    "Create lines of maximum width WIDTH (in characters) from word list WORDS."
6118    (let (lines line)    (let (lines line)
6119      (while words      (while words
6120        (setq line (pop words))        (setq line (pop words))
# Line 6222  A few examples for formulae: Line 6333  A few examples for formulae:
6333    $;%.1f              Reformat current cell to 1 digit after dec.point    $;%.1f              Reformat current cell to 1 digit after dec.point
6334    ($3-32)*5/9         degrees F -> C conversion    ($3-32)*5/9         degrees F -> C conversion
6335    
6336  When called with a raw C-u prefix, the formula is applied to the current  When called with a raw \\[universal-argument] prefix, the formula is applied to the current
6337  field, and to the same same column in all following rows, until reaching a  field, and to the same same column in all following rows, until reaching a
6338  horizontal line or the end of the table.  When the command is called with a  horizontal line or the end of the table.  When the command is called with a
6339  numeric prefix argument (like M-3 or C-7 or C-u 24), the formula is applied  numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied
6340  to the current row, and to the following n-1 rows (but not beyond a  to the current row, and to the following n-1 rows (but not beyond a
6341  separator line)."  separator line)."
6342    (interactive "P")    (interactive "P")
# Line 6297  separator line)." Line 6408  separator line)."
6408  ;; modified self-insert.  ;; modified self-insert.
6409    
6410  (defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized)  (defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized)
6411    "Non-nil means, use the optimized table editor version for orgtbl-mode.    "Non-nil means, use the optimized table editor version for `orgtbl-mode'.
6412  In the optimized version, the table editor takes over all simple keys that  In the optimized version, the table editor takes over all simple keys that
6413  normally just insert a character.  In tables, the characters are inserted  normally just insert a character.  In tables, the characters are inserted
6414  in a way to minimize disturbing the table structure (i.e. in overwrite mode  in a way to minimize disturbing the table structure (i.e. in overwrite mode
# Line 6311  this variable requires a restart of Emac Line 6422  this variable requires a restart of Emac
6422    :type 'boolean)    :type 'boolean)
6423    
6424  (defvar orgtbl-mode nil  (defvar orgtbl-mode nil
6425    "Variable controlling orgtbl-mode, a minor mode enabling the org-mode    "Variable controlling `orgtbl-mode', a minor mode enabling the `org-mode'
6426  table editor in arbitrary modes.")  table editor in arbitrary modes.")
6427  (make-variable-buffer-local 'orgtbl-mode)  (make-variable-buffer-local 'orgtbl-mode)
6428    
6429  (defvar orgtbl-mode-map (make-sparse-keymap)  (defvar orgtbl-mode-map (make-sparse-keymap)
6430    "Keymap for orgtbl-mode.")    "Keymap for `orgtbl-mode'.")
6431    
6432  ;;;###autoload  ;;;###autoload
6433  (defun turn-on-orgtbl ()  (defun turn-on-orgtbl ()
6434    "Unconditionally turn on orgtbl-mode."    "Unconditionally turn on `orgtbl-mode'."
6435    (orgtbl-mode 1))    (orgtbl-mode 1))
6436    
6437  ;;;###autoload  ;;;###autoload
6438  (defun orgtbl-mode (&optional arg)  (defun orgtbl-mode (&optional arg)
6439    "The org-mode table editor as a minor mode for use in other modes."    "The `org-mode' table editor as a minor mode for use in other modes."
6440    (interactive)    (interactive)
6441    (setq orgtbl-mode    (setq orgtbl-mode
6442          (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode)))          (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode)))
# Line 6435  table editor in arbitrary modes.") Line 6546  table editor in arbitrary modes.")
6546    (define-key org-mode-map "|" 'self-insert-command))    (define-key org-mode-map "|" 'self-insert-command))
6547    
6548  (defun orgtbl-tab ()  (defun orgtbl-tab ()
6549    "Justification and field motion for orgtbl-mode."    "Justification and field motion for `orgtbl-mode'."
6550    (interactive)    (interactive)
6551    (org-table-justify-field-maybe)    (org-table-justify-field-maybe)
6552    (org-table-next-field))    (org-table-next-field))
6553    
6554  (defun orgtbl-ret ()  (defun orgtbl-ret ()
6555    "Justification and field motion for orgtbl-mode."    "Justification and field motion for `orgtbl-mode'."
6556    (interactive)    (interactive)
6557    (org-table-justify-field-maybe)    (org-table-justify-field-maybe)
6558    (org-table-next-row))    (org-table-next-row))
# Line 6454  overwritten, and the table is not marked Line 6565  overwritten, and the table is not marked
6565    (if (and (org-at-table-p)    (if (and (org-at-table-p)
6566             (eq N 1)             (eq N 1)
6567             (looking-at "[^|\n]*  +|"))             (looking-at "[^|\n]*  +|"))
6568        (let (org-table-may-need-update (pos (point)))        (let (org-table-may-need-update)
6569          (goto-char (1- (match-end 0)))          (goto-char (1- (match-end 0)))
6570          (delete-backward-char 1)          (delete-backward-char 1)
6571          (goto-char (match-beginning 0))          (goto-char (match-beginning 0))
# Line 6869  The list contains HTML entities for Lati Line 6980  The list contains HTML entities for Lati
6980  It is supplemented by a number of commonly used TeX macros with appropriate  It is supplemented by a number of commonly used TeX macros with appropriate
6981  translations.")  translations.")
6982    
6983    (defvar org-last-level nil) ; dynamically scoped variable
6984    
6985  (defun org-export-as-ascii (arg)  (defun org-export-as-ascii (arg)
6986    "Export the outline as a pretty ASCII file.    "Export the outline as a pretty ASCII file.
6987  If there is an active region, export only the region.  If there is an active region, export only the region.
# Line 6898  underlined headlines.  The default is 3. Line 7011  underlined headlines.  The default is 3.
7011           (email       user-mail-address)           (email       user-mail-address)
7012           (language    org-export-default-language)           (language    org-export-default-language)
7013           (text        nil)           (text        nil)
          (last-level  1)  
7014           (todo nil)           (todo nil)
7015           (lang-words nil))           (lang-words nil))
7016    
7017        (setq org-last-level 1)
7018      (org-init-section-numbers)      (org-init-section-numbers)
7019    
7020      (find-file-noselect filename)      (find-file-noselect filename)
# Line 6962  underlined headlines.  The default is 3. Line 7075  underlined headlines.  The default is 3.
7075                                   (insert                                   (insert
7076                                    (make-string (* (1- level) 4) ?\ )                                    (make-string (* (1- level) 4) ?\ )
7077                                    (format (if todo "%s (*)\n" "%s\n") txt))                                    (format (if todo "%s (*)\n" "%s\n") txt))
7078                                   (setq last-level level))                                   (setq org-last-level level))
7079                               ))))                               ))))
7080                    lines)))                    lines)))
7081    
# Line 7030  underlined headlines.  The default is 3. Line 7143  underlined headlines.  The default is 3.
7143            (setq title (concat (org-section-number level) " " title)))            (setq title (concat (org-section-number level) " " title)))
7144        (insert title "\n" (make-string (string-width title) char) "\n"))))        (insert title "\n" (make-string (string-width title) char) "\n"))))
7145    
7146  (defun org-export-copy-visible (&optional arg)  (defun org-export-copy-visible ()
7147    "Copy the visible part of the buffer to another buffer, for printing.    "Copy the visible part of the buffer to another buffer, for printing.
7148  Also removes the first line of the buffer if it specifies a mode,  Also removes the first line of the buffer if it specifies a mode,
7149  and all options lines."  and all options lines."
7150    (interactive "P")    (interactive)
7151    (let* ((filename (concat (file-name-sans-extension (buffer-file-name))    (let* ((filename (concat (file-name-sans-extension (buffer-file-name))
7152                             ".txt"))                             ".txt"))
7153           (buffer (find-file-noselect filename))           (buffer (find-file-noselect filename))
# Line 7044  and all options lines." Line 7157  and all options lines."
7157                    "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))                    "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))
7158                 (if org-noutline-p "\\(\n\\|$\\)" "")))                 (if org-noutline-p "\\(\n\\|$\\)" "")))
7159           s e)           s e)
7160      (save-excursion      (with-current-buffer buffer
       (set-buffer buffer)  
7161        (erase-buffer)        (erase-buffer)
7162        (text-mode))        (text-mode))
7163      (save-excursion      (save-excursion
# Line 7174  headlines.  The default is 3.  Lower lev Line 7286  headlines.  The default is 3.  Lower lev
7286    (org-open-file (buffer-file-name)))    (org-open-file (buffer-file-name)))
7287    
7288  (defun org-export-as-html-batch ()  (defun org-export-as-html-batch ()
7289    "Call org-export-as-html, may be used in batch processing as    "Call `org-export-as-html', may be used in batch processing as
7290  emacs   --batch  emacs   --batch
7291          --load=$HOME/lib/emacs/org.el          --load=$HOME/lib/emacs/org.el
7292          --eval \"(setq org-export-headline-levels 2)\"          --eval \"(setq org-export-headline-levels 2)\"
# Line 7199  headlines.  The default is 3.  Lower lev Line 7311  headlines.  The default is 3.  Lower lev
7311            (org-skip-comments (org-split-string region "[\r\n]")))            (org-skip-comments (org-split-string region "[\r\n]")))
7312           (lines (org-export-find-first-heading-line all_lines))           (lines (org-export-find-first-heading-line all_lines))
7313           (level 0) (line "") (origline "") txt todo           (level 0) (line "") (origline "") txt todo
          (last-level 1)  
7314           (umax nil)           (umax nil)
7315           (filename (concat (file-name-sans-extension (buffer-file-name))           (filename (concat (file-name-sans-extension (buffer-file-name))
7316                             ".html"))                             ".html"))
# Line 7220  headlines.  The default is 3.  Lower lev Line 7331  headlines.  The default is 3.  Lower lev
7331           )           )
7332      (message "Exporting...")      (message "Exporting...")
7333    
7334        (setq org-last-level 1)
7335      (org-init-section-numbers)      (org-init-section-numbers)
7336    
7337      ;; Search for the export key lines      ;; Search for the export key lines
# Line 7284  headlines.  The default is 3.  Lower lev Line 7396  headlines.  The default is 3.  Lower lev
7396                               (if (<= level umax)                               (if (<= level umax)
7397                                   (progn                                   (progn
7398                                     (setq head-count (+ head-count 1))                                     (setq head-count (+ head-count 1))
7399                                     (if (> level last-level)                                     (if (> level org-last-level)
7400                                         (progn                                         (progn
7401                                           (setq cnt (- level last-level))                                           (setq cnt (- level org-last-level))
7402                                           (while (>= (setq cnt (1- cnt)) 0)                                           (while (>= (setq cnt (1- cnt)) 0)
7403                                             (insert "<ul>"))                                             (insert "<ul>"))
7404                                           (insert "\n")))                                           (insert "\n")))
7405                                     (if (< level last-level)                                     (if (< level org-last-level)
7406                                         (progn                                         (progn
7407                                           (setq cnt (- last-level level))                                           (setq cnt (- org-last-level level))
7408                                           (while (>= (setq cnt (1- cnt)) 0)                                           (while (>= (setq cnt (1- cnt)) 0)
7409                                             (insert "</ul>"))                                             (insert "</ul>"))
7410                                           (insert "\n")))                                           (insert "\n")))
# Line 7302  headlines.  The default is 3.  Lower lev Line 7414  headlines.  The default is 3.  Lower lev
7414                                           "<li><a href=\"#sec-%d\"><span style='color:red'>%s</span></a></li>\n"                                           "<li><a href=\"#sec-%d\"><span style='color:red'>%s</span></a></li>\n"
7415                                         "<li><a href=\"#sec-%d\">%s</a></li>\n")                                         "<li><a href=\"#sec-%d\">%s</a></li>\n")
7416                                       head-count txt))                                       head-count txt))
7417                                     (setq last-level level))                                     (setq org-last-level level))
7418                                 ))))                                 ))))
7419                      lines)                      lines)
7420              (while (> last-level 0)              (while (> org-last-level 0)
7421                (setq last-level (1- last-level))                (setq org-last-level (1- org-last-level))
7422                (insert "</ul>\n"))                (insert "</ul>\n"))
7423              ))              ))
7424        (setq head-count 0)        (setq head-count 0)
# Line 7537  But it has the disadvantage, that no cel Line 7649  But it has the disadvantage, that no cel
7649  This has the advantage that cell- or row-spanning is allowed.  This has the advantage that cell- or row-spanning is allowed.
7650  But it has the disadvantage, that Org-mode's HTML conversions cannot be used."  But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
7651    (require 'table)    (require 'table)
7652    (save-excursion    (with-current-buffer (get-buffer-create " org-tmp1 ")
     (set-buffer (get-buffer-create " org-tmp1 "))  
7653      (erase-buffer)      (erase-buffer)
7654      (insert (mapconcat 'identity lines "\n"))      (insert (mapconcat 'identity lines "\n"))
7655      (goto-char (point-min))      (goto-char (point-min))
7656      (if (not (re-search-forward "|[^+]" nil t))      (if (not (re-search-forward "|[^+]" nil t))
7657          (error "Error processing table."))          (error "Error processing table."))
7658      (table-recognize-table)      (table-recognize-table)
7659      (save-excursion      (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
       (set-buffer (get-buffer-create " org-tmp2 "))  
       (erase-buffer))  
7660      (table-generate-source 'html " org-tmp2 ")      (table-generate-source 'html " org-tmp2 ")
7661      (set-buffer " org-tmp2 ")      (set-buffer " org-tmp2 ")
7662      (buffer-substring (point-min) (point-max))))      (buffer-substring (point-min) (point-max))))
# Line 7711  stacked delimiters is N. Escaping delimi Line 7820  stacked delimiters is N. Escaping delimi
7820                            level head-count title level))                            level head-count title level))
7821          (insert (format "\n<H%d>%s</H%d>\n" level title level))))))          (insert (format "\n<H%d>%s</H%d>\n" level title level))))))
7822    
7823  (defun org-html-level-close (level)  (defun org-html-level-close (&rest args)
7824    "Terminate one level in HTML export."    "Terminate one level in HTML export."
7825    (insert "</ul>"))    (insert "</ul>"))
7826    
# Line 7800  When LEVEL is non-nil, increase section Line 7909  When LEVEL is non-nil, increase section
7909  (define-key org-mode-map "\C-c/"    'org-occur)   ; Minor-mode reserved  (define-key org-mode-map "\C-c/"    'org-occur)   ; Minor-mode reserved
7910  (define-key org-mode-map "\C-c\C-m" 'org-insert-heading)  (define-key org-mode-map "\C-c\C-m" 'org-insert-heading)
7911  (define-key org-mode-map "\M-\C-m"  'org-insert-heading)  (define-key org-mode-map "\M-\C-m"  'org-insert-heading)
7912    (define-key org-mode-map [(meta shift return)] 'org-insert-todo-heading)
7913  (define-key org-mode-map "\C-c\C-l" 'org-insert-link)  (define-key org-mode-map "\C-c\C-l" 'org-insert-link)
7914  (define-key org-mode-map "\C-c\C-o" 'org-open-at-point)  (define-key org-mode-map "\C-c\C-o" 'org-open-at-point)
7915  (define-key org-mode-map "\C-c\C-z" 'org-time-stamp)  ; Alternative binding  (define-key org-mode-map "\C-c\C-z" 'org-time-stamp)  ; Alternative binding
# Line 7811  When LEVEL is non-nil, increase section Line 7921  When LEVEL is non-nil, increase section
7921  (define-key org-mode-map "\C-c["    'org-add-file)  (define-key org-mode-map "\C-c["    'org-add-file)
7922  (define-key org-mode-map "\C-c]"    'org-remove-file)  (define-key org-mode-map "\C-c]"    'org-remove-file)
7923  (define-key org-mode-map "\C-c\C-r"       'org-timeline)  (define-key org-mode-map "\C-c\C-r"       'org-timeline)
 ;(define-key org-mode-map [(shift up)]     'org-timestamp-up)  
 ;(define-key org-mode-map [(shift down)]   'org-timestamp-down)  
7924  (define-key org-mode-map [(shift up)]     'org-shiftup)  (define-key org-mode-map [(shift up)]     'org-shiftup)
7925  (define-key org-mode-map [(shift down)]   'org-shiftdown)  (define-key org-mode-map [(shift down)]   'org-shiftdown)
7926  (define-key org-mode-map [(shift left)]   'org-timestamp-down-day)  (define-key org-mode-map [(shift left)]   'org-timestamp-down-day)
# Line 7864  overwritten, and the table is not marked Line 7972  overwritten, and the table is not marked
7972    (if (and (org-table-p)    (if (and (org-table-p)
7973             (eq N 1)             (eq N 1)
7974             (looking-at "[^|\n]*  +|"))             (looking-at "[^|\n]*  +|"))
7975        (let (org-table-may-need-update (pos (point)))        (let (org-table-may-need-update)
7976          (goto-char (1- (match-end 0)))          (goto-char (1- (match-end 0)))
7977          (delete-backward-char 1)          (delete-backward-char 1)
7978          (goto-char (match-beginning 0))          (goto-char (match-beginning 0))
# Line 7935  a reduced column width." Line 8043  a reduced column width."
8043     ((org-at-table-p) (org-table-previous-field))     ((org-at-table-p) (org-table-previous-field))
8044     (t (org-cycle '(4)))))     (t (org-cycle '(4)))))
8045    
8046  (defun org-shiftmetaleft (&optional arg)  (defun org-shiftmetaleft ()
8047    "Call `org-promote-subtree' or `org-table-delete-column'."    "Call `org-promote-subtree' or `org-table-delete-column'."
8048    (interactive "P")    (interactive)
8049    (cond    (cond
8050     ((org-at-table-p) (org-table-delete-column arg))     ((org-at-table-p) (org-table-delete-column))
8051     ((org-on-heading-p) (org-promote-subtree arg))     ((org-on-heading-p) (org-promote-subtree))
8052     (t (org-shiftcursor-error))))     (t (org-shiftcursor-error))))
8053  (defun org-shiftmetaright (&optional arg)  
8054    (defun org-shiftmetaright ()
8055    "Call `org-demote-subtree' or `org-table-insert-column'."    "Call `org-demote-subtree' or `org-table-insert-column'."
8056    (interactive "P")    (interactive)
8057    (cond    (cond
8058     ((org-at-table-p) (org-table-insert-column arg))     ((org-at-table-p) (org-table-insert-column))
8059     ((org-on-heading-p) (org-demote-subtree arg))     ((org-on-heading-p) (org-demote-subtree))
8060     (t (org-shiftcursor-error))))     (t (org-shiftcursor-error))))
8061    
8062  (defun org-shiftmetaup (&optional arg)  (defun org-shiftmetaup (&optional arg)
8063    "Call `org-move-subtree-up' or `org-table-kill-row'."    "Call `org-move-subtree-up' or `org-table-kill-row'."
8064    (interactive "P")    (interactive "P")
8065    (cond    (cond
8066     ((org-at-table-p) (org-table-kill-row arg))     ((org-at-table-p) (org-table-kill-row))
8067     ((org-on-heading-p) (org-move-subtree-up arg))     ((org-on-heading-p) (org-move-subtree-up arg))
8068     (t (org-shiftcursor-error))))     (t (org-shiftcursor-error))))
8069  (defun org-shiftmetadown (&optional arg)  (defun org-shiftmetadown (&optional arg)
# Line 7969  a reduced column width." Line 8079  a reduced column width."
8079    (interactive "P")    (interactive "P")
8080    (cond    (cond
8081     ((org-at-table-p) (org-table-move-column 'left))     ((org-at-table-p) (org-table-move-column 'left))
8082     ((or (org-on-heading-p) (org-region-active-p)) (org-do-promote arg))     ((or (org-on-heading-p) (org-region-active-p)) (org-do-promote))
8083     (t (backward-word (prefix-numeric-value arg)))))     (t (backward-word (prefix-numeric-value arg)))))
8084    
8085  (defun org-metaright (&optional arg)  (defun org-metaright (&optional arg)
8086    "Call `org-do-demote' or `org-table-move-column' to right."    "Call `org-do-demote' or `org-table-move-column' to right."
8087    (interactive "P")    (interactive "P")
8088    (cond    (cond
8089     ((org-at-table-p) (org-table-move-column nil))     ((org-at-table-p) (org-table-move-column nil))
8090     ((or (org-on-heading-p) (org-region-active-p)) (org-do-demote arg))     ((or (org-on-heading-p) (org-region-active-p)) (org-do-demote))
8091     (t (forward-word (prefix-numeric-value arg)))))     (t (forward-word (prefix-numeric-value arg)))))
8092    
8093  (defun org-metaup (&optional arg)  (defun org-metaup (&optional arg)
8094    "Call `org-move-subtree-up' or `org-table-move-row' up."    "Call `org-move-subtree-up' or `org-table-move-row' up."
8095    (interactive "P")    (interactive "P")
# Line 7985  a reduced column width." Line 8097  a reduced column width."
8097     ((org-at-table-p) (org-table-move-row 'up))     ((org-at-table-p) (org-table-move-row 'up))
8098     ((org-on-heading-p) (org-move-subtree-up arg))     ((org-on-heading-p) (org-move-subtree-up arg))
8099     (t (org-shiftcursor-error))))     (t (org-shiftcursor-error))))
8100    
8101  (defun org-metadown (&optional arg)  (defun org-metadown (&optional arg)
8102    "Call `org-move-subtree-down' or `org-table-move-row' down."    "Call `org-move-subtree-down' or `org-table-move-row' down."
8103    (interactive "P")    (interactive "P")
# Line 8007  a reduced column width." Line 8120  a reduced column width."
8120     ((org-at-timestamp-p) (org-timestamp-down arg))     ((org-at-timestamp-p) (org-timestamp-down arg))
8121     (t (org-priority-down))))     (t (org-priority-down))))
8122    
8123  (defun org-copy-special (arg)  (defun org-copy-special ()
8124    "Call either `org-table-copy' or `org-copy-subtree'."    "Call either `org-table-copy' or `org-copy-subtree'."
8125    (interactive "P")    (interactive)
8126    (if (org-at-table-p)    (if (org-at-table-p)
8127        (org-table-copy-region arg)        (org-table-copy-region)
8128      (org-copy-subtree arg)))      (org-copy-subtree)))
8129    
8130  (defun org-cut-special (arg)  (defun org-cut-special ()
8131    "Call either `org-table-copy' or `org-copy-subtree'."    "Call either `org-table-copy' or `org-cut-subtree'."
8132    (interactive "P")    (interactive)
8133    (if (org-at-table-p)    (if (org-at-table-p)
8134        (org-table-cut-region arg)        (org-table-cut-region)
8135      (org-cut-subtree arg)))      (org-cut-subtree)))
8136    
8137  (defun org-paste-special (arg)  (defun org-paste-special (arg)
8138    "Call either `org-table-paste-rectangle' or `org-paste-subtree'."    "Call either `org-table-paste-rectangle' or `org-paste-subtree'."
8139    (interactive "P")    (interactive "P")
8140    (if (org-at-table-p)    (if (org-at-table-p)
8141        (org-table-paste-rectangle arg)        (org-table-paste-rectangle)
8142      (org-paste-subtree arg)))      (org-paste-subtree arg)))
8143    
8144  (defun org-ctrl-c-ctrl-c (&optional arg)  (defun org-ctrl-c-ctrl-c (&optional arg)
# Line 8040  the automatic table editor has been turn Line 8153  the automatic table editor has been turn
8153       ((org-at-table.el-p)       ((org-at-table.el-p)
8154        (require 'table)        (require 'table)
8155        (beginning-of-line 1)        (beginning-of-line 1)
8156        (re-search-forward "|" (save-excursion (end-of-line 2) (point)))        (re-search-forward "|" (save-excursion (end-of-line 2) (point))) ;FIXME: line-end-position?
8157        (table-recognize-table))        (table-recognize-table))
8158       ((org-at-table-p)       ((org-at-table-p)
8159        (org-table-align))        (org-table-align))
8160       ((save-excursion (beginning-of-line 1) (looking-at "#\\+[A-Z]+"))       ((save-excursion (beginning-of-line 1) (looking-at "#\\+[A-Z]+"))
8161        (let (org-inhibit-startup) (org-mode)))        (let ((org-inhibit-startup t)) (org-mode)))
8162       ((org-region-active-p)       ((org-region-active-p)
8163        (org-table-convert-region (region-beginning) (region-end) arg))        (org-table-convert-region (region-beginning) (region-end) arg))
8164       ((and (region-beginning) (region-end))       ((and (region-beginning) (region-end))
# Line 8054  the automatic table editor has been turn Line 8167  the automatic table editor has been turn
8167          (error "Abort")))          (error "Abort")))
8168       (t (error "No table at point, and no region to make one.")))))       (t (error "No table at point, and no region to make one.")))))
8169    
8170  (defun org-return (&optional arg)  (defun org-return ()
8171    "Call `org-table-next-row' or `newline'."    "Call `org-table-next-row' or `newline'."
8172    (interactive "P")    (interactive)
8173    (cond    (cond
8174     ((org-at-table-p)     ((org-at-table-p)
8175      (org-table-justify-field-maybe)      (org-table-justify-field-maybe)
# Line 8069  the automatic table editor has been turn Line 8182  the automatic table editor has been turn
8182    (cond    (cond
8183     ((org-at-table-p)     ((org-at-table-p)
8184      (org-table-wrap-region arg))      (org-table-wrap-region arg))
8185     (t (org-insert-heading arg))))     (t (org-insert-heading))))
8186    
8187  ;;; Menu entries  ;;; Menu entries
8188    
# Line 8256  With optional NODE, go directly to that Line 8369  With optional NODE, go directly to that
8369  ;;; Miscellaneous stuff  ;;; Miscellaneous stuff
8370    
8371  (defun org-move-line-down (arg)  (defun org-move-line-down (arg)
8372    "Move the current line up."    "Move the current line down.  With prefix argument, move it past ARG lines."
8373    (interactive "p")    (interactive "p")
8374    (let ((col (current-column))    (let ((col (current-column))
8375          beg end pos)          beg end pos)
# Line 8269  With optional NODE, go directly to that Line 8382  With optional NODE, go directly to that
8382      (move-to-column col)))      (move-to-column col)))
8383    
8384  (defun org-move-line-up (arg)  (defun org-move-line-up (arg)
8385    "Move the current line up."    "Move the current line up.  With prefix argument, move it past ARG lines."
8386    (interactive "p")    (interactive "p")
8387    (let ((col (current-column))    (let ((col (current-column))
8388          beg end pos)          beg end pos)
8389      (beginning-of-line 1) (setq beg (point))      (beginning-of-line 1) (setq beg (point))
8390      (beginning-of-line 2) (setq end (point))      (beginning-of-line 2) (setq end (point))
8391      (beginning-of-line (+ -2 arg))      (beginning-of-line (- arg))
8392      (setq pos (move-marker (make-marker) (point)))      (setq pos (move-marker (make-marker) (point)))
8393      (insert (delete-and-extract-region beg end))      (insert (delete-and-extract-region beg end))
8394      (goto-char pos)      (goto-char pos)
# Line 8284  With optional NODE, go directly to that Line 8397  With optional NODE, go directly to that
8397  ;; Functions needed for Emacs/XEmacs region compatibility  ;; Functions needed for Emacs/XEmacs region compatibility
8398    
8399  (defun org-region-active-p ()  (defun org-region-active-p ()
8400    "Is transient-mark-mode on and the region active?    "Is `transient-mark-mode' on and the region active?
8401  Works on both Emacs and XEmacs."  Works on both Emacs and XEmacs."
8402    (if org-ignore-region    (if org-ignore-region
8403        nil        nil
# Line 8403  If INVISIBLE-OK is non-nil, an invisible Line 8516  If INVISIBLE-OK is non-nil, an invisible
8516  This function considers both visible and invisible heading lines.  This function considers both visible and invisible heading lines.
8517  With argument, move up ARG levels."  With argument, move up ARG levels."
8518    (if org-noutline-p    (if org-noutline-p
8519        (outline-up-heading arg t)        (if (fboundp 'outline-up-heading-all)
8520              (outline-up-heading-all arg)   ; emacs 21 version of outline.el
8521            (outline-up-heading arg t))      ; emacs 22 version of outline.el
8522      (org-back-to-heading t)      (org-back-to-heading t)
8523      (looking-at outline-regexp)      (looking-at outline-regexp)
8524      (if (<= (- (match-end 0) (match-beginning 0)) arg)      (if (<= (- (match-end 0) (match-beginning 0)) arg)
# Line 8422  With argument, move up ARG levels." Line 8537  With argument, move up ARG levels."
8537          (progn          (progn
8538            (org-back-to-heading t)            (org-back-to-heading t)
8539            (org-flag-heading nil)))            (org-flag-heading nil)))
8540      (show-entry)))      (org-show-entry)))
8541    
8542  (defun org-check-occur-regexp (regexp)  (defun org-check-occur-regexp (regexp)
8543    "If REGEXP starts with \"^\", modify it to check for \\r as well.    "If REGEXP starts with \"^\", modify it to check for \\r as well.
# Line 8444  When ENTRY is non-nil, show the entire e Line 8559  When ENTRY is non-nil, show the entire e
8559      ;; Check if we should show the entire entry      ;; Check if we should show the entire entry
8560      (if entry      (if entry
8561          (progn          (progn
8562            (show-entry)            (org-show-entry)
8563            (save-excursion  ;; FIXME: Is this the fix for points in the   -|            (save-excursion  ;; FIXME: Is this the fix for points in the   -|
8564                             ;;        middle of text?                      |                             ;;        middle of text?                      |
8565              (and (outline-next-heading)   ;;                              |              (and (outline-next-heading)   ;;                              |
# Line 8455  When ENTRY is non-nil, show the entire e Line 8570  When ENTRY is non-nil, show the entire e
8570                                 flag                                 flag
8571                               (if flag ?\r ?\n))))))                               (if flag ?\r ?\n))))))
8572    
8573    (defun org-show-subtree ()
8574      "Show everything after this heading at deeper levels."
8575      (outline-flag-region
8576       (point)
8577       (save-excursion
8578         (outline-end-of-subtree) (outline-next-heading) (point))
8579       (if org-noutline-p nil ?\n)))
8580    
8581    (defun org-show-entry ()
8582      "Show the body directly following this heading.
8583    Show the heading too, if it is currently invisible."
8584      (interactive)
8585      (save-excursion
8586        (org-back-to-heading t)
8587        (outline-flag-region
8588         (1- (point))
8589         (save-excursion
8590           (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move)
8591           (or (match-beginning 1) (point-max)))
8592         (if org-noutline-p nil ?\n))))
8593    
8594    
8595  (defun org-make-options-regexp (kwds)  (defun org-make-options-regexp (kwds)
8596    "Make a regular expression for keyword lines."    "Make a regular expression for keyword lines."
8597    (concat    (concat

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26