emacs: lisp/textmodes/org.el comparison

comparison lisp/textmodes/org.el @ 62546:153ddc124932

(org-agenda-toggle-time-grid): New command. (org-agenda-use-time-grid, org-agenda-time-grid): New options. (org-agenda-add-time-grid-maybe): New function. (org-agenda): Call `org-agenda-add-time-grid-maybe'. (org-table-create): `dotimes' instead of `mapcar'. (org-xor): Simplified implementation. (org-agenda): `inhibit-redisplay' turned on. (org-agenda-change-all-lines): Use `org-format-agenda-item' to get a consistent line after a state change. (org-agenda-remove-times-when-in-prefix): New option. (org-prefix-has-time): New variable. (org-parse-time-string): Optional argument NODEFAULT. (org-format-agenda-item): Parse items for time-of-day specifications and move these into the prefix if possible. (org-agenda-priority): Get current heading, not previous heading during agenda remote editing.

author	Carsten Dominik <dominik@science.uva.nl>
date	Fri, 20 May 2005 11:24:48 +0000
parents	fab4f3bb60e0
children	b9935dc86aa4 5b029ff3b08d

comparison

equal deleted inserted replaced

-:bea5728f69fa
+:153ddc124932
 ;; Copyright (c) 2004, 2005 Free Software Foundation
 ;;
 ;; Author: Carsten Dominik <dominik at science dot uva dot nl>
 ;; Keywords: outlines, hypermedia, calendar
 ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
-;; Version: 3.08
+;; Version: 3.09
 ;;
 ;; This file is part of GNU Emacs.
 ;;
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;;
 ;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing
 ;; project planning with a fast and effective plain-text system.
 ;;
 ;; Org-mode develops organizational tasks around a NOTES file that contains
-;; information about projects as plain text.  Org-mode is implemented on
+;; information about projects as plain text.  Org-mode is implemented on top
-;; top of outline-mode - ideal to keep the content of large files well
+;; of outline-mode - ideal to keep the content of large files well structured.
-;; structured.  It supports ToDo items, deadlines and time stamps, which
+;; It supports ToDo items, deadlines and time stamps, which can be extracted
-;; magically appear in the diary listing of the Emacs calendar.  Tables are
+;; to create a daily/weekly agenda that also integrates the diary of the Emacs
-;; easily created with a built-in table editor.  Plain text URL-like links
+;; calendar.  Tables are easily created with a built-in table editor.  Plain
-;; connect to websites, emails (VM,RMAIL,WANDERLUST), Usenet messages (Gnus),
+;; text URL-like links connect to websites, emails (VM, RMAIL, WANDERLUST),
-;; BBDB entries, and any files related to the projects.  For printing and
+;; Usenet messages (Gnus), BBDB entries, and any files related to the
-;; sharing of notes, an Org-mode file (or a part of it) can be exported as
+;; projects.  For printing and sharing of notes, an Org-mode file (or a part
-;; a structured ASCII file, or as HTML.
+;; of it) can be exported as a structured ASCII file, or as HTML.
 ;;
 ;; Installation
 ;; ------------
-;; The instruction below assume that you have downloaded Org-mode from the
+;; If Org-mode is part of the Emacs distribution or an XEmacs package, you
-;; web.  If Org-mode is part of the Emacs distribution or an XEmacs package,
+;; only need to copy the following lines to your .emacs file.  The last two
-;; you only need to add to .emacs the last three lines of Lisp code listed
+;; lines define *global* keys for the commands `org-store-link' and
-;; below, i.e. the `auto-mode-alist' modification and the global key bindings.
+;; `org-agenda' - please choose suitable keys yourself.
 ;;
-;; Byte-compile org.el and put it on your load path.  Then copy the
+;;    (add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
-;; following lines into .emacs.  The last two lines define *global*
+;;    (define-key global-map "\C-cl" 'org-store-link)
-;; keys for the commands `org-store-link' and `org-agenda' - please
+;;    (define-key global-map "\C-ca" 'org-agenda)
-;; choose suitable keys yourself.
+;;
+;; If you have downloaded Org-mode from the Web, you must byte-compile
+;; org.el and put it on your load path.  In addition to the Emacs Lisp
+;; lines above, you also need to add the following lines to .emacs:
 ;;
 ;;    (autoload 'org-mode "org" "Org mode" t)
 ;;    (autoload 'org-diary "org" "Diary entries from Org mode")
 ;;    (autoload 'org-agenda "org" "Multi-file agenda from Org mode" t)
 ;;    (autoload 'org-store-link "org" "Store a link to the current location" t)
 ;;    (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t)
 ;;    (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode")
-;;    (add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
-;;    (define-key global-map "\C-cl" 'org-store-link)
-;;    (define-key global-map "\C-ca" 'org-agenda)
 ;;
-;; This will put all files with extension ".org" into Org-mode.  As an
+;; This setup will put all files with extension ".org" into Org-mode.  As
-;; alternative, make the first line of a file look like this:
+;; an alternative, make the first line of a file look like this:
 ;;
 ;;     MY PROJECTS    -*- mode: org; -*-
 ;;
 ;; which will select Org-mode for this buffer no matter what the file's
 ;; name is.
 ;;
 ;; Documentation
 ;; -------------
-;; The documentation of Org-mode can be found in the TeXInfo file.
+;; The documentation of Org-mode can be found in the TeXInfo file.  The
-;; The distribution also contains a PDF version of it.  At the homepage
+;; distribution also contains a PDF version of it.  At the homepage of
-;; of Org-mode, you can read the same text online as HTML.
+;; Org-mode, you can read the same text online as HTML.  There is also an
+;; excellent reference card made by Philip Rooke.
 ;;
 ;; Changes:
 ;; -------
+;; Version 3.09
+;;    - Time-of-day specifications in agenda are extracted and placed
+;;      into the prefix.  Timed entries can be placed into a time grid for
+;;      day.
+;;
 ;; Version 3.08
 ;;    - "|" no longer allowed as part of a link, to allow links in tables.
 ;;    - The prefix of items in the agenda buffer can be configured.
 ;;    - Cleanup.
 ;;
 ;;    - New reference card, thanks to Philip Rooke for creating it.
 ;;    - Single file agenda renamed to "Timeline".  It no longer shows
 ;;      warnings about upcoming deadlines/overdue scheduled items.
 ;;      That functionality is now limited to the (multifile) agenda.
 ;;    - When reading a date, the calendar can be manipulated with keys.
-;;    - Link support for RMAIL and Wanderlust (from planner.el, untested)
+;;    - Link support for RMAIL and Wanderlust (from planner.el, untested).
 ;;    - Minor bug fixes and documentation improvements.
 ;;; Code:
 (eval-when-compile (require 'cl) (require 'calendar))
 (require 'time-date)
 (require 'easymenu)
 ;;; Customization variables
-(defvar org-version "3.08"
+(defvar org-version "3.09"
 "The version number of the file org.el.")
 (defun org-version ()
 (interactive)
 (message "Org-mode version %s" org-version))
-;; The following two constants are for compatibility with different
+;; The following two constants are for compatibility with different Emacs
-;; Emacs versions (Emacs versus XEmacs) and with different versions of
+;; versions (Emacs versus XEmacs) and with different versions of outline.el.
-;; outline.el.  All the compatibility code in org.el is based on these two
+;; The compatibility code in org.el is based on these two constants.
-;; constants.
 (defconst org-xemacs-p (featurep 'xemacs)
 "Are we running xemacs?")
 (defconst org-noutline-p (featurep 'noutline)
 "Are we using the new outline mode?")
 agenda listing for the day.  Of the entries without a time indication, keep
 the grouped in categories, don't sort the categories, but keep them in
 the sequence given in `org-agenda-files'.  Within each category sort by
 priority.
-Leaving out the `category-keep' would mean that items will be sorted across
+Leaving out `category-keep' would mean that items will be sorted across
 categories by priority."
 :group 'org-agenda
 :type '(repeat
 (choice
 (const time-up)
 (const category-up)
 (const category-down)
 (const priority-up)
 (const priority-down))))
-(defcustom org-agenda-prefix-format "  %-12:c% s"
+(defcustom org-agenda-prefix-format "  %-12:c%?-12t% s"
 "Format specification for the prefix of items in the agenda buffer.
 This format works similar to a printf format, with the following meaning:
 %c   the category of the item, \"Diary\" for entries from the diary, or
 as given by the CATEGORY keyword or derived from the file name.
 %t   the time-of-day specification if one applies to the entry, in the
 format HH:MM
 %s   Scheduling/Deadline information, a short string
-In addition to the normal printf field modifiers like field width and
+All specifiers work basically like the standard `%s' of printf, but may
-padding instructions, in this format you can also add an additional
+contain two additional characters:  A question mark just after the `%' and
-punctuation or whitespace character just before the final format letter.
+a whitespace/punctuation character just before the final letter.
-This character will be appended to the field value if the value is not
-empty.  For example, the format \"%-12:c\" leads to \"Diary:    \" if
+If the first character after `%' is a question mark, the entire field
-the category is \"Diary\".  If the category were be empty, no additional
+will only be included if the corresponding value applies to the
-colon would be interted.
+current entry.  This is useful for fields which should have fixed
+width when present, but zero width when absent.  For example,
-Including `%t' in the format string leads to a double time specification
+\"%?-12t\" will result in a 12 character time field if a time of the
-because the headline/diary item will contain the time specification as
+day is specified, but will completely disappear in entries which do
-well.  However, using `%t' in the format will result in a canonical 24
+not contain a time.
-hour time specification at a consistent position in the prefix, while the
-time specification in the headline/diary item may be at any position and in
+If there is punctuation or whitespace character just before the final
-various formats.
+format letter, this character will be appended to the field value if
-Example:
+the value is not empty.  For example, the format \"%-12:c\" leads to
-(setq org-agenda-prefix-format \"  %-12:c% t% s\")"
+\"Diary: \" if the category is \"Diary\".  If the category were be
+empty, no additional colon would be interted.
+The default value of this option is \"  %-12:c%?-12t% s\", meaning:
+- Indent the line with two space characters
+- Give the category in a 12 chars wide field, padded with whitespace on
+the right (because of `-').  Append a colon if there is a category
+(because of `:').
+- If there is a time-of-day, put it into a 12 chars wide field.  If no
+time, don't put in an empty field, just skip it (because of '?').
+- Finally, put the scheduling information and append a whitespace.
+As another example, if you don't want the time-of-day of entries in
+the prefix, you could use:
+(setq org-agenda-prefix-format \"  %-11:c% s\")
+See also the variable `org-agenda-remove-times-when-in-prefix'."
 :type 'string
 :group 'org-agenda)
 (defcustom org-timeline-prefix-format "  % s"
 "Like `org-agenda-prefix-format', but for the timeline of a single file."
 :type 'string
 :group 'org-agenda)
 (defvar org-prefix-format-compiled nil
-"The compiled version of `org-???-prefix-format'.")
+"The compiled version of the most recently used prefix format.
+Depending on which command was used last, this may be the compiled version
+of `org-agenda-prefix-format' or `org-timeline-prefix-format'.")
+(defcustom org-agenda-use-time-grid t
+"Non-nil means, show a time grid in the agenda schedule.
+A time grid is a set of lines for specific times (like every two hours between
+8:00 and 20:00.  The items scheduled for a day at specific times are
+sorted in between these lines.
+For deails about when the grid will be shown, and what it will look like, see
+the variable `org-agenda-time-grid'."
+:group 'org-agenda
+:type 'boolean)
+(defcustom org-agenda-time-grid
+'((daily today require-timed)
+"----------------"
+(800 1000 1200 1400 1600 1800 2000))
+"FIXME: document"
+:group 'org-agenda
+:type
+'(list
+(set :greedy t :tag "Grid Display Options"
+(const :tag "Show grid in single day agenda display" daily)
+(const :tag "Show grid in weekly agenda display" weekly)
+(const :tag "Always show grid for today" today)
+(const :tag "Show grid only if any timed entries are present"
+require-timed)
+(const :tag "Skip grid times already present in an entry"
+remove-match))
+(string :tag "Grid String")
+(repeat :tag "Grid Times" (integer :tag "Time"))))
+(defcustom org-agenda-remove-times-when-in-prefix t
+"Non-nil means, remove duplicate time specifications in agenda items.
+When the format `org-agenda-prefix-format' contains a `%t' specifier, a
+time-of-day specification in a headline or diary entry is extracted and
+placed into the prefix.  If this option is non-nil, the original specification
+\(a timestamp or -range, or just a plain time(range) specification like
+11:30-4pm) will be removed for agenda display.  This makes the agenda less
+cluttered.
+The option can be t or nil.  It may also be the symbol `beg', indicating
+that the time should only be removed what it is located at the beginning of
+the headline/diary entry."
+:group 'org-agenda
+:type '(choice
+(const :tag "Always" t)
+(const :tag "Never" nil)
+(const :tag "When at beginning of entry" beg)))
 (defcustom org-sort-agenda-notime-is-late t
 "Non-nil means, items without time are considered late.
 This is only relevant for sorting.  When t, items which have no explicit
 time like 15:30 will be considered as 24:01, i.e. later than any items which
-do have a time.  When nil, the default time is before 0:00."
+do have a time.  When nil, the default time is before 0:00.  You can use this
+option to decide if the schedule for today should come before or after timeless
+agenda entries."
 :group 'org-agenda
 :type 'boolean)
 (defgroup org-structure nil
 "Options concerning structure editing in Org-mode."
 '((((type tty) (class color)) (:foreground "blue" :weight bold))
 (((class color) (background light)) (:foreground "Blue"))
 (((class color) (background dark)) (:foreground "LightSkyBlue"))
 (t (:inverse-video t :bold t)))
 "Face used for tables."
+:group 'org-faces)
+(defface org-time-grid-face ;; font-lock-variable-name-face
+'((((type tty) (class color)) (:foreground "yellow" :weight light))
+(((class color) (background light)) (:foreground "DarkGoldenrod"))
+(((class color) (background dark)) (:foreground "LightGoldenrod"))
+(t (:bold t :italic t)))
+"Face used for level 2 headlines."
 :group 'org-faces)
 (defvar org-level-faces
 '(
 org-level-1-face
 (interactive-p)
 (= (point-min) (point-max))))
 (save-excursion
 (goto-char (point-min))
 (insert "    -*- mode: org -*-\n\n")))
-(run-hooks 'org-mode-hook)       ;FIXME: Should be run-mode-hooks.
+(run-hooks 'org-mode-hook)
 (unless org-inhibit-startup
 (if org-startup-with-deadline-check
 (call-interactively 'org-check-deadlines)
 (cond
 ((eq org-startup-folded t)
 (defun org-font-lock-level ()
 (save-excursion
 (org-back-to-heading t)
 (- (match-end 0) (match-beginning 0))))
 (defvar org-font-lock-keywords nil)
 (defun org-set-font-lock-defaults ()
 (let ((org-font-lock-extra-keywords
 (list
 (apply 'format fmt (nreverse l))))
 (defun org-time-string-to-time (s)
 (apply 'encode-time (org-parse-time-string s)))
-(defun org-parse-time-string (s)
+(defun org-parse-time-string (s &optional nodefault)
 "Parse the standard Org-mode time string.
-This should be a lot faster than the normal `parse-time-string'."
+This should be a lot faster than the normal `parse-time-string'.
+If time is not given, defaults to 0:00.  However, with optional NODEFAULT,
+hour and minute fields will be nil if not given."
 (if (string-match org-ts-regexp1 s)
 (list 0
-(string-to-number (or (match-string 8 s) "0"))
+(if (or (match-beginning 8) (not nodefault))
-(string-to-number (or (match-string 7 s) "0"))
+(string-to-number (or (match-string 8 s) "0")))
+(if (or (match-beginning 7) (not nodefault))
+(string-to-number (or (match-string 7 s) "0")))
 (string-to-number (match-string 4 s))
 (string-to-number (match-string 3 s))
 (string-to-number (match-string 2 s))
 nil nil nil)
 (make-list 9 0)))
 (while l (define-key org-agenda-mode-map
 (int-to-string (pop l)) 'digit-argument)))
 (define-key org-agenda-mode-map "f" 'org-agenda-follow-mode)
 (define-key org-agenda-mode-map "d" 'org-agenda-toggle-diary)
+(define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid)
 (define-key org-agenda-mode-map "r" 'org-agenda-redo)
 (define-key org-agenda-mode-map "q" 'org-agenda-quit)
 (define-key org-agenda-mode-map "x" 'org-agenda-exit)
 (define-key org-agenda-mode-map "P" 'org-agenda-show-priority)
 (define-key org-agenda-mode-map "n" 'next-line)
 ["Set Priority" org-agenda-priority t]
 ["Increase Priority" org-agenda-priority-up t]
 ["Decrease Priority" org-agenda-priority-down t]
 ["Show Priority" org-agenda-show-priority t])
 "--"
-["Rebuild" org-agenda-redo t]
+["Rebuild buffer" org-agenda-redo t]
 ["Goto Today" org-agenda-goto-today t]
 ["Next Dates" org-agenda-later (local-variable-p 'starting-day)]
 ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)]
 "--"
 ["Week/Day View" org-agenda-toggle-week-view
 (local-variable-p 'starting-day)]
 ["Include Diary" org-agenda-toggle-diary
 :style toggle :selected org-agenda-include-diary :active t]
+["Use Time Grid" org-agenda-toggle-time-grid
+:style toggle :selected org-agenda-use-time-grid :active t]
 "--"
 ["New Diary Entry" org-agenda-diary-entry t]
 ("Calendar Commands"
 ["Goto Calendar" org-agenda-goto-calendar t]
 ["Phases of the Moon" org-agenda-phases-of-moon t]
 (calendar-gregorian-from-absolute sd)))
 (n1 org-agenda-start-on-weekday)
 (d (- nt n1)))
 (- sd (+ (if (< d 0) 7 0) d)))))
 (day-numbers (list start))
-s e rtn rtnall file date d start-pos end-pos)
+(inhibit-redisplay t)
+s e rtn rtnall file date d start-pos end-pos todayp nd)
 (setq org-agenda-redo-command
 (list 'org-agenda include-all start-day ndays))
 ;; Make the list of days
-(setq ndays (or ndays org-agenda-ndays))
+(setq ndays (or ndays org-agenda-ndays)
+nd ndays)
 (while (> ndays 1)
 (push (1+ (car day-numbers)) day-numbers)
 (setq ndays (1- ndays)))
 (setq day-numbers (nreverse day-numbers))
 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name)))
 (org-check-agenda-file file)
 (setq date (calendar-gregorian-from-absolute today)
 rtn (org-agenda-get-day-entries
 file date :todo))
 (setq rtnall (append rtnall rtn))))
-(if rtnall (insert (org-finalize-agenda-entries rtnall) "\n")))
+(when rtnall
+(insert "ALL CURRENTLY OPEN TODO ITEMS:\n")
+(add-text-properties (point-min) (1- (point))
+(list 'face 'org-link-face))
+(insert (org-finalize-agenda-entries rtnall) "\n")))
 (while (setq d (pop day-numbers))
 (setq date (calendar-gregorian-from-absolute d)
 s (point))
-(if (or (= d today)
+(if (or (setq todayp (= d today))
 (and (not start-pos) (= d sd)))
 (setq start-pos (point))
 (if (and start-pos (not end-pos))
 (setq end-pos (point))))
 (setq files org-agenda-files
 (require 'diary-lib)
 (setq rtn (org-get-entries-from-diary date))
 (setq rtnall (append rtnall rtn))))
 (if (or rtnall org-agenda-show-all-dates)
 (progn
-(insert (format "%-9s %2d %-9s %4d\n"
+(insert (format "%-9s %2d %s %4d\n"
 (calendar-day-name date)
 (extract-calendar-day date)
 (calendar-month-name (extract-calendar-month date))
 (extract-calendar-year date)))
 (put-text-property s (1- (point)) 'face
 'org-link-face)
-(if rtnall (insert (org-finalize-agenda-entries rtnall) "\n"))
+(if rtnall (insert
+(org-finalize-agenda-entries ;; FIXME: condition needed
+(org-agenda-add-time-grid-maybe
+rtnall nd todayp))
+"\n"))
 (put-text-property s (1- (point)) 'day d))))
 (goto-char (point-min))
 (setq buffer-read-only t)
 (if org-fit-agenda-window
 (fit-window-to-buffer nil (/ (* (frame-height) 3) 4)
 (org-agenda-redo)
 (org-agenda-set-mode-name)
 (message "Diary inclusion turned %s"
 (if org-agenda-include-diary "on" "off")))
+(defun org-agenda-toggle-time-grid ()
+"Toggle follow mode in an agenda buffer."
+(interactive)
+(setq org-agenda-use-time-grid (not org-agenda-use-time-grid))
+(org-agenda-redo)
+(org-agenda-set-mode-name)
+(message "Time-grid turned %s"
+(if org-agenda-use-time-grid "on" "off")))
 (defun org-agenda-set-mode-name ()
 "Set the mode name to indicate all the small mode settings."
 (setq mode-name
 (concat "Org-Agenda"
 (if (equal org-agenda-ndays 1) " Day"    "")
 (if (equal org-agenda-ndays 7) " Week"   "")
 (if org-agenda-follow-mode     " Follow" "")
-(if org-agenda-include-diary   " Diary"  "")))
+(if org-agenda-include-diary   " Diary"  "")
+(if org-agenda-use-time-grid   " Grid"   "")))
 (force-mode-line-update))
 (defun org-agenda-post-command-hook ()
 (and (eolp) (not (bolp)) (backward-char 1))
 (if (and org-agenda-follow-mode
 (defun org-get-entries-from-diary (date)
 "Get the (Emacs Calendar) diary entries for DATE."
 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")
 (diary-display-hook '(fancy-diary-display))
 (list-diary-entries-hook
 (cons 'org-diary-default-entry list-diary-entries-hook))
 entries
 (org-disable-diary t))
 (save-excursion
 (save-window-excursion
 (when entries
 (setq entries (org-split-string entries "\n"))
 (setq entries
 (mapcar
 (lambda (x)
-(setq x (org-format-agenda-item "" x "Diary"))
+(setq x (org-format-agenda-item "" x "Diary" 'time))
 ;; Extend the text properties to the beginning of the line
 (add-text-properties
 0 (length x)
 (text-properties-at (1- (length x)) x)
 x)
 (org-get-agenda-file-buffer file)
 (error "No such file %s" file)))
 arg results rtn)
 (if (not buffer)
 ;; If file does not exist, make sure an error message ends up in diary
-(format "ORG-AGENDA-ERROR: No such org-file %s" file)
+(list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
 (with-current-buffer buffer
 (unless (eq major-mode 'org-mode)
 (error "Agenda file %s is not in `org-mode'" file))
 (let ((case-fold-search nil))
 (save-excursion
 (setq rtn (org-agenda-get-scheduled))
 (setq results (append results rtn)))
 ((and (eq arg :deadline)
 (equal date (calendar-current-date)))
 (setq rtn (org-agenda-get-deadlines))
-(setq results (append results rtn))))))))))
+(setq results (append results rtn))))))))
-results))
+results))))
 (defun org-entry-is-done-p ()
 "Is the current entry marked DONE?"
 (save-excursion
 (and (re-search-backward "[\r\n]\\*" nil t)
 (car org-time-stamp-formats)
 (apply 'encode-time  ; DATE bound by calendar
 (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
 0 11)))
 marker hdmarker deadlinep scheduledp donep tmp priority
-ee txt)
+ee txt timestr)
 (goto-char (point-min))
 (while (re-search-forward regexp nil t)
 (if (not (save-match-data (org-at-date-range-p)))
 (progn
 (setq marker (org-agenda-new-marker (match-beginning 0))
 tmp (buffer-substring (max (point-min)
 (- (match-beginning 0)
 org-ds-keyword-length))
 (match-beginning 0))
+timestr (buffer-substring (match-beginning 0) (point-at-eol))
 deadlinep (string-match org-deadline-regexp tmp)
 scheduledp (string-match org-scheduled-regexp tmp)
 donep (org-entry-is-done-p))
+(if (string-match ">" timestr)
+;; substring should only run to end of time stamp
+(setq timestr (substring timestr 0 (match-end 0))))
 (save-excursion
 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
 (progn
 (goto-char (match-end 1))
 (setq hdmarker (org-agenda-new-marker))
 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
 (setq txt (org-format-agenda-item
 (format "%s%s"
 (if deadlinep  "Deadline:  " "")
 (if scheduledp "Scheduled: " ""))
-(match-string 1))))
+(match-string 1) nil timestr)))
 (setq txt org-agenda-no-heading-message))
 (setq priority (org-get-priority txt))
 (add-text-properties
 0 (length txt) (append (list 'org-marker marker
 'org-hd-marker hdmarker) props)
 'help-echo
 (format "mouse-2 or RET jump to org file %s"
 (abbreviate-file-name (buffer-file-name)))))
 (regexp org-tr-regexp)
 (d0 (calendar-absolute-from-gregorian date))
-marker hdmarker ee txt d1 d2 s1 s2)
+marker hdmarker ee txt d1 d2 s1 s2 timestr)
 (goto-char (point-min))
 (while (re-search-forward regexp nil t)
-(setq s1 (match-string 1)
+(setq timestr (match-string 0)
+s1 (match-string 1)
 s2 (match-string 2)
 d1 (time-to-days (org-time-string-to-time s1))
 d2 (time-to-days (org-time-string-to-time s2)))
 (if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
 ;; Only allow days between the limits, because the normal
 (progn
 (setq hdmarker (org-agenda-new-marker (match-end 1)))
 (goto-char (match-end 1))
 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
 (setq txt (org-format-agenda-item
-(format "(%d/%d): "
+(format (if (= d1 d2) "" "(%d/%d): ")
 (1+ (- d0 d1)) (1+ (- d2 d1)))
-(match-string 1))))
+(match-string 1) nil (if (= d0 d1) timestr))))
 (setq txt org-agenda-no-heading-message))
 (add-text-properties
 0 (length txt) (append (list 'org-marker marker
 'org-hd-marker hdmarker
 'priority (org-get-priority txt))
 (push txt ee)))
 (outline-next-heading))
 ;; Sort the entries by expiration date.
 (nreverse ee)))
-(defun org-format-agenda-item (prefix txt &optional category)
+(defconst org-plain-time-of-day-regexp
+(concat
+"\\(\\<[012]?[0-9]"
+"\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
+"\\(--?"
+"\\(\\<[012]?[0-9]"
+"\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
+"\\)?")
+"Regular expression to match a plain time or time range.
+Examples:  11:45 or 8am-13:15 or 2:45-2:45pm.  After a match, the following
+groups carry important information:
+0  the full match
+1  the first time, range or not
+8  the second time, if it is a range.")
+(defconst org-stamp-time-of-day-regexp
+(concat
+"<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +[a-zA-Z]+ +\\)"
+"\\([012][0-9]:[0-5][0-9]\\)>"
+"\\(--?"
+"<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?")
+"Regular expression to match a timestamp time or time range.
+After a match, the following groups carry important information:
+0  the full match
+1  date plus weekday, for backreferencing to make sure both times on same day
+2  the first time, range or not
+4  the second time, if it is a range.")
+(defvar org-prefix-has-time nil
+"A flag, set by `org-compile-prefix-format'.
+The flag is set if the currently compiled format contains a `%t'.")
+(defun org-format-agenda-item (extra txt &optional category dotime noprefix)
 "Format TXT to be inserted into the agenda buffer.
-In particular, this indents the line and adds a category."
+In particular, it adds the prefix and corresponding text properties.  EXTRA
-(let* ((category (or category
+must be a string and replaces the `%s' specifier in the prefix format.
-org-category
+CATEGORY (string, symbol or nil) may be used to overule the default
-(file-name-sans-extension
+category taken from local variable or file name. It will replace the `%c'
-(file-name-nondirectory (buffer-file-name)))))
+specifier in the format.  DOTIME, when non-nil, indicates that a
-(extra prefix)
+time-of-day should be extracted from TXT for sorting of this entry, and for
-(time-of-day (org-get-time-of-day txt))
+the `%t' specifier in the format.  When DOTIME is a string, this string is
-(t1 (if time-of-day (concat "0" (int-to-string time-of-day)) "0000"))
+searched for a time before TXT is.  NOPREFIX is a flag and indicates that
-(time (if time-of-day
+only the correctly processes TXT should be returned - this is used by
-(concat (substring t1 -4 -2)
+`org-agenda-change-all-lines'."
-":" (substring t1 -2))
+(save-match-data
-""))
+;; Diary entries sometimes have extra whitespace at the beginning
-rtn)
+(if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt)))
-(if (symbolp category) (setq category (symbol-name category)))
+(let* ((category (or category
-(setq rtn (concat (eval org-prefix-format-compiled) txt))
+org-category
-(add-text-properties
+(if (buffer-file-name)
-0 (length rtn) (list 'category (downcase category)
+(file-name-sans-extension
-'prefix-length (- (length rtn) (length txt))
+(file-name-nondirectory (buffer-file-name)))
-'time-of-day time-of-day)
+"")))
-rtn)
+time              ;; needed for the eval of the prefix format
-rtn))
+(ts (if dotime (concat (if (stringp dotime) dotime "") txt)))
+(time-of-day (and dotime (org-get-time-of-day ts)))
+stamp plain s0 s1 s2 rtn)
+(when (and dotime time-of-day org-prefix-has-time)
+;; Extract starting and ending time and move them to prefix
+(when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
+(setq plain (string-match org-plain-time-of-day-regexp ts)))
+(setq s0 (match-string 0 ts)
+s1 (match-string (if plain 1 2) ts)
+s2 (match-string (if plain 8 4) ts))
+;; If the times are in TXT (not in DOTIMES), and the prefix will list
+;; them, we might want to remove them there to avoid duplication.
+;; The user can turn this off with a variable.
+(if (and org-agenda-remove-times-when-in-prefix (or stamp plain)
+(string-match (concat (regexp-quote s0) " *") txt)
+(if (eq org-agenda-remove-times-when-in-prefix 'beg)
+(= (match-beginning 0) 0)
+t))
+(setq txt (replace-match "" nil nil txt))))
+;; Normalize the time(s) to 24 hour
+(if s1 (setq s1 (org-get-time-of-day s1 'string)))
+(if s2 (setq s2 (org-get-time-of-day s2 'string))))
+;; Create the final string
+(if noprefix
+(setq rtn txt)
+;; Prepare the variables needed in the eval of the compiled format
+(setq time (cond (s2 (concat s1 "-" s2))
+(s1 (concat s1 "......"))
+(t ""))
+extra (or extra "")
+category (if (symbolp category) (symbol-name category) category))
+;; Evaluate the compiled format
+(setq rtn (concat (eval org-prefix-format-compiled) txt)))
+;; And finally add the text properties
+(add-text-properties
+0 (length rtn) (list 'category (downcase category)
+'prefix-length (- (length rtn) (length txt))
+'time-of-day time-of-day
+'dotime dotime)
+rtn)
+rtn)))
+(defun org-agenda-add-time-grid-maybe (list ndays todayp)
+(catch 'exit
+(cond ((not org-agenda-use-time-grid) (throw 'exit list))
+((and todayp (member 'today (car org-agenda-time-grid))))
+((and (= ndays 1) (member 'daily (car org-agenda-time-grid))))
+((member 'weekly (car org-agenda-time-grid)))
+(t (throw 'exit list)))
+(let* ((have (delq nil (mapcar
+(lambda (x) (get-text-property 1 'time-of-day x))
+list)))
+(string (nth 1 org-agenda-time-grid))
+(gridtimes (nth 2 org-agenda-time-grid))
+(req (car org-agenda-time-grid))
+(remove (member 'remove-match req))
+new time)
+(if (and (member 'require-timed req) (not have))
+;; don't show empty grid
+(throw 'exit list))
+(while (setq time (pop gridtimes))
+(unless (and remove (member time have))
+(setq time (int-to-string time))
+(push (org-format-agenda-item
+nil string "" ;; FIXME: put a category?
+(concat (substring time 0 -2) ":" (substring time -2)))
+new)
+(put-text-property
+1 (length (car new)) 'face 'org-time-grid-face (car new))))
+(if (member 'time-up org-agenda-sorting-strategy)
+(append new list)
+(append list new)))))
 (defun org-compile-prefix-format (format)
 "Compile the prefix format into a Lisp form that can be evaluated.
 The resulting form is returned and stored in the variable
 `org-prefix-format-compiled'."
-(let ((start 0) varform vars (s format) c)
+(setq org-prefix-has-time nil)
-(while (string-match "%\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)"
+(let ((start 0) varform vars var (s format) c f opt)
+(while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)"
 s start)
-(setq var (cdr (assoc (match-string 3 s)
+(setq var (cdr (assoc (match-string 4 s)
 '(("c" . category) ("t" . time) ("s" . extra))))
-c (match-string 2 s)
+c (or (match-string 3 s) "")
+opt (match-beginning 1)
 start (1+ (match-beginning 0)))
-(if (= (length c) 1)
+(if (equal var 'time) (setq org-prefix-has-time t))
-(setq varform `(if (equal "" ,var) "" (concat ,var ,c)))
+(setq f (concat "%" (match-string 2 s) "s"))
-(setq varform var))
+(if opt
-(setq s (replace-match "%\\1s" t nil s))
+(setq varform
+`(if (equal "" ,var)
+""
+(format ,f (if (equal "" ,var) "" (concat ,var ,c)))))
+(setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c)))))
+(setq s (replace-match "%s" t nil s))
 (push varform vars))
 (setq vars (nreverse vars))
 (setq org-prefix-format-compiled `(format ,s ,@vars))))
-(defun org-get-time-of-day (s)
+(defun org-get-time-of-day (s &optional string)
 "Check string S for a time of day.
 If found, return it as a military time number between 0 and 2400.
-If not found, return nil."
+If not found, return nil.
+The optional STRING argument forces conversion into a 5 character wide string
+HH:MM."
 (save-match-data
-(when (or
+(when
-(string-match
+(or
-"\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\>" s)
+(string-match
-(string-match
+"\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
-"\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\>" s))
+(string-match
-(+ (* 100 (+ (string-to-number (match-string 1 s))
+"\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
-(if (and (match-beginning 4)
+(let* ((t0 (+ (* 100
-(equal (downcase (match-string 4 s)) "pm"))
+(+ (string-to-number (match-string 1 s))
-12 0)))
+(if (and (match-beginning 4)
-(if (match-beginning 3)
+(equal (downcase (match-string 4 s)) "pm"))
-(string-to-number (match-string 3 s))
+12 0)))
-0)))))
+(if (match-beginning 3)
+(string-to-number (match-string 3 s))
+0)))
+(t1 (concat " " (int-to-string t0))))
+(if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
 (defun org-finalize-agenda-entries (list)
 "Sort and concatenate the agenda items."
 (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))
 (org-agenda-change-all-lines newhead hdmarker 'fixface))
 (move-to-column col)))
 (defun org-agenda-change-all-lines (newhead hdmarker &optional fixface)
 "Change all lines in the agenda buffer which match hdmarker.
-The new content of the line will be NEWHEAD.  HDMARKER is checked with
+The new content of the line will be NEWHEAD (as modified by
-`equal' against all `org-hd-marker' text properties in the file."
+`org-format-agenda-item').  HDMARKER is checked with
-(let* (props m pl undone-face done-face)
+`equal' against all `org-hd-marker' text properties in the file.
+If FIXFACE is non-nil, the face of each item is modified acording to
+the new TODO state."
+(let* (props m pl undone-face done-face finish new dotime)
+;    (setq newhead (org-format-agenda-item "x" newhead "x" nil 'noprefix))
 (save-excursion
 (goto-char (point-max))
 (beginning-of-line 1)
-(while (not (bobp))
+(while (not finish)
+(setq finish (bobp))
 (when (and (setq m (get-text-property (point) 'org-hd-marker))
 (equal m hdmarker))
 (setq props (text-properties-at (point))
+dotime (get-text-property (point) 'dotime)
+new (org-format-agenda-item "x" newhead "x" dotime 'noprefix)
 pl (get-text-property (point) 'prefix-length)
 undone-face (get-text-property (point) 'undone-face)
 done-face (get-text-property (point) 'done-face))
 (move-to-column pl)
 (if (looking-at ".*")
 (progn
-(replace-match newhead t t)
+(replace-match new t t)
 (beginning-of-line 1)
 (add-text-properties (point-at-bol) (point-at-eol) props)
 (if fixface
 (add-text-properties
 (point-at-bol) (point-at-eol)
 (org-show-hidden-entry)
 (save-excursion
 (and (outline-next-heading)
 (org-flag-heading nil)))   ; show the next heading
 (funcall 'org-priority force-direction)
+(end-of-line 1)
 (setq newhead (org-get-heading)))
 (org-agenda-change-all-lines newhead hdmarker)
 (beginning-of-line 1)))
 (defun org-agenda-date-later (arg &optional what)
 (setq s (concat
 "Gregorian:  " (calendar-date-string date) "\n"
 "ISO:        " (calendar-iso-date-string date) "\n"
 "Day of Yr:  " (calendar-day-of-year-string date) "\n"
 "Julian:     " (calendar-julian-date-string date) "\n"
-"Astronomic: " (calendar-astro-date-string date)
+"Astron. JD: " (calendar-astro-date-string date)
 " (Julian date number at noon UTC)\n"
 "Hebrew:     " (calendar-hebrew-date-string date) " (until sunset)\n"
 "Islamic:    " (calendar-islamic-date-string date) " (until sunset)\n"
 "French:     " (calendar-french-date-string date) "\n"
 "Mayan:      " (calendar-mayan-date-string date) "\n"
 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus
 (gnus-group-group-name))         ; version
 ((fboundp 'gnus-group-name)
 (gnus-group-name))
 (t "???"))))
-(setq link (concat (if (org-xor arg org-usenet-links-prefer-google)
+(setq link (concat
-"http://groups.google.com/groups?group="
+(if (org-xor arg org-usenet-links-prefer-google)
-"gnus:")
+"http://groups.google.com/groups?group="
-group))))
+"gnus:")
+group))))
 ((memq major-mode '(gnus-summary-mode gnus-article-mode))
 (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
 (gnus-summary-beginning-of-article)
 (let* ((group (car gnus-article-current))
 (message "Stored: %s" (or cpltxt link)))
 link)))
 (defun org-xor (a b)
 "Exclusive or."
-;; (if a (not b) b)
+(if a (not b) b))
-(or (and a (not b))
-(and b (not a))))
 (defun org-get-header (header)
 "Find a header field in the current buffer."
 (save-excursion
 (goto-char (point-min))
 "\n")))
 (if (string-match "^[ \t]*$" (buffer-substring-no-properties
 (point-at-bol) (point)))
 (beginning-of-line 1)
 (newline))
-(mapcar (lambda (x) (insert line)) (make-list rows t))
+;; (mapcar (lambda (x) (insert line)) (make-list rows t))
+(dotimes (i rows) (insert line))
 (goto-char pos)
 (if (> rows 1)
 ;; Insert a hline after the first row.
 (progn
 (end-of-line 1)
 (file (read-file-name "Export table to: "))
 buf)
 (unless (or (not (file-exists-p file))
 (y-or-n-p (format "Overwrite file %s? " file)))
 (error "Abort"))
-(save-excursion
+(with-current-buffer (find-file-noselect file)
-(find-file file)
 (setq buf (current-buffer))
 (erase-buffer)
 (fundamental-mode)
 (insert table)
 (goto-char (point-min))
 (setq rfmt (concat rfmt (format rfmt1 ty l))
 hfmt (concat hfmt (format hfmt1 (make-string l ?-)))))
 (setq rfmt (concat rfmt "\n")
 hfmt (concat (substring hfmt 0 -1) "|\n"))
 ;; Produce the new table
-(while lines
+;;(while lines
-(setq l (pop lines))
+;;  (setq l (pop lines))
-(if l
+;;  (if l
-(setq new (concat new (apply 'format rfmt
+;;      (setq new (concat new (apply 'format rfmt
-(append (pop fields) emptystrings))))
+;;                                   (append (pop fields) emptystrings))))
-(setq new (concat new hfmt))))
+;;    (setq new (concat new hfmt))))
+(setq new (mapconcat
+(lambda (l)
+(if l (apply 'format rfmt
+(append (pop fields) emptystrings))
+hfmt))
+lines ""))
 ;; Replace the old one
 (delete-region beg end)
 (move-marker end nil)
 (move-marker org-table-aligned-begin-marker (point))
 (insert new)
 (if (fboundp 'outline-invisible-p)
 (outline-invisible-p)
 (get-char-property (point) 'invisible))
 (save-excursion
 (skip-chars-backward "^\r\n")
-(if (bobp)
+(equal (char-before) ?\r))))
-nil
-(equal (char-before) ?\r)))))
 (defun org-back-to-heading (&optional invisible-ok)
 "Move to previous heading line, or beg of this line if it's a heading.
 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
 (if org-noutline-p

Mercurial > emacs

comparison lisp/textmodes/org.el @ 62546:153ddc124932