;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 5.11b
+;; Version: 5.13d
;;
;; This file is part of GNU Emacs.
;;
;;; Version
-(defconst org-version "5.11"
+(defconst org-version "5.13d"
"The version number of the file org.el.")
(defun org-version ()
(interactive)
(progn
(if pc-mode (partial-completion-mode -1))
,@body)
- (if pc-mode (partial-completion-mode 1)))))
+ (if pc-mode (partial-completion-mode 1)))))
;;; The custom variables
"Define a key, possibly translated, as returned by `org-key'."
(define-key keymap (org-key key) def))
-(defcustom org-ellipsis nil
+(defcustom org-ellipsis 'org-ellipsis
"The ellipsis to use in the Org-mode outline.
When nil, just use the standard three dots. When a string, use that instead,
When a face, use the standart 3 dots, but with the specified face.
.....
:END:
The drawer \"PROPERTIES\" is special for capturing properties through
-the property API."
+the property API.
+
+Drawers can be defined on the per-file basis with a line like:
+
+#+DRAWERS: HIDDEN STATE PROPERTIES"
:group 'org-structure
:type '(repeat (string :tag "Drawer Name")))
(defcustom org-confirm-shell-link-function 'yes-or-no-p
"Non-nil means, ask for confirmation before executing shell links.
-Shell links can be dangerous, just thing about a link
+Shell links can be dangerous: just think about a link
[[shell:rm -rf ~/*][Google Search]]
-This link would show up in your Org-mode document as \"Google Search\"
+This link would show up in your Org-mode document as \"Google Search\",
but really it would remove your entire home directory.
-Therefore I *definitely* advise against setting this variable to nil.
-Just change it to `y-or-n-p' of you want to confirm with a single key press
-rather than having to type \"yes\"."
+Therefore we advise against setting this variable to nil.
+Just change it to `y-or-n-p' of you want to confirm with a
+single keystroke rather than having to type \"yes\"."
:group 'org-link-follow
:type '(choice
(const :tag "with yes-or-no (safer)" yes-or-no-p)
(const :tag "no confirmation (dangerous)" nil)))
(defcustom org-confirm-elisp-link-function 'yes-or-no-p
- "Non-nil means, ask for confirmation before executing elisp links.
-Elisp links can be dangerous, just think about a link
+ "Non-nil means, ask for confirmation before executing Emacs Lisp links.
+Elisp links can be dangerous: just think about a link
[[elisp:(shell-command \"rm -rf ~/*\")][Google Search]]
-This link would show up in your Org-mode document as \"Google Search\"
+This link would show up in your Org-mode document as \"Google Search\",
but really it would remove your entire home directory.
-Therefore I *definitely* advise against setting this variable to nil.
-Just change it to `y-or-n-p' of you want to confirm with a single key press
-rather than having to type \"yes\"."
+Therefore we advise against setting this variable to nil.
+Just change it to `y-or-n-p' of you want to confirm with a
+single keystroke rather than having to type \"yes\"."
:group 'org-link-follow
:type '(choice
(const :tag "with yes-or-no (safer)" yes-or-no-p)
`C-u C-c C-c' trigger the fasttrack."
:group 'org-remember
:type 'boolean)
-
+
(defcustom org-remember-default-headline ""
"The headline that should be the default location in the notes file.
When filing remember notes, the cursor will start at that position.
(defcustom org-remember-templates nil
"Templates for the creation of remember buffers.
When nil, just let remember make the buffer.
-When not nil, this is a list of 4-element lists. In each entry, the first
-element is a character, a unique key to select this template.
-The second element is the template. The third element is optional and can
+When not nil, this is a list of 5-element lists. In each entry, the first
+element is a the name of the template, It should be a single short word.
+The second element is a character, a unique key to select this template.
+The third element is the template. The forth element is optional and can
specify a destination file for remember items created with this template.
-The default file is given by `org-default-notes-file'. An optional forth
+The default file is given by `org-default-notes-file'. An optional fifth
element can specify the headline in that file that should be offered
first when the user is asked to file the entry. The default headline is
given in the variable `org-remember-default-headline'.
info | %:type %:file %:node
calendar | %:type %:date"
:group 'org-remember
- :get (lambda (var) ; Make sure all entries have 4 elements
+ :get (lambda (var) ; Make sure all entries have 5 elements
(mapcar (lambda (x)
- (cond ((= (length x) 3) (append x '("")))
- ((= (length x) 2) (append x '("" "")))
+ (if (not (stringp (car x))) (setq x (cons "" x)))
+ (cond ((= (length x) 4) (append x '("")))
+ ((= (length x) 3) (append x '("" "")))
(t x)))
(default-value var)))
:type '(repeat
:tag "enabled"
- (list :value (?a "\n" nil nil)
+ (list :value ("" ?a "\n" nil nil)
+ (string :tag "Name")
(character :tag "Selection Key")
(string :tag "Template")
- (file :tag "Destination file (optional)")
- (string :tag "Destination headline (optional)"))))
+ (choice
+ (file :tag "Destination file")
+ (const :tag "Prompt for file" nil))
+ (choice
+ (string :tag "Destination headline")
+ (const :tag "Selection interface for heading")))))
(defcustom org-reverse-note-order nil
"Non-nil means, store new notes at the beginning of a file or entry.
(concat "[" (substring f 1 -1) "]")
f)))
-(defcustom org-deadline-warning-days 14
- "No. of days before expiration during which a deadline becomes active.
-This variable governs the display in sparse trees and in the agenda.
-When negative, it means use this number (the absolute value of it)
-even if a deadline has a different individual lead time specified."
- :group 'org-time
- :type 'number)
-
(defcustom org-popup-calendar-for-date-prompt t
"Non-nil means, pop up a calendar when prompting for a date.
In the calendar, the date can be selected with mouse-1. However, the
:group 'org-properties
:type 'string)
+(defcustom org-use-property-inheritance nil
+ "Non-nil means, properties apply also for sublevels.
+This can cause significant overhead when doing a search, so this is turned
+off by default.
+When nil, only the properties directly given in the current entry count.
+
+However, note that some special properties use inheritance under special
+circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS,
+and the properties ending in \"_ALL\" when they are used as descriptor
+for valid values of a property."
+ :group 'org-properties
+ :type 'boolean)
+
(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
"The default column format, if no other format has been defined.
This variable can be set on the per-file basis by inserting a line
Entries may be added to this list with \\[org-agenda-file-to-front] and removed with
\\[org-remove-file]. You can also use customize to edit the list.
+If an entry is a directory, all files in that directory that are matched by
+`org-agenda-file-regexp' will be part of the file list.
+
If the value of the variable is not a list but a single file name, then
the list of agenda files is actually stored and maintained in that file, one
agenda file per line."
:group 'org-agenda
:type '(choice
- (repeat :tag "List of files" file)
+ (repeat :tag "List of files and directories" file)
(file :tag "Store list in a file\n" :value "~/.agenda_files")))
+(defcustom org-agenda-file-regexp "\\.org\\'"
+ "Regular expression to match files for `org-agenda-files'.
+If ny element in the list in that variable contains a directory instead
+of a normal file, all files in that directory that are matched by this
+regular expression will be included."
+ :group 'org-agenda
+ :type 'regexp)
+
(defcustom org-agenda-skip-unavailable-files nil
"t means to just skip non-reachable files in `org-agenda-files'.
Nil means to remove them, after a query, from the list."
:group 'org-agenda
:type 'boolean)
+(defcustom org-agenda-multi-occur-extra-files nil
+ "List of extra files to be searched by `org-occur-in-agenda-files'.
+The files in `org-agenda-files' are always searched."
+ :group 'org-agenda
+ :type '(repeat file))
+
(defcustom org-agenda-confirm-kill 1
"When set, remote killing from the agenda buffer needs confirmation.
When t, a confirmation is always needed. When a number N, confirmation is
These commands will be offered on the splash screen displayed by the
agenda dispatcher \\[org-agenda]. Each entry is a list like this:
- (key type match options files)
+ (key desc type match options files)
-key The key (a single char as a string) to be associated with the command.
+key The key (one or more characters as a string) to be associated
+ with the command.
+desc A description of the commend, when omitted or nil, a default
+ description is built using MATCH.
type The command type, any of the following symbols:
todo Entries with a specific TODO keyword, in all agenda files.
tags Tags match in all agenda files.
todo-tree Sparse tree of specific TODO keyword in *current* file.
tags-tree Sparse tree with all tags matches in *current* file.
occur-tree Occur sparse tree for *current* file.
+ ... A user-defined function.
match What to search for:
- a single keyword for TODO keyword searches
- a tags match expression for tags searches
Each command can carry a list of options, and another set of options can be
given for the whole set of commands. Individual command options take
-precedence over the general options."
+precedence over the general options.
+
+When using several characters as key to a command, the first characters
+are prefix commands. For the dispatcher to display useful information, you
+should provide a description for the prefix, like
+
+ (setq org-agenda-custom-commands
+ '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
+ (\"hl\" tags \"+HOME+Lisa\")
+ (\"hp\" tags \"+HOME+Peter\")
+ (\"hk\" tags \"+HOME+Kim\")))"
:group 'org-agenda-custom-commands
:type '(repeat
- (choice :value ("a" tags "" nil)
+ (choice :value ("a" "" tags "" nil)
(list :tag "Single command"
- (string :tag "Key")
+ (string :tag "Access Key(s) ")
+ (option (string :tag "Description"))
(choice
(const :tag "Agenda" agenda)
(const :tag "TODO list" alltodo)
(const :tag "Tags sparse tree (current buffer)" tags-tree)
(const :tag "TODO keyword tree (current buffer)" todo-tree)
(const :tag "Occur tree (current buffer)" occur-tree)
- (symbol :tag "Other, user-defined function"))
+ (sexp :tag "Other, user-defined function"))
(string :tag "Match")
(repeat :tag "Local options"
(list (variable :tag "Option") (sexp :tag "Value")))
(option (repeat :tag "Export" (file :tag "Export to"))))
(list :tag "Command series, all agenda files"
- (string :tag "Key")
- (string :tag "Description")
+ (string :tag "Access Key(s)")
+ (string :tag "Description ")
(repeat
(choice
(const :tag "Agenda" (agenda))
(repeat :tag "General options"
(list (variable :tag "Option")
(sexp :tag "Value")))
- (option (repeat :tag "Export" (file :tag "Export to")))))))
+ (option (repeat :tag "Export" (file :tag "Export to"))))
+ (cons :tag "Prefix key documentation"
+ (string :tag "Access Key(s)")
+ (string :tag "Description ")))))
(defcustom org-stuck-projects
'("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "")
:group 'org-todo
:type 'boolean)
+(defcustom org-agenda-todo-ignore-with-date nil
+ "Non-nil means, don't show entries with a date in the global todo list.
+You can use this if you prefer to mark mere appointments with a TODO keyword,
+but don't want them to show up in the TODO list.
+When this is set, it also covers deadlines and scheduled items, the settings
+of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines'
+will be ignored."
+ :group 'org-agenda-skip
+ :group 'org-todo
+ :type 'boolean)
+
(defcustom org-agenda-todo-ignore-scheduled nil
"Non-nil means, don't show scheduled entries in the global todo list.
The idea behind this is that by scheduling it, you have already taken care
-of this item."
+of this item.
+See also `org-agenda-todo-ignore-with-date'."
:group 'org-agenda-skip
:group 'org-todo
:type 'boolean)
(defcustom org-agenda-todo-ignore-deadlines nil
"Non-nil means, don't show near deadline entries in the global todo list.
Near means closer than `org-deadline-warning-days' days.
-The idea behind this is that such items will appear in the agenda anyway."
+The idea behind this is that such items will appear in the agenda anyway.
+See also `org-agenda-todo-ignore-with-date'."
:group 'org-agenda-skip
:group 'org-todo
:type 'boolean)
(const other-window)
(const reorganize-frame)))
+(defcustom org-agenda-window-frame-fractions '(0.5 . 0.75)
+ "The min and max height of the agenda window as a fraction of frame height.
+The value of the variable is a cons cell with two numbers between 0 and 1.
+It only matters if `org-agenda-window-setup' is `reorganize-frame'."
+ :group 'org-agenda-windows
+ :type '(cons (number :tag "Minimum") (number :tag "Maximum")))
+
(defcustom org-agenda-restore-windows-after-quit nil
"Non-nil means, restore window configuration open exiting agenda.
Before the window configuration is changed for displaying the agenda,
:group 'org-agenda-daily/weekly
:type 'boolean)
+(defcustom org-deadline-warning-days 14
+ "No. of days before expiration during which a deadline becomes active.
+This variable governs the display in sparse trees and in the agenda.
+When negative, it means use this number (the absolute value of it)
+even if a deadline has a different individual lead time specified."
+ :group 'org-time
+ :group 'org-agenda-daily/weekly
+ :type 'number)
+
+(defcustom org-scheduled-past-days 10000
+ "No. of days to continue listing scheduled items that are not marked DONE.
+When an item is scheduled on a date, it shows up in the agenda on this
+day and will be listed until it is marked done for the number of days
+given here."
+ :group 'org-agenda-daily/weekly
+ :type 'number)
+
(defgroup org-agenda-time-grid nil
"Options concerning the time grid in the Org-mode Agenda."
:tag "Org Agenda Time Grid"
"The compiled version of the most recently used prefix format.
See the variable `org-agenda-prefix-format'.")
+(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ")
+ "Text preceeding scheduled items in the agenda view.
+THis is a list with two strings. The first applies when the item is
+scheduled on the current day. The second applies when it has been scheduled
+previously, it may contain a %d to capture how many days ago the item was
+scheduled."
+ :group 'org-agenda-line-format
+ :type '(list
+ (string :tag "Scheduled today ")
+ (string :tag "Scheduled previously")))
+
+(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ")
+ "Text preceeding deadline items in the agenda view.
+This is a list with two strings. The first applies when the item has its
+deadline on the current day. The second applies when it is in the past or
+in the future, it may contain %d to capture how many days away the deadline
+is (was)."
+ :group 'org-agenda-line-format
+ :type '(list
+ (string :tag "Deadline today ")
+ (string :tag "Deadline relative")))
+
(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
(if (fboundp 'defvaralias)
(defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column))
+(defcustom org-agenda-fontify-priorities t
+ "Non-nil means, highlight low and high priorities in agenda.
+When t, the highest priority entries are bold, lowest priority italic.
+This may also be an association list of priority faces. The face may be
+a names face, or a list like `(:background \"Red\")'."
+ :group 'org-agenda-line-format
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Defaults" t)
+ (repeat :tag "Specify"
+ (list (character :tag "Priority" :value ?A)
+ (sexp :tag "face")))))
+
(defgroup org-latex nil
"Options for embedding LaTeX code into Org-mode"
:tag "Org LaTeX"
(repeat
(cons
(choice :tag "Type"
- (const :html) (const :LaTeX)
+ (const :html) (const :LaTeX)
(const :ascii) (const :ical) (const :xoxo))
(directory)))))
(defcustom org-export-with-tags 'not-in-toc
"If nil, do not export tags, just remove them from headlines.
If this is the symbol `not-in-toc', tags will be removed from table of
-contents entries, but still be shown in the headlines of the document."
+contents entries, but still be shown in the headlines of the document.
+
+This option can also be set with the +OPTIONS line, e.g. \"tags:nil\"."
:group 'org-export-general
:type '(choice
(const :tag "Off" nil)
(const :tag "Not in TOC" not-in-toc)
(const :tag "On" t)))
-(defcustom org-export-with-property-drawer nil
- "Non-nil means, export property drawers.
-When nil, these drawers are removed before export.
-
-This option can also be set with the +OPTIONS line, e.g. \"p:t\"."
+(defcustom org-export-with-drawers nil
+ "Non-nil means, export with drawers like the property drawer.
+When t, all drawers are exported. This may also be a list of
+drawer names to export."
:group 'org-export-general
- :type 'boolean)
+ :type '(choice
+ (const :tag "All drawers" t)
+ (const :tag "None" nil)
+ (repeat :tag "Selected drawers"
+ (string :tag "Drawer name"))))
(defgroup org-export-translation nil
"Options for translating special ascii sequences for the export backends."
;; Make sure that a fixed-width face is used when we have a column table.
(set-face-attribute 'org-column nil
:height (face-attribute 'default :height)
- :family (face-attribute 'default :family)))
+ :family (face-attribute 'default :family)))
(defface org-warning
(org-compatible-face
"Face for links."
:group 'org-faces)
+(defface org-ellipsis
+ '((((class color) (background light)) (:foreground "DarkGoldenrod" :strike-through t))
+ (((class color) (background dark)) (:foreground "LightGoldenrod" :strike-through t))
+ (t (:strike-through t)))
+ "Face for the ellipsis in folded text."
+ :group 'org-faces)
+
(defface org-target
'((((class color) (background light)) (:underline t))
(((class color) (background dark)) (:underline t))
(defvar org-todo-line-regexp nil
"Matches a headline and puts TODO state into group 2 if present.")
(make-variable-buffer-local 'org-todo-line-regexp)
+(defvar org-complex-heading-regexp nil
+ "Matches a headline and puts everything into groups:
+group 1: the stars
+group 2: The todo keyword, maybe
+group 3: Priority cookie
+group 4: True headline
+group 5: Tags")
+(make-variable-buffer-local 'org-complex-heading-regexp)
(defvar org-todo-line-tags-regexp nil
"Matches a headline and puts TODO state into group 2 if present.
Also put tags into group 4 if tags are present.")
(let ((re (org-make-options-regexp
'("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "COLUMNS"
"STARTUP" "ARCHIVE" "TAGS" "LINK" "PRIORITIES"
- "CONSTANTS" "PROPERTY")))
+ "CONSTANTS" "PROPERTY" "DRAWERS")))
(splitre "[ \t]+")
kwds kws0 kwsa key value cat arch tags const links hw dws
- tail sep kws1 prio props
- ex log note)
+ tail sep kws1 prio props drawers
+ ex log)
(save-excursion
(save-restriction
(widen)
(when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
(push (cons (match-string 1 value) (match-string 2 value))
props)))
+ ((equal key "DRAWERS")
+ (setq drawers (org-split-string value splitre)))
((equal key "CONSTANTS")
(setq const (append const (org-split-string value splitre))))
((equal key "STARTUP")
(org-set-local 'org-lowest-priority (nth 1 prio))
(org-set-local 'org-default-priority (nth 2 prio)))
(and props (org-set-local 'org-local-properties (nreverse props)))
+ (and drawers (org-set-local 'org-drawers drawers))
(and arch (org-set-local 'org-archive-location arch))
(and links (setq org-link-abbrev-alist-local (nreverse links)))
;; Process the TODO keywords
(concat "^\\(\\*+\\)[ \t]+\\(?:\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
"\\)\\>\\)?[ \t]*\\(.*\\)")
+ org-complex-heading-regexp
+ (concat "^\\(\\*+\\)\\(?:[ \t]+\\("
+ (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
+ "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)"
+ "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$")
org-nl-done-regexp
(concat "\n\\*+[ \t]+"
"\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|")
(defconst org-nonsticky-props
'(mouse-face highlight keymap invisible intangible help-echo org-linked-text))
+
(defun org-activate-plain-links (limit)
"Run through the buffer and add overlays to links."
(catch 'exit
))
(throw 'exit t))))))
+(defun org-activate-code (limit)
+ (if (re-search-forward "^[ \t]*\\(:.*\\)" limit t)
+ (unless (get-text-property (match-beginning 1) 'face)
+ (remove-text-properties (match-beginning 0) (match-end 0)
+ '(display t invisible t intangible t))
+ t)))
+
(defun org-activate-angle-links (limit)
"Run through the buffer and add overlays to links."
(if (re-search-forward org-angle-link-re limit t)
(2 (org-get-level-face 2)) (3 (org-get-level-face 3)))
;; Table lines
'("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
- (1 'org-table))
+ (1 'org-table t))
+ ;; Table internals
+ '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
+ '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
+ '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
+ ;; Drawers
+ (list org-drawer-regexp '(0 'org-special-keyword t))
+ (list "^[ \t]*:END:" '(0 'org-special-keyword t))
+ ;; Properties
+ (list org-property-re
+ '(1 'org-special-keyword t)
+ '(3 'org-property-value t))
+ (if org-format-transports-properties-p
+ '("| *\\(<[0-9]+>\\) *" (1 'org-formula t)))
;; Links
(if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
(if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
(if (featurep 'xemacs)
'(org-do-emphasis-faces (0 nil append))
'(org-do-emphasis-faces)))
- ;; Checkboxes, similar to Frank Ruell's org-checklet.el
+ ;; Checkboxes
'("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)"
2 'bold prepend)
(if org-provide-checkbox-statistics
"\\|" org-quote-string "\\)\\>")
'(1 'org-special-keyword t))
'("^#.*" (0 'font-lock-comment-face t))
- ;; Code
- '("^[ \t]*\\(:.*\\)" (1 'org-code t))
- ;; Table internals
- '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
- '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
- '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
- ;; Drawers
- (list org-drawer-regexp '(0 'org-special-keyword t))
- (list "^[ \t]*:END:" '(0 'org-special-keyword t))
- ;; Properties
- (list org-property-re
- '(1 'org-special-keyword t)
- '(3 'org-property-value t))
- (if org-format-transports-properties-p
- '("| *\\(<[0-9]+>\\) *" (1 'org-formula t)))
'("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend))
+ ;; Code
+ '(org-activate-code (1 'org-code t))
)))
(setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
;; Now set the full font-lock-keywords
(cond
((org-on-heading-p) (org-do-demote))
((org-at-item-p) (org-indent-item 1))))
-
+
;;; Promotion and Demotion
(defun org-promote-subtree ()
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\*\\*+ " nil t)
- (setq n (/ (length (1- (match-string 0))) 2))
+ (setq n (/ (1- (length (match-string 0))) 2))
(while (>= (setq n (1- n)) 0)
(org-promote))
(end-of-line 1))))))
"Was the last copied subtree folded?
This is used to fold the tree back after pasting.")
-(defun org-cut-subtree ()
+(defun org-cut-subtree (&optional n)
"Cut the current subtree into the clipboard.
+With prefix arg N, cut this many sequential subtrees.
This is a short-hand for marking the subtree and then cutting it."
- (interactive)
- (org-copy-subtree 'cut))
+ (interactive "p")
+ (org-copy-subtree n 'cut))
-(defun org-copy-subtree (&optional cut)
+(defun org-copy-subtree (&optional n cut)
"Cut the current subtree into the clipboard.
+With prefix arg N, cut this many sequential subtrees.
This is a short-hand for marking the subtree and then copying it.
If CUT is non-nil, actually cut the subtree."
- (interactive)
+ (interactive "p")
(let (beg end folded)
(if (interactive-p)
(org-back-to-heading nil) ; take what looks like a subtree
(save-match-data
(save-excursion (outline-end-of-heading)
(setq folded (org-invisible-p)))
- (outline-end-of-subtree))
- (if (equal (char-after) ?\n) (forward-char 1))
+ (condition-case nil
+ (outline-forward-same-level (1- n))
+ (error nil))
+ (org-end-of-subtree t t))
(setq end (point))
(goto-char beg)
(when (> end beg)
(setq org-subtree-clip-folded folded)
(if cut (kill-region beg end) (copy-region-as-kill beg end))
(setq org-subtree-clip (current-kill 0))
- (message "%s: Subtree with %d characters"
+ (message "%s: Subtree(s) with %d characters"
(if cut "Cut" "Copied")
(length org-subtree-clip)))))
(let* ((txt (or tree (and kill-ring (current-kill 0))))
(^re (concat "^\\(" outline-regexp "\\)"))
(re (concat "\\(" outline-regexp "\\)"))
- (^re_ (concat "\\(" outline-regexp "\\)[ \t]*"))
+ (^re_ (concat "\\(\\*+\\)[ \t]*"))
(old-level (if (string-match ^re txt)
(- (match-end 0) (match-beginning 0) 1)
(force-level (cond (level (prefix-numeric-value level))
((string-match
^re_ (buffer-substring (point-at-bol) (point)))
- (- (match-end 0) (match-beginning 0)))
+ (- (match-end 1) (match-beginning 1)))
(t nil)))
(previous-level (save-excursion
(condition-case nil
(progn
(outline-previous-visible-heading 1)
(if (looking-at re)
- (- (match-end 0) (match-beginning 0))
+ (- (match-end 0) (match-beginning 0) 1)
1))
(error 1))))
(next-level (save-excursion
(condition-case nil
(progn
- (outline-next-visible-heading 1)
+ (or (looking-at outline-regexp)
+ (outline-next-visible-heading 1))
(if (looking-at re)
- (- (match-end 0) (match-beginning 0))
+ (- (match-end 0) (match-beginning 0) 1)
1))
(error 1))))
(new-level (or force-level (max previous-level next-level)))
(= old-level new-level))
0
(- new-level old-level)))
- (shift1 shift)
(delta (if (> shift 0) -1 1))
(func (if (> shift 0) 'org-demote 'org-promote))
(org-odd-levels-only nil)
;;; Outline Sorting
(defun org-sort (with-case)
- "Call `org-sort-entries' or `org-table-sort-lines', depending on context."
+ "Call `org-sort-entries-or-items' or `org-table-sort-lines'.
+Optional argument WITH-CASE means sort case-sensitively."
(interactive "P")
(if (org-at-table-p)
(org-call-with-arg 'org-table-sort-lines with-case)
- (org-call-with-arg 'org-sort-entries with-case)))
+ (org-call-with-arg 'org-sort-entries-or-items with-case)))
+
+(defvar org-priority-regexp) ; defined later in the file
-(defun org-sort-entries (&optional with-case sorting-type)
+(defun org-sort-entries-or-items (&optional with-case sorting-type getkey-func property)
"Sort entries on a certain level of an outline tree.
If there is an active region, the entries in the region are sorted.
Else, if the cursor is before the first entry, sort the top-level items.
Sorting can be alphabetically, numerically, and by date/time as given by
the first time stamp in the entry. The command prompts for the sorting
type unless it has been given to the function through the SORTING-TYPE
-argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T).
+argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T ?p ?P ?f ?F).
+If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be
+called with point at the beginning of the record. It must return either
+a string or a number that should serve as the sorting key for that record.
Comparing entries ignores case by default. However, with an optional argument
-WITH-CASE, the sorting considers case as well. With two prefix arguments
-`C-u C-u', sorting is case-sensitive and duplicate entries will be removed."
+WITH-CASE, the sorting considers case as well."
(interactive "P")
- (let ((unique (equal with-case '(16)))
- start beg end entries stars re re2 p nentries (nremoved 0)
- last txt what)
+ (let ((case-func (if with-case 'identity 'downcase))
+ start beg end stars re re2
+ txt what tmp plain-list-p)
;; Find beginning and end of region to sort
(cond
((org-region-active-p)
;; we will sort the region
(setq end (region-end)
- what "region")
+ what "region")
(goto-char (region-beginning))
(if (not (org-on-heading-p)) (outline-next-heading))
(setq start (point)))
+ ((org-at-item-p)
+ ;; we will sort this plain list
+ (org-beginning-of-item-list) (setq start (point))
+ (org-end-of-item-list) (setq end (point))
+ (goto-char start)
+ (setq plain-list-p t
+ what "plain list"))
((or (org-on-heading-p)
- (condition-case nil (progn (org-back-to-heading) t) (error nil)))
+ (condition-case nil (progn (org-back-to-heading) t) (error nil)))
;; we will sort the children of the current headline
(org-back-to-heading)
(setq start (point) end (org-end-of-subtree) what "children")
(setq start (point) end (point-max) what "top-level")
(goto-char start)
(show-all)))
- (setq beg (point))
- (if (>= (point) end) (error "Nothing to sort"))
- (looking-at "\\(\\*+\\)")
- (setq stars (match-string 1)
- re (concat "^" (regexp-quote stars) " +")
- re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]")
- txt (buffer-substring beg end))
- (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n")))
- (if (and (not (equal stars "*")) (string-match re2 txt))
- (error "Region to sort contains a level above the first entry"))
- ;; Make a list that can be sorted.
- ;; The car is the string for comparison, the cdr is the subtree
- (message "Sorting entries...")
- (setq entries
- (mapcar
- (lambda (x)
- (string-match "^.*\\(\n.*\\)?" x) ; take two lines
- (cons (match-string 0 x) x))
- (org-split-string txt re)))
- ;; Sort the list
- (save-excursion
- (goto-char start)
- (setq entries (org-do-sort entries what with-case sorting-type)))
+ (setq beg (point))
+ (if (>= beg end) (error "Nothing to sort"))
+
+ (unless plain-list-p
+ (looking-at "\\(\\*+\\)")
+ (setq stars (match-string 1)
+ re (concat "^" (regexp-quote stars) " +")
+ re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]")
+ txt (buffer-substring beg end))
+ (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n")))
+ (if (and (not (equal stars "*")) (string-match re2 txt))
+ (error "Region to sort contains a level above the first entry")))
+
+ (unless sorting-type
+ (message
+ (if plain-list-p
+ "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:"
+ "Sort %s: [a]lpha [n]umeric [t]ime [p]riority p[r]operty [f]unc A/N/T/P/F means reversed:")
+ what)
+ (setq sorting-type (read-char-exclusive))
+
+ (and (= (downcase sorting-type) ?f)
+ (setq getkey-func
+ (completing-read "Sort using function: "
+ obarray 'fboundp t nil nil))
+ (setq getkey-func (intern getkey-func)))
+
+ (and (= (downcase sorting-type) ?r)
+ (setq property
+ (completing-read "Property: "
+ (mapcar 'list (org-buffer-property-keys t))
+ nil t))))
- ;; Delete the old stuff
- (goto-char beg)
- (kill-region beg end)
- (setq nentries (length entries))
- ;; Insert the sorted entries, and remove duplicates if this is required
- (while (setq p (pop entries))
- (if (and unique (equal last (setq last (org-trim (cdr p)))))
- (setq nremoved (1+ nremoved)) ; same entry as before, skip it
- (insert stars " " (cdr p))))
- (goto-char start)
- (message "Sorting entries...done (%d entries%s)"
- nentries
- (if unique (format ", %d duplicates removed" nremoved) ""))))
+ (message "Sorting entries...")
-(defvar org-priority-regexp) ; defined later in the file
+ (save-restriction
+ (narrow-to-region start end)
+
+ (let ((dcst (downcase sorting-type))
+ (now (current-time)))
+ (sort-subr
+ (/= dcst sorting-type)
+ ;; This function moves to the beginning character of the "record" to
+ ;; be sorted.
+ (if plain-list-p
+ (lambda nil
+ (if (org-at-item-p) t (goto-char (point-max))))
+ (lambda nil
+ (if (re-search-forward re nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max)))))
+ ;; This function moves to the last character of the "record" being
+ ;; sorted.
+ (if plain-list-p
+ 'org-end-of-item
+ (lambda nil
+ (save-match-data
+ (condition-case nil
+ (outline-forward-same-level 1)
+ (error
+ (goto-char (point-max)))))))
+
+ ;; This function returns the value that gets sorted against.
+ (if plain-list-p
+ (lambda nil
+ (when (looking-at "[ \t]*[-+*0-9.)]+[ \t]+")
+ (cond
+ ((= dcst ?n)
+ (string-to-number (buffer-substring (match-end 0)
+ (line-end-position))))
+ ((= dcst ?a)
+ (buffer-substring (match-end 0) (line-end-position)))
+ ((= dcst ?t)
+ (if (re-search-forward org-ts-regexp
+ (line-end-position) t)
+ (org-time-string-to-time (match-string 0))
+ now))
+ ((= dcst ?f)
+ (if getkey-func
+ (progn
+ (setq tmp (funcall getkey-func))
+ (if (stringp tmp) (setq tmp (funcall case-func tmp)))
+ tmp)
+ (error "Invalid key function `%s'" getkey-func)))
+ (t (error "Invalid sorting type `%c'" sorting-type)))))
+ (lambda nil
+ (cond
+ ((= dcst ?n)
+ (if (looking-at outline-regexp)
+ (string-to-number (buffer-substring (match-end 0)
+ (line-end-position)))
+ nil))
+ ((= dcst ?a)
+ (funcall case-func (buffer-substring (line-beginning-position)
+ (line-end-position))))
+ ((= dcst ?t)
+ (if (re-search-forward org-ts-regexp
+ (save-excursion
+ (forward-line 2)
+ (point)) t)
+ (org-time-string-to-time (match-string 0))
+ now))
+ ((= dcst ?p)
+ (if (re-search-forward org-priority-regexp (line-end-position) t)
+ (string-to-char (match-string 2))
+ org-default-priority))
+ ((= dcst ?r)
+ (or (org-entry-get nil property) ""))
+ ((= dcst ?f)
+ (if getkey-func
+ (progn
+ (setq tmp (funcall getkey-func))
+ (if (stringp tmp) (setq tmp (funcall case-func tmp)))
+ tmp)
+ (error "Invalid key function `%s'" getkey-func)))
+ (t (error "Invalid sorting type `%c'" sorting-type)))))
+ nil
+ (cond
+ ((= dcst ?a) 'string<)
+ ((= dcst ?t) 'time-less-p)
+ (t nil)))))
+ (message "Sorting entries...done")))
(defun org-do-sort (table what &optional with-case sorting-type)
"Sort TABLE of WHAT according to SORTING-TYPE.
If WITH-CASE is non-nil, the sorting will be case-sensitive."
(unless sorting-type
(message
- "Sort %s: [a]lphabetic. [n]umeric. [t]ime [p]riority. A/N/T/P means reversed:"
+ "Sort %s: [a]lphabetic. [n]umeric. [t]ime. A/N/T means reversed:"
what)
(setq sorting-type (read-char-exclusive)))
(let ((dcst (downcase sorting-type))
(org-time-string-to-time (match-string 0 x)))
0))
comparefun (if (= dcst sorting-type) '< '>)))
- ((= dcst ?p)
- (setq extractfun
- (lambda (x)
- (if (string-match org-priority-regexp x)
- (string-to-char (match-string 2 x))
- org-default-priority))
- comparefun (if (= dcst sorting-type) '< '>)))
(t (error "Invalid sorting type `%c'" sorting-type)))
(sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x)))
(org-beginning-of-item-list)
(org-at-item-p)
(beginning-of-line 1)
- (let ((current (match-string 0)) new)
+ (let ((current (match-string 0))
+ (prevp (eq which 'previous))
+ new)
(setq new (cond
- ((and which (nth (1- which) '("-" "+" "*" "1." "1)"))))
- ((string-match "-" current) "+")
+ ((and (numberp which)
+ (nth (1- which) '("-" "+" "*" "1." "1)"))))
+ ((string-match "-" current) (if prevp "1)" "+"))
((string-match "\\+" current)
- (if (looking-at "\\S-") "1." "*"))
- ((string-match "\\*" current) "1.")
- ((string-match "\\." current) "1)")
- ((string-match ")" current) "-")
+ (if prevp "-" (if (looking-at "\\S-") "1." "*")))
+ ((string-match "\\*" current) (if prevp "+" "1."))
+ ((string-match "\\." current) (if prevp "*" "1)"))
+ ((string-match ")" current) (if prevp "1." "-"))
(t (error "This should not happen"))))
(and (looking-at "\\([ \t]*\\)\\S-+") (replace-match (concat "\\1" new)))
(org-fix-bullet-type)
(when (org-at-item-p) (setq pos (point-at-bol)))))))
(goto-char pos)))
+
+(defun org-end-of-item-list ()
+ "Go to the end of the current item list.
+I.e. to the text after the last item."
+ (interactive)
+ (org-beginning-of-item)
+ (let ((pos (point-at-bol))
+ (ind (org-get-indentation))
+ ind1)
+ ;; find where this list begins
+ (catch 'exit
+ (while t
+ (catch 'next
+ (beginning-of-line 2)
+ (if (looking-at "[ \t]*$")
+ (throw (if (eobp) 'exit 'next) t))
+ (skip-chars-forward " \t") (setq ind1 (current-column))
+ (if (or (< ind1 ind)
+ (and (= ind1 ind)
+ (not (org-at-item-p)))
+ (eobp))
+ (progn
+ (setq pos (point-at-bol))
+ (throw 'exit t))))))
+ (goto-char pos)))
+
+
(defvar org-last-indent-begin-marker (make-marker))
(defvar org-last-indent-end-marker (make-marker))
(orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i"))
(org-defkey orgstruct-mode-map "\C-i"
(orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)]))
-
+
(org-defkey orgstruct-mode-map "\M-\C-m"
(orgstruct-make-binding 'org-insert-heading 105
"\M-\C-m" [(meta return)]))
(org-defkey orgstruct-mode-map [(shift meta return)]
(orgstruct-make-binding 'org-insert-todo-heading 107
[(meta return)] "\M-\C-m"))
-
+
(unless org-local-vars
(setq org-local-vars (org-get-local-variables)))
-
+
t))
(defun orgstruct-make-binding (fun n &rest keys)
(kill-buffer "*Org tmp*")
(delq nil
(mapcar
- (lambda (x)
+ (lambda (x)
(setq x
(if (symbolp x)
(list x)
(this-buffer (current-buffer))
(org-archive-location org-archive-location)
(re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
+ ;; start of variables that will be used for savind context
(file (abbreviate-file-name (buffer-file-name)))
(time (format-time-string
(substring (cdr org-time-stamp-formats) 1 -1)
(current-time)))
afile heading buffer level newfile-p
- category todo priority ltags itags prop)
+ category todo priority
+ ;; start of variables that will be used for savind context
+ ltags itags prop)
;; Try to find a local archive location
(save-excursion
(setq res t)
(push tag current))))
(end-of-line 1)
- (when current
- (insert " :" (mapconcat 'identity (nreverse current) ":") ":"))
- (org-set-tags nil t)
- res)
- (run-hooks 'org-after-tags-change-hook)))
+ (if current
+ (progn
+ (insert " :" (mapconcat 'identity (nreverse current) ":") ":")
+ (org-set-tags nil t))
+ (delete-horizontal-space))
+ (run-hooks 'org-after-tags-change-hook))
+ res))
(defun org-toggle-archive-tag (&optional arg)
"Toggle the archive tag for the current headline.
(interactive "rP")
(let* ((beg (min beg0 end0))
(end (max beg0 end0))
- sep-re re)
+ re)
(goto-char beg)
(beginning-of-line 1)
(setq beg (move-marker (make-marker) (point)))
(org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
dline -1 dline)))
-
(defun org-table-sort-lines (with-case &optional sorting-type)
"Sort table lines according to the column at point.
(defun org-table-formula-substitute-names (f)
"Replace $const with values in string F."
- (let ((start 0) a (f1 f))
+ (message "form %s" f) (sit-for 1)
+ (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?')))
;; First, check for column names
(while (setq start (string-match org-table-column-name-regexp f start))
(setq start (1+ start))
(setq start (1+ start))
(if (setq a (save-match-data
(org-table-get-constant (match-string 1 f))))
- (setq f (replace-match (concat "(" a ")") t t f))))
+ (setq f (replace-match
+ (concat (if pp "(") a (if pp ")")) t t f))))
(if org-table-formula-debug
(put-text-property 0 (length f) :orig-formula f1 f))
f))
(elmo-msgdb-overview-get-entity
msgnum (wl-summary-buffer-msgdb))))
(from (wl-summary-line-from))
- (to (car (elmo-message-entity-field wl-message-entity 'to)))
+ (to (elmo-message-entity-field wl-message-entity 'to))
(subject (let (wl-thr-indent-string wl-parent-message-entity)
(wl-summary-line-subject))))
(org-store-link-props :type "wl" :from from :to to
(if description (concat "[" description "]") "")
"]"))
-(defconst org-link-escape-chars
+(defconst org-link-escape-chars
'((" " . "%20")
("[" . "%5B")
("]" . "%5d")
("\340" . "%E0") ; `a
- ("\342" . "%E2") ; ^a
+ ("\342" . "%E2") ; ^a
("\347" . "%E7") ; ,c
("\350" . "%E8") ; `e
("\351" . "%E9") ; 'e
"Association list of escapes for some characters problematic in links.
This is the list that is used for internal purposes.")
-(defconst org-link-escape-chars-browser
+(defconst org-link-escape-chars-browser
'((" " . "%20"))
"Association list of escapes for some characters problematic in links.
This is the list that is used before handing over to the browser.")
(setq org-stored-links (delq (assoc link org-stored-links)
org-stored-links)))
(setq desc (or desc (nth 1 entry)))))
-
+
(if (string-match org-plain-link-re link)
;; URL-like link, normalize the use of angular brackets.
(setq link (org-make-link (org-remove-angle-brackets link))))
(browse-url-at-point)))))
(move-marker org-open-link-marker nil))
-
;;; File search
(defvar org-create-file-search-functions nil
This function should be placed into `remember-mode-hook' and in fact requires
to be run from that hook to fucntion properly."
(if org-remember-templates
-
- (let* ((char (or use-char
+ (let* ((templates (mapcar (lambda (x)
+ (if (stringp (car x))
+ (append (list (nth 1 x) (car x)) (cddr x))
+ (append (list (car x) "") (cdr x))))
+ org-remember-templates))
+ (char (or use-char
(cond
- ((= (length org-remember-templates) 1)
- (caar org-remember-templates))
+ ((= (length templates) 1)
+ (caar templates))
((and (boundp 'org-force-remember-template-char)
org-force-remember-template-char)
- (if (string-p org-force-remember-template-char)
+ (if (stringp org-force-remember-template-char)
(string-to-char org-force-remember-template-char)
org-force-remember-template-char))
(t
(message "Select template: %s"
(mapconcat
- (lambda (x) (char-to-string (car x)))
- org-remember-templates " "))
- (read-char-exclusive)))))
- (entry (cdr (assoc char org-remember-templates)))
+ (lambda (x)
+ (cond
+ ((not (string-match "\\S-" (nth 1 x)))
+ (format "[%c]" (car x)))
+ ((equal (downcase (car x))
+ (downcase (aref (nth 1 x) 0)))
+ (format "[%c]%s" (car x) (substring (nth 1 x) 1)))
+ (t (format "[%c]%s" (car x) (nth 1 x)))))
+ templates " "))
+ (let ((inhibit-quit t) (char0 (read-char-exclusive)))
+ (when (equal char0 ?\C-g)
+ (jump-to-register remember-register)
+ (kill-buffer remember-buffer))
+ char0)))))
+ (entry (cddr (assoc char templates)))
(tpl (car entry))
(plist-p (if org-store-link-plist t nil))
(file (if (and (nth 1 entry) (stringp (nth 1 entry))
(v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time)))
(v-u (concat "[" (substring v-t 1 -1) "]"))
(v-U (concat "[" (substring v-T 1 -1) "]"))
- (v-i initial) ; defined in `remember-mode'
- (v-a (if (equal annotation "[[]]") "" annotation)) ; likewise
+ ;; `initial' and `annotation' are bound in `remember'
+ (v-i (if (boundp 'initial) initial))
+ (v-a (if (and (boundp 'annotation) annotation)
+ (if (equal annotation "[[]]") "" annotation)
+ ""))
(v-A (if (and v-a
(string-match "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a))
(replace-match "[\\1[%^{Link description}]]" nil nil v-a)
## %s to select file and header location interactively.
## %s \"%s\" -> \"* %s\"
## C-u C-u C-c C-c \"%s\" -> \"* %s\"
-## To switch templates, use `\\[org-remember]'.\n\n"
+## To switch templates, use `\\[org-remember]'. To abort use `C-c C-k'.\n\n"
(if org-remember-store-without-prompt " C-u C-c C-c" " C-c C-c")
(if org-remember-store-without-prompt " C-c C-c" " C-u C-c C-c")
(abbreviate-file-name (or file org-default-notes-file))
(when (string-match "\\S-" ins)
(or (equal (char-before) ?:) (insert ":"))
(insert ins)
- (or (equal (char-after) ?:) (insert ":")))))
+ (or (equal (char-after) ?:) (insert ":")))))
(char
(setq org-time-was-given (equal (upcase char) char))
(setq time (org-read-date (equal (upcase char) "U") t nil
(remember (buffer-substring (point) (mark)))
(call-interactively 'remember))))
+(defvar org-note-abort nil) ; dynamically scoped
+
;;;###autoload
(defun org-remember-handler ()
"Store stuff from remember.el into an org file.
(goto-char (point-max))
(unless (equal (char-before) ?\n) (insert "\n"))
(catch 'quit
+ (if org-note-abort (throw 'quit nil))
(let* ((txt (buffer-substring (point-min) (point-max)))
(fastp (org-xor (equal current-prefix-arg '(4))
org-remember-store-without-prompt))
(org-end-of-subtree t)
(org-paste-subtree level txt))
(t (error "This should not happen"))))
-
+
((and (bobp) (not reversed))
;; Put it at the end, one level below level 1
(save-restriction
(goto-char (point-max))
(if (not (bolp)) (newline))
(org-paste-subtree (org-get-legal-level 1 1) txt)))
-
+
((and (bobp) reversed)
;; Put it at the start, as level 1
(save-restriction
(defconst org-additional-option-like-keywords
'("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX"
- "ORGTBL" "HTML:" "LaTeX:"))
+ "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "DATE:"))
(defun org-complete (&optional arg)
"Perform completion on word at point.
(save-excursion
(org-back-to-heading)
(if (looking-at (concat outline-regexp
- "\\( *\\<" org-comment-string "\\>\\)"))
+ "\\( *\\<" org-comment-string "\\>[ \t]*\\)"))
(replace-match "" t t nil 1)
(if (looking-at outline-regexp)
(progn
(read prop)
(symbol-value var))))
+(defun org-parse-local-options (string var)
+ "Parse STRING for startup setting relevant for variable VAR."
+ (let ((rtn (symbol-value var))
+ e opts)
+ (save-match-data
+ (if (or (not string) (not (string-match "\\S-" string)))
+ rtn
+ (setq opts (delq nil (mapcar (lambda (x)
+ (setq e (assoc x org-startup-options))
+ (if (eq (nth 1 e) var) e nil))
+ (org-split-string string "[ \t]+"))))
+ (if (not opts)
+ rtn
+ (setq rtn nil)
+ (while (setq e (pop opts))
+ (if (not (nth 3 e))
+ (setq rtn (nth 2 e))
+ (if (not (listp rtn)) (setq rtn nil))
+ (push (nth 2 e) rtn)))
+ rtn)))))
+
+(defvar org-blocker-hook nil
+ "Hook for functions that are allowed to block a state change.
+
+Each function gets as its single argument a property list, see
+`org-trigger-hook' for more information about this list.
+
+If any of the functions in this hook returns nil, the state change
+is blocked.")
+
+(defvar org-trigger-hook nil
+ "Hook for functions that are triggered by a state change.
+
+Each function gets as its single argument a property list with at least
+the following elements:
+
+ (:type type-of-change :position pos-at-entry-start
+ :from old-state :to new-state)
+
+Depending on the type, more properties may be present.
+
+This mechanism is currently implemented for:
+
+TODO state changes
+------------------
+:type todo-state-change
+:from previous state (keyword as a string), or nil
+:to new state (keyword as a string), or nil")
+
+
(defun org-todo (&optional arg)
"Change the TODO state of an item.
The state of an item is given by a keyword at the start of the heading,
really is a member of `org-todo-keywords'."
(interactive "P")
(save-excursion
- (org-back-to-heading)
- (if (looking-at outline-regexp) (goto-char (1- (match-end 0))))
- (or (looking-at (concat " +" org-todo-regexp " *"))
- (looking-at " *"))
- (let* ((logging (save-match-data (org-entry-get nil "LOGGING" t)))
- (org-log-done (org-parse-local-options logging 'org-log-done))
- (org-log-repeat (org-parse-local-options logging 'org-log-repeat))
- (this (match-string 1))
- (hl-pos (match-beginning 0))
- (head (org-get-todo-sequence-head this))
- (ass (assoc head org-todo-kwd-alist))
- (interpret (nth 1 ass))
- (done-word (nth 3 ass))
- (final-done-word (nth 4 ass))
- (last-state (or this ""))
- (completion-ignore-case t)
- (member (member this org-todo-keywords-1))
- (tail (cdr member))
- (state (cond
- ((and org-todo-key-trigger
- (or (and (equal arg '(4)) (eq org-use-fast-todo-selection 'prefix))
- (and (not arg) org-use-fast-todo-selection
- (not (eq org-use-fast-todo-selection 'prefix)))))
- ;; Use fast selection
- (org-fast-todo-selection))
- ((and (equal arg '(4))
- (or (not org-use-fast-todo-selection)
- (not org-todo-key-trigger)))
- ;; Read a state with completion
- (completing-read "State: " (mapcar (lambda(x) (list x))
- org-todo-keywords-1)
- nil t))
- ((eq arg 'right)
- (if this
- (if tail (car tail) nil)
- (car org-todo-keywords-1)))
- ((eq arg 'left)
- (if (equal member org-todo-keywords-1)
- nil
+ (catch 'exit
+ (org-back-to-heading)
+ (if (looking-at outline-regexp) (goto-char (1- (match-end 0))))
+ (or (looking-at (concat " +" org-todo-regexp " *"))
+ (looking-at " *"))
+ (let* ((startpos (line-beginning-position))
+ (logging (save-match-data (org-entry-get nil "LOGGING" t)))
+ (org-log-done (org-parse-local-options logging 'org-log-done))
+ (org-log-repeat (org-parse-local-options logging 'org-log-repeat))
+ (this (match-string 1))
+ (hl-pos (match-beginning 0))
+ (head (org-get-todo-sequence-head this))
+ (ass (assoc head org-todo-kwd-alist))
+ (interpret (nth 1 ass))
+ (done-word (nth 3 ass))
+ (final-done-word (nth 4 ass))
+ (last-state (or this ""))
+ (completion-ignore-case t)
+ (member (member this org-todo-keywords-1))
+ (tail (cdr member))
+ (state (cond
+ ((and org-todo-key-trigger
+ (or (and (equal arg '(4)) (eq org-use-fast-todo-selection 'prefix))
+ (and (not arg) org-use-fast-todo-selection
+ (not (eq org-use-fast-todo-selection 'prefix)))))
+ ;; Use fast selection
+ (org-fast-todo-selection))
+ ((and (equal arg '(4))
+ (or (not org-use-fast-todo-selection)
+ (not org-todo-key-trigger)))
+ ;; Read a state with completion
+ (completing-read "State: " (mapcar (lambda(x) (list x))
+ org-todo-keywords-1)
+ nil t))
+ ((eq arg 'right)
(if this
- (nth (- (length org-todo-keywords-1) (length tail) 2)
- org-todo-keywords-1)
- (org-last org-todo-keywords-1))))
- ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
- (setq arg nil))) ; hack to fall back to cycling
- (arg
- ;; user or caller requests a specific state
- (cond
- ((equal arg "") nil)
- ((eq arg 'none) nil)
- ((eq arg 'done) (or done-word (car org-done-keywords)))
- ((eq arg 'nextset)
- (or (car (cdr (member head org-todo-heads)))
- (car org-todo-heads)))
- ((eq arg 'previousset)
- (let ((org-todo-heads (reverse org-todo-heads)))
+ (if tail (car tail) nil)
+ (car org-todo-keywords-1)))
+ ((eq arg 'left)
+ (if (equal member org-todo-keywords-1)
+ nil
+ (if this
+ (nth (- (length org-todo-keywords-1) (length tail) 2)
+ org-todo-keywords-1)
+ (org-last org-todo-keywords-1))))
+ ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
+ (setq arg nil))) ; hack to fall back to cycling
+ (arg
+ ;; user or caller requests a specific state
+ (cond
+ ((equal arg "") nil)
+ ((eq arg 'none) nil)
+ ((eq arg 'done) (or done-word (car org-done-keywords)))
+ ((eq arg 'nextset)
(or (car (cdr (member head org-todo-heads)))
- (car org-todo-heads))))
- ((car (member arg org-todo-keywords-1)))
- ((nth (1- (prefix-numeric-value arg))
+ (car org-todo-heads)))
+ ((eq arg 'previousset)
+ (let ((org-todo-heads (reverse org-todo-heads)))
+ (or (car (cdr (member head org-todo-heads)))
+ (car org-todo-heads))))
+ ((car (member arg org-todo-keywords-1)))
+ ((nth (1- (prefix-numeric-value arg))
org-todo-keywords-1))))
- ((null member) (or head (car org-todo-keywords-1)))
- ((equal this final-done-word) nil) ;; -> make empty
- ((null tail) nil) ;; -> first entry
- ((eq interpret 'sequence)
- (car tail))
- ((memq interpret '(type priority))
- (if (eq this-command last-command)
- (car tail)
- (if (> (length tail) 0)
- (or done-word (car org-done-keywords))
- nil)))
- (t nil)))
- (next (if state (concat " " state " ") " "))
- dostates)
- (replace-match next t t)
- (unless (pos-visible-in-window-p hl-pos)
- (message "TODO state changed to %s" (org-trim next)))
- (unless head
- (setq head (org-get-todo-sequence-head state)
- ass (assoc head org-todo-kwd-alist)
- interpret (nth 1 ass)
- done-word (nth 3 ass)
- final-done-word (nth 4 ass)))
- (when (memq arg '(nextset previousset))
- (message "Keyword-Set %d/%d: %s"
- (- (length org-todo-sets) -1
- (length (memq (assoc state org-todo-sets) org-todo-sets)))
- (length org-todo-sets)
- (mapconcat 'identity (assoc state org-todo-sets) " ")))
- (setq org-last-todo-state-is-todo
- (not (member state org-done-keywords)))
- (when (and org-log-done (not (memq arg '(nextset previousset))))
- (setq dostates (and (listp org-log-done) (memq 'state org-log-done)
- (or (not org-todo-log-states)
- (member state org-todo-log-states))))
-
- (cond
- ((and state (member state org-not-done-keywords)
- (not (member this org-not-done-keywords)))
- ;; This is now a todo state and was not one before
- ;; Remove any CLOSED timestamp, and possibly log the state change
- (org-add-planning-info nil nil 'closed)
- (and dostates (org-add-log-maybe 'state state 'findpos)))
- ((and state dostates)
- ;; This is a non-nil state, and we need to log it
- (org-add-log-maybe 'state state 'findpos))
- ((and (member state org-done-keywords)
- (not (member this org-done-keywords)))
- ;; It is now done, and it was not done before
- (org-add-planning-info 'closed (org-current-time))
- (org-add-log-maybe 'done state 'findpos))))
- ;; Fixup tag positioning
- (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
- (run-hooks 'org-after-todo-state-change-hook)
- (and (member state org-done-keywords) (org-auto-repeat-maybe))
- (if (and arg (not (member state org-done-keywords)))
- (setq head (org-get-todo-sequence-head state)))
- (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)))
- ;; Fixup cursor location if close to the keyword
- (if (and (outline-on-heading-p)
- (not (bolp))
- (save-excursion (beginning-of-line 1)
- (looking-at org-todo-line-regexp))
- (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
- (progn
- (goto-char (or (match-end 2) (match-end 1)))
- (just-one-space))))
+ ((null member) (or head (car org-todo-keywords-1)))
+ ((equal this final-done-word) nil) ;; -> make empty
+ ((null tail) nil) ;; -> first entry
+ ((eq interpret 'sequence)
+ (car tail))
+ ((memq interpret '(type priority))
+ (if (eq this-command last-command)
+ (car tail)
+ (if (> (length tail) 0)
+ (or done-word (car org-done-keywords))
+ nil)))
+ (t nil)))
+ (next (if state (concat " " state " ") " "))
+ (change-plist (list :type 'todo-state-change :from this :to state
+ :position startpos))
+ dostates)
+ (when org-blocker-hook
+ (unless (save-excursion
+ (save-match-data
+ (run-hook-with-args-until-failure
+ 'org-blocker-hook change-plist)))
+ (if (interactive-p)
+ (error "TODO state change from %s to %s blocked" this state)
+ ;; fail silently
+ (message "TODO state change from %s to %s blocked" this state)
+ (throw 'exit nil))))
+ (replace-match next t t)
+ (unless (pos-visible-in-window-p hl-pos)
+ (message "TODO state changed to %s" (org-trim next)))
+ (unless head
+ (setq head (org-get-todo-sequence-head state)
+ ass (assoc head org-todo-kwd-alist)
+ interpret (nth 1 ass)
+ done-word (nth 3 ass)
+ final-done-word (nth 4 ass)))
+ (when (memq arg '(nextset previousset))
+ (message "Keyword-Set %d/%d: %s"
+ (- (length org-todo-sets) -1
+ (length (memq (assoc state org-todo-sets) org-todo-sets)))
+ (length org-todo-sets)
+ (mapconcat 'identity (assoc state org-todo-sets) " ")))
+ (setq org-last-todo-state-is-todo
+ (not (member state org-done-keywords)))
+ (when (and org-log-done (not (memq arg '(nextset previousset))))
+ (setq dostates (and (listp org-log-done) (memq 'state org-log-done)
+ (or (not org-todo-log-states)
+ (member state org-todo-log-states))))
+
+ (cond
+ ((and state (member state org-not-done-keywords)
+ (not (member this org-not-done-keywords)))
+ ;; This is now a todo state and was not one before
+ ;; Remove any CLOSED timestamp, and possibly log the state change
+ (org-add-planning-info nil nil 'closed)
+ (and dostates (org-add-log-maybe 'state state 'findpos)))
+ ((and state dostates)
+ ;; This is a non-nil state, and we need to log it
+ (org-add-log-maybe 'state state 'findpos))
+ ((and (member state org-done-keywords)
+ (not (member this org-done-keywords)))
+ ;; It is now done, and it was not done before
+ (org-add-planning-info 'closed (org-current-time))
+ (org-add-log-maybe 'done state 'findpos))))
+ ;; Fixup tag positioning
+ (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
+ (run-hooks 'org-after-todo-state-change-hook)
+ (and (member state org-done-keywords) (org-auto-repeat-maybe))
+ (if (and arg (not (member state org-done-keywords)))
+ (setq head (org-get-todo-sequence-head state)))
+ (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
+ ;; Fixup cursor location if close to the keyword
+ (if (and (outline-on-heading-p)
+ (not (bolp))
+ (save-excursion (beginning-of-line 1)
+ (looking-at org-todo-line-regexp))
+ (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
+ (progn
+ (goto-char (or (match-end 2) (match-end 1)))
+ (just-one-space)))
+ (when org-trigger-hook
+ (save-excursion
+ (run-hook-with-args 'org-trigger-hook change-plist)))))))
(defun org-get-todo-sequence-head (kwd)
"Return the head of the TODO sequence to which KWD belongs.
(lambda (x)
(if (stringp (car x)) (string-width (car x)) 0))
fulltable)))
- (buf (current-buffer))
(expert nil)
(fwidth (+ maxlen 3 1 3))
(ncol (/ (- (window-width) 4) fwidth))
- tg cnt e c char c1 c2 ntable tbl rtn
+ tg cnt e c tbl
groups ingroup)
(save-window-excursion
(if expert
(org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
(erase-buffer)
(org-set-local 'org-done-keywords done-keywords)
- (setq tbl fulltable char ?a cnt 0)
+ (setq tbl fulltable cnt 0)
(while (setq e (pop tbl))
(cond
((equal e '(:startgroup))
(org-switch-to-buffer-other-window "*Org Note*")
(erase-buffer)
(let ((org-inhibit-startup t)) (org-mode))
- (insert (format "# Insert note for %s, finish with C-c C-c, or cancel with C-u C-c C-c.\n\n"
+ (insert (format "# Insert note for %s.
+# Finish with C-c C-c, or cancel with C-c C-k.\n\n"
(cond
((eq org-log-note-purpose 'clock-out) "stopped clock")
((eq org-log-note-purpose 'done) "closed todo item")
- ((eq org-log-note-purpose 'state) "state change")
+ ((eq org-log-note-purpose 'state)
+ (format "state change to \"%s\"" org-log-note-state))
(t (error "This should not happen")))))
(org-set-local 'org-finish-function 'org-store-log-note))
(note (cdr (assq org-log-note-purpose org-log-note-headings)))
lines ind)
(kill-buffer (current-buffer))
- (if (string-match "^#.*\n[ \t\n]*" txt)
- (setq txt (replace-match "" t t txt)))
+ (while (string-match "\\`#.*\n[ \t\n]*" txt)
+ (setq txt (replace-match "" t t txt)))
(if (string-match "\\s-+\\'" txt)
(setq txt (replace-match "" t t txt)))
(setq lines (org-split-string txt "\n"))
"")))))
(if lines (setq note (concat note " \\\\")))
(push note lines))
- (when current-prefix-arg (setq lines nil))
+ (when (or current-prefix-arg org-note-abort) (setq lines nil))
(when lines
(save-excursion
(set-buffer (marker-buffer org-log-note-marker))
(goto-char org-log-note-marker)
(move-marker org-log-note-marker nil)
(end-of-line 1)
- (if (not (bolp)) (insert "\n")) (indent-relative nil)
+ (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
+ (indent-relative nil)
(insert " - " (pop lines))
(org-indent-line-function)
(beginning-of-line 1)
(move-marker org-log-note-return-to nil)
(and org-log-post-message (message org-log-post-message)))
+;; FIXME: what else would be useful?
+;; - priority
+;; - date
+
+(defun org-sparse-tree (&optional arg)
+ "Create a sparse tree, prompt for the details.
+This command can create sparse trees. You first need to select the type
+of match used to create the tree:
+
+t Show entries with a specific TODO keyword.
+T Show entries selected by a tags match.
+p Enter a property name and its value (both with completion on existing
+ names/values) and show entries with that property.
+r Show entries matching a regular expression"
+ (interactive "P")
+ (let (ans kwd value)
+ (message "Sparse tree: [r]egexp [t]odo-kwd [T]ag [p]roperty")
+ (setq ans (read-char-exclusive))
+ (cond
+ ((equal ans ?t)
+ (org-show-todo-tree '(4)))
+ ((equal ans ?T)
+ (call-interactively 'org-tags-sparse-tree))
+ ((member ans '(?p ?P))
+ (setq kwd (completing-read "Property: "
+ (mapcar 'list (org-buffer-property-keys))))
+ (setq value (completing-read "Value: "
+ (mapcar 'list (org-property-values kwd))))
+ (unless (string-match "\\`{.*}\\'" value)
+ (setq value (concat "\"" value "\"")))
+ (org-tags-sparse-tree arg (concat kwd "=" value)))
+ ((member ans '(?r ?R))
+ (call-interactively 'org-occur))
+ (t (error "No such sparse tree command \"%c\"" ans)))))
+
(defvar org-occur-highlights nil)
(make-variable-buffer-local 'org-occur-highlights)
todo marker entry priority)
(save-excursion
(goto-char (point-min))
- (when (eq action 'sparse-tree) (org-overview))
+ (when (eq action 'sparse-tree)
+ (org-overview)
+ (org-remove-occur-highlights))
(while (re-search-forward re nil t)
(catch :skip
(setq todo (if (match-end 1) (match-string 2))
(not (member org-archive-tag tags-list))))
(and (eq action 'agenda) (org-agenda-skip))
;; list this headline
+
(if (eq action 'sparse-tree)
(progn
+ (and org-highlight-sparse-tree-matches
+ (org-get-heading) (match-end 0)
+ (org-highlight-new-match
+ (match-beginning 0) (match-beginning 1)))
(org-show-context 'tags-tree))
(setq txt (org-format-agenda-item
""
(defvar org-cached-props nil)
(defun org-cached-entry-get (pom property)
- (cdr (assoc property (or org-cached-props
- (setq org-cached-props
- (org-entry-properties pom))))))
+ (if org-use-property-inheritance
+ ;; Caching is not possible, check it directly
+ (org-entry-get pom property 'inherit)
+ ;; Get all properties, so that we can do complicated checks easily
+ (cdr (assoc property (or org-cached-props
+ (setq org-cached-props
+ (org-entry-properties pom)))))))
(defun org-global-tags-completion-table (&optional files)
"Return the list of all tags in all agenda buffer/files."
(setq match (completing-read
"Match: " 'org-tags-completion-function nil nil nil
'org-tags-history))))
-
+
;; Parse the string and create a lisp form
(let ((match0 match)
- (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|\\([[:alnum:]]+\\)=\\({[^}]+}\\|\"[^\"]+\"\\)\\|[[:alnum:]_@]+\\)"))
+ (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)=\\({[^}]+}\\|\"[^\"]+\"\\)\\|[[:alnum:]_@]+\\)"))
minus tag mm
tagsmatch todomatch tagsmatcher todomatcher kwd matcher
orterms term orlist re-p level-p prop-p pn pv)
re-p (equal (string-to-char pv) ?{)
pv (substring pv 1 -1))
(if re-p
- `(string-match ,pv (org-cached-entry-get nil ,pn))
+ `(string-match ,pv (or (org-cached-entry-get nil ,pn) ""))
`(equal ,pv (org-cached-entry-get nil ,pn))))
(t `(member ,(downcase tag) tags-list)))
mm (if minus (list 'not mm) mm)
(while (string-match "[-+&]+" tags)
;; No boolean logic, just a list
(setq tags (replace-match ":" t t tags))))
-
+
(if (string-match "\\`[\t ]*\\'" tags)
(setq tags "")
(unless (string-match ":$" tags) (setq tags (concat tags ":")))
(unless (string-match "^:" tags) (setq tags (concat ":" tags))))
-
+
;; Insert new tags at the correct column
(beginning-of-line 1)
(cond
(setq current (delete tg current))
(loop for g in groups do
(if (member tg g)
- (mapc (lambda (x)
- (setq current (delete x current)))
- g)))
+ (mapcar (lambda (x)
+ (setq current (delete x current)))
+ g)))
(push tg current))
(if exit-after-next (setq exit-after-next 'now))))
(let (tags)
(save-excursion
(goto-char (point-min))
- (while (re-search-forward
+ (while (re-search-forward
(org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t\r\n]") nil t)
(when (equal (char-after (point-at-bol 0)) ?*)
(mapc (lambda (x) (add-to-list 'tags x))
These are properties that are not defined in the property drawer,
but in some other way.")
+(defconst org-default-properties
+ '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION"
+ "LOCATION" "LOGGING" "COLUMNS")
+ "Some properties that are used by Org-mode for various purposes.
+Being in this list makes sure that they are offered for completion.")
+
(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$"
"Regular expression matching the first line of a property drawer.")
(defun org-property-action ()
"Do an action on properties."
(interactive)
- (let (c prop)
+ (let (c)
(org-at-property-p)
- (setq prop (match-string 2))
(message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
(setq c (read-char-exclusive))
(cond
(unless (member key excluded)
(push (cons key (or value "")) props)))))
(append sum-props (nreverse props)))))))
-
+
(defun org-entry-get (pom property &optional inherit)
"Get value of PROPERTY for entry at point-or-marker POM.
If INHERIT is non-nil and the entry does not have the property,
t)
nil)))))
+;; Multi-values properties are properties that contain multiple values
+;; These values are assumed to be single words, separated by whitespace.
+(defun org-entry-add-to-multivalued-property (pom property value)
+ "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM."
+ (let* ((old (org-entry-get pom property))
+ (values (and old (org-split-string old "[ \t]"))))
+ (unless (member value values)
+ (setq values (cons value values))
+ (org-entry-put pom property
+ (mapconcat 'identity values " ")))))
+
+(defun org-entry-remove-from-multivalued-property (pom property value)
+ "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM."
+ (let* ((old (org-entry-get pom property))
+ (values (and old (org-split-string old "[ \t]"))))
+ (when (member value values)
+ (setq values (delete value values))
+ (org-entry-put pom property
+ (mapconcat 'identity values " ")))))
+
+(defun org-entry-member-in-multivalued-property (pom property value)
+ "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?"
+ (let* ((old (org-entry-get pom property))
+ (values (and old (org-split-string old "[ \t]"))))
+ (member value values)))
+
(defvar org-entry-property-inherited-from (make-marker))
(defun org-entry-get-with-inheritance (property)
"Get entry property, and search higher levels if not present."
(let (tmp)
(save-excursion
- (catch 'ex
- (while t
- (when (setq tmp (org-entry-get nil property))
- (org-back-to-heading t)
- (move-marker org-entry-property-inherited-from (point))
- (throw 'ex tmp))
- (or (org-up-heading-safe) (throw 'ex nil)))))
- (or tmp (cdr (assoc property org-local-properties))
- (cdr (assoc property org-global-properties)))))
-
+ (save-restriction
+ (widen)
+ (catch 'ex
+ (while t
+ (when (setq tmp (org-entry-get nil property))
+ (org-back-to-heading t)
+ (move-marker org-entry-property-inherited-from (point))
+ (throw 'ex tmp))
+ (or (org-up-heading-safe) (throw 'ex nil)))))
+ (or tmp (cdr (assoc property org-local-properties))
+ (cdr (assoc property org-global-properties))))))
+
(defun org-entry-put (pom property value)
"Set PROPERTY to VALUE for entry at point-or-marker POM."
(org-with-point-at pom
(cdr range) t)
(add-to-list 'rtn (org-match-string-no-properties 1)))
(outline-next-heading))))
+
(when include-specials
(setq rtn (append org-special-properties rtn)))
+
(when include-defaults
- (add-to-list rtn "CATEGORY")
- (add-to-list rtn "ARCHIVE"))
+ (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties))
+
(sort rtn (lambda (a b) (string< (upcase a) (upcase b))))))
+(defun org-property-values (key)
+ "Return a list of all values of property KEY."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let ((re (concat "^[ \t]*:" key ":[ \t]*\\(\\S-.*\\)"))
+ values)
+ (while (re-search-forward re nil t)
+ (add-to-list 'values (org-trim (match-string 1))))
+ (delete "" values)))))
+
(defun org-insert-property-drawer ()
"Insert a property drawer into the current entry."
(interactive)
(org-back-to-heading t)
- (let ((beg (point))
+ (looking-at outline-regexp)
+ (let ((indent (- (match-end 0)(match-beginning 0)))
+ (beg (point))
(re (concat "^[ \t]*" org-keyword-time-regexp))
end hiddenp)
(outline-next-heading)
(while (re-search-forward re end t))
(setq hiddenp (org-invisible-p))
(end-of-line 1)
- (and (= (char-after) ?\n) (forward-char 1))
+ (and (equal (char-after) ?\n) (forward-char 1))
(org-skip-over-state-notes)
- (end-of-line 0)
- (insert "\n:PROPERTIES:\n:END:")
+ (skip-chars-backward " \t\n\r")
+ (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:"))
(beginning-of-line 0)
- (org-indent-line-function)
+ (indent-to-column indent)
(beginning-of-line 2)
- (org-indent-line-function)
+ (indent-to-column indent)
(beginning-of-line 0)
(if hiddenp
(save-excursion
(org-flag-drawer t))))
(defun org-set-property (property value)
- "In the current entry, set PROPERTY to VALUE."
+ "In the current entry, set PROPERTY to VALUE.
+When called interactively, this will prompt for a property name, offering
+completion on existing and default properties. And then it will prompt
+for a value, offering competion either on allowed values (via an inherited
+xxx_ALL property) or on existing values in other instances of this property
+in the current file."
(interactive
- (let* ((prop (completing-read "Property: "
- (mapcar 'list (org-buffer-property-keys))))
+ (let* ((prop (completing-read
+ "Property: " (mapcar 'list (org-buffer-property-keys nil t))))
(cur (org-entry-get nil prop))
(allowed (org-property-get-allowed-values nil prop 'table))
+ (existing (mapcar 'list (org-property-values prop)))
(val (if allowed
(completing-read "Value: " allowed nil 'req-match)
- (read-string
+ (completing-read
(concat "Value" (if (and cur (string-match "\\S-" cur))
(concat "[" cur "]") "")
": ")
- "" cur))))
+ existing nil nil "" nil cur))))
(list prop (if (equal val "") cur val))))
(unless (equal (org-entry-get nil property) value)
(org-entry-put nil property value)))
(let* ((prop (completing-read
"Property: " (org-entry-properties nil 'standard))))
(list prop)))
- (message (concat "Property " property
+ (message (concat "Property " property
(if (org-entry-delete nil property)
" deleted"
" was not present in the entry"))))
"Remove PROPERTY globally, from all entries."
(interactive
(let* ((prop (completing-read
- "Globally remove property: "
+ "Globally remove property: "
(mapcar 'list (org-buffer-property-keys)))))
(list prop)))
(save-excursion
(let (vals)
(cond
((equal property "TODO")
- (setq vals (org-with-point-at pom
+ (setq vals (org-with-point-at pom
(append org-todo-keywords-1 '("")))))
((equal property "PRIORITY")
(let ((n org-lowest-priority))
((member property org-special-properties))
(t
(setq vals (org-entry-get pom (concat property "_ALL") 'inherit))
-
+
(when (and vals (string-match "\\S-" vals))
(setq vals (car (read-from-string (concat "(" vals ")"))))
(setq vals (mapcar (lambda (x)
(beginning-of-line 1)
(skip-chars-forward " \t")))
+(defun org-find-entry-with-id (ident)
+ "Locate the entry that contains the ID property with exact value IDENT.
+IDENT can be a string, a symbol or a number, this function will search for
+the string representation of it.
+Return the position where this entry starts, or nil if there is no such entry."
+ (let ((id (cond
+ ((stringp ident) ident)
+ ((symbol-name ident) (symbol-name ident))
+ ((numberp ident) (number-to-string ident))
+ (t (error "IDENT %s must be a string, symbol or number" ident))))
+ (case-fold-search nil))
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$")
+ nil t)
+ (org-back-to-heading)
+ (point))))))
+
;;; Column View
(defvar org-columns-overlays nil
(defvar org-columns-current-fmt-compiled nil
"Local variable, holds the currently active column format.
This is the compiled version of the format.")
+(defvar org-columns-current-widths nil
+ "Loval variable, holds the currently widths of fields.")
(defvar org-columns-current-maxwidths nil
"Loval variable, holds the currently active maximum column widths.")
(defvar org-columns-begin-marker (make-marker)
(org-defkey org-columns-map "c" 'org-columns-content)
(org-defkey org-columns-map "o" 'org-overview)
(org-defkey org-columns-map "e" 'org-columns-edit-value)
+(org-defkey org-columns-map "\C-c\C-t" 'org-columns-todo)
+(org-defkey org-columns-map "\C-c\C-c" 'org-columns-set-tags-or-toggle)
(org-defkey org-columns-map "v" 'org-columns-show-value)
(org-defkey org-columns-map "q" 'org-columns-quit)
(org-defkey org-columns-map "r" 'org-columns-redo)
(org-defkey org-columns-map [left] 'backward-char)
+(org-defkey org-columns-map "\M-b" 'backward-char)
(org-defkey org-columns-map "a" 'org-columns-edit-allowed)
(org-defkey org-columns-map "s" 'org-columns-edit-attributes)
-(org-defkey org-columns-map [right] 'forward-char)
+(org-defkey org-columns-map "\M-f" (lambda () (interactive) (goto-char (1+ (point)))))
(org-defkey org-columns-map [right] (lambda () (interactive) (goto-char (1+ (point)))))
(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value)
-(org-defkey org-columns-map "\C-c\C-c" 'org-columns-next-allowed-value)
(org-defkey org-columns-map "n" 'org-columns-next-allowed-value)
(org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value)
(org-defkey org-columns-map "p" 'org-columns-previous-allowed-value)
(beginning-of-line 1)
(and (looking-at "\\(\\**\\)\\(\\* \\)")
(org-get-level-face 2))))
- (color (list :foreground
+ (color (list :foreground
(face-attribute (or level-face 'default) :foreground)))
- props pom property ass width f string ov column)
+ props pom property ass width f string ov column val modval)
;; Check if the entry is in another buffer.
(unless props
(if (eq major-mode 'org-agenda-mode)
(point-at-bol) (point-at-eol))))))
(assoc property props))
width (or (cdr (assoc property org-columns-current-maxwidths))
- (nth 2 column))
+ (nth 2 column)
+ (length property))
f (format "%%-%d.%ds | " width width)
- string (format f (or (cdr ass) "")))
+ val (or (cdr ass) "")
+ modval (if (equal property "ITEM")
+ (org-columns-cleanup-item val org-columns-current-fmt-compiled))
+ string (format f (or modval val)))
;; Create the overlay
(org-unmodified
(setq ov (org-columns-new-overlay
(org-overlay-put ov 'keymap org-columns-map)
(org-overlay-put ov 'org-columns-key property)
(org-overlay-put ov 'org-columns-value (cdr ass))
+ (org-overlay-put ov 'org-columns-value-modified modval)
(org-overlay-put ov 'org-columns-pom pom)
(org-overlay-put ov 'org-columns-format f))
(if (or (not (char-after beg))
(let ((inhibit-read-only t))
(save-excursion
(goto-char beg)
- (insert " ")))))
+ (org-unmodified (insert " ")))))) ;; FIXME: add props and remove later?
;; Make the rest of the line disappear.
(org-unmodified
(setq ov (org-columns-new-overlay beg (point-at-eol)))
(defvar org-columns-inhibit-recalculation nil
"Inhibit recomputing of columns on column view startup.")
+
(defvar header-line-format)
(defun org-columns-display-here-title ()
"Overlay the newline before the current line with the table title."
(interactive)
(let ((fmt org-columns-current-fmt-compiled)
string (title "")
- property width f column str)
+ property width f column str widths)
(while (setq column (pop fmt))
(setq property (car column)
str (or (nth 1 column) property)
width (or (cdr (assoc property org-columns-current-maxwidths))
- (nth 2 column))
+ (nth 2 column)
+ (length str))
+ widths (push width widths)
f (format "%%-%d.%ds | " width width)
string (format f str)
title (concat title string)))
(org-add-props " " nil 'display '(space :align-to 0))
(org-add-props title nil 'face '(:weight bold :underline t))))
(org-set-local 'org-previous-header-line-format header-line-format)
+ (org-set-local 'org-columns-current-widths (nreverse widths))
(setq header-line-format title)))
(defun org-columns-remove-overlays ()
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t)))))))
+(defun org-columns-cleanup-item (item fmt)
+ "Remove from ITEM what is a column in the format FMT."
+ (if (not org-complex-heading-regexp)
+ item
+ (when (string-match org-complex-heading-regexp item)
+ (concat
+ (org-add-props (concat (match-string 1 item) " ") nil
+ 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
+ (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
+ (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
+ " " (match-string 4 item)
+ (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))))
+
(defun org-columns-show-value ()
"Show the full value of the property."
(interactive)
(get-char-property 0 'org-computed val))
(error "This value is computed from the entry's children"))))
-(defun org-columns-edit-value ()
+(defun org-columns-todo (&optional arg)
+ "Change the TODO state during column view."
+ (interactive "P")
+ (org-columns-edit-value "TODO"))
+
+(defun org-columns-set-tags-or-toggle (&optional arg)
+ "Toggle checkbox at point, or set tags for current headline."
+ (interactive "P")
+ (if (string-match "\\`\\[[ xX-]\\]\\'"
+ (get-char-property (point) 'org-columns-value))
+ (org-columns-next-allowed-value)
+ (org-columns-edit-value "TAGS")))
+
+(defun org-columns-edit-value (&optional key)
"Edit the value of the property at point in column view.
Where possible, use the standard interface for changing this line."
(interactive)
(org-columns-check-computed)
- (let* ((col (current-column))
- (key (get-char-property (point) 'org-columns-key))
+ (let* ((external-key key)
+ (col (current-column))
+ (key (or key (get-char-property (point) 'org-columns-key)))
(value (get-char-property (point) 'org-columns-value))
(bol (point-at-bol)) (eol (point-at-eol))
(pom (or (get-text-property bol 'org-hd-marker)
x))
org-columns-overlays)))
nval eval allowed)
- (when (equal key "ITEM")
- (error "Cannot edit item headline from here"))
-
(cond
+ ((equal key "ITEM")
+ (setq eval '(org-with-point-at pom
+ (org-edit-headline))))
((equal key "TODO")
(setq eval '(org-with-point-at pom
- (let ((current-prefix-arg '(4))) (org-todo '(4))))))
+ (let ((current-prefix-arg
+ (if external-key current-prefix-arg '(4))))
+ (call-interactively 'org-todo)))))
((equal key "PRIORITY")
(setq eval '(org-with-point-at pom
(call-interactively 'org-priority))))
(setq eval '(org-entry-put pom key nval)))))
(when eval
(let ((inhibit-read-only t))
- (remove-text-properties (1- bol) eol '(read-only t))
+ (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t))
(unwind-protect
(progn
- (setq org-columns-overlays
+ (setq org-columns-overlays
(org-delete-all line-overlays org-columns-overlays))
(mapc 'org-delete-overlay line-overlays)
(org-columns-eval eval))
(if (nth 3 (assoc key org-columns-current-fmt-compiled))
(org-columns-update key))))
+(defun org-edit-headline () ; FIXME: this is not columns specific
+ "Edit the current headline, the part without TODO keyword, TAGS."
+ (org-back-to-heading)
+ (when (looking-at org-todo-line-regexp)
+ (let ((pre (buffer-substring (match-beginning 0) (match-beginning 3)))
+ (txt (match-string 3))
+ (post "")
+ txt2)
+ (if (string-match (org-re "[ \t]+:[[:alnum:]:_@]+:[ \t]*$") txt)
+ (setq post (match-string 0 txt)
+ txt (substring txt 0 (match-beginning 0))))
+ (setq txt2 (read-string "Edit: " txt))
+ (when (not (equal txt txt2))
+ (beginning-of-line 1)
+ (insert pre txt2 post)
+ (delete-region (point) (point-at-eol))
+ (org-set-tags nil t)))))
+
(defun org-columns-edit-allowed ()
"Edit the list of allowed values for the current property."
(interactive)
- (let* ((col (current-column))
- (key (get-char-property (point) 'org-columns-key))
+ (let* ((key (get-char-property (point) 'org-columns-key))
(key1 (concat key "_ALL"))
- (value (get-char-property (point) 'org-columns-value))
(allowed (org-entry-get (point) key1 t))
nval)
(setq nval (read-string "Allowed: " allowed))
- (org-entry-put
+ (org-entry-put
(cond ((marker-position org-entry-property-inherited-from)
org-entry-property-inherited-from)
((marker-position org-columns-top-level-marker)
(defun org-columns-eval (form)
(let (hidep)
(save-excursion
- (forward-line 1)
+ (beginning-of-line 1)
+ (condition-case nil (next-line 1) (error nil))
(setq hidep (org-on-heading-p 1)))
(eval form)
(and hidep (hide-entry))))
(remove-text-properties (1- bol) eol '(read-only t))
(unwind-protect
(progn
- (setq org-columns-overlays
+ (setq org-columns-overlays
(org-delete-all line-overlays org-columns-overlays))
(mapc 'org-delete-overlay line-overlays)
(org-columns-eval '(org-entry-put pom key nval)))
(< emacs-major-version 22))
(error "Emacs 22 is required for the columns feature")))))
+;; FIXME: does not yet work
+(defun org-columns-follow-link ()
+ (let ((key (get-char-property (point) 'org-columns-key))
+ (value (get-char-property (point) 'org-columns-value)))
+ (if (or (string-match org-bracket-link-regexp value)
+ (string-match org-angle-link-re value)
+ (string-match org-plain-link-re value))
+ (org-open-at-point) ; fixme
+ (error "No link in this value"))))
+
(defun org-columns-get-format-and-top-level ()
(let (fmt)
(when (condition-case nil (org-back-to-heading) (error nil))
(error "Cannot shift this column further to the left"))
(backward-char 1)
(org-columns-move-right)
- (backward-char 1)))
+ (backward-char 1)))
(defun org-columns-store-format ()
"Store the text version of the current columns format in appropriate place.
This is either in the COLUMNS property of the node starting the current column
display, or in the #+COLUMNS line of the current buffer."
- (let (fmt)
+ (let (fmt (cnt 0))
(setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))
+ (org-set-local 'org-columns-current-fmt fmt)
(if (marker-position org-columns-top-level-marker)
(save-excursion
(goto-char org-columns-top-level-marker)
- (if (org-entry-get nil "COLUMNS")
+ (if (and (org-at-heading-p)
+ (org-entry-get nil "COLUMNS"))
(org-entry-put nil "COLUMNS" fmt)
(goto-char (point-min))
+ ;; Overwrite all #+COLUMNS lines....
(while (re-search-forward "^#\\+COLUMNS:.*" nil t)
- (replace-match (concat "#+COLUMNS: " fmt t t)))))
- (setq org-columns-current-fmt fmt))))
+ (setq cnt (1+ cnt))
+ (replace-match (concat "#+COLUMNS: " fmt) t t))
+ (unless (> cnt 0)
+ (goto-char (point-min))
+ (or (org-on-heading-p t) (outline-next-heading))
+ (let ((inhibit-read-only t))
+ (insert-before-markers "#+COLUMNS: " fmt "\n")))
+ (org-set-local 'org-columns-default-format fmt))))))
(defvar org-overriding-columns-format nil
"When set, overrides any other definition.")
(setq pos (org-overlay-start ov))
(goto-char pos)
(when (setq val (cdr (assoc property
- (get-text-property
+ (get-text-property
(point-at-bol) 'org-summaries))))
(setq fmt (org-overlay-get ov 'org-columns-format))
(org-overlay-put ov 'org-columns-value val)
(if flag str val) format))))
(aset lflag level t))
;; clear accumulators for deeper levels
- (loop for l from (1+ level) to (1- lmax) do
+ (loop for l from (1+ level) to (1- lmax) do
(aset lsum l 0)
(aset lflag l nil)))
((>= level last-level)
(setq org-columns-current-fmt-compiled
(nreverse org-columns-current-fmt-compiled))))
+
+;;; Dynamic block for Column view
+
+(defun org-columns-capture-view ()
+ "Get the column view of the current buffer and return it as a list.
+The list will contains the title row and all other rows. Each row is
+a list of fields."
+ (save-excursion
+ (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
+ (n (length title)) row tbl)
+ (goto-char (point-min))
+ (while (re-search-forward "^\\*+ " nil t)
+ (when (get-char-property (match-beginning 0) 'org-columns-key)
+ (setq row nil)
+ (loop for i from 0 to (1- n) do
+ (push (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified)
+ (get-char-property (+ (match-beginning 0) i) 'org-columns-value)
+ "")
+ row))
+ (setq row (nreverse row))
+ (push row tbl)))
+ (append (list title 'hline) (nreverse tbl)))))
+
+(defun org-dblock-write:columnview (params)
+ "Write the column view table.
+PARAMS is a property list of parameters:
+
+:width enforce same column widths with <N> specifiers.
+:id the :ID: property of the entry where the columns view
+ should be built, as a string. When `local', call locally.
+ When `global' call column view with the cursor at the beginning
+ of the buffer (usually this means that the whole buffer switches
+ to column view).
+:hlines When t, insert a hline before each item. When a number, insert
+ a hline before each level <= that number.
+:vlines When t, make each column a colgroup to enforce vertical lines."
+ (let ((pos (move-marker (make-marker) (point)))
+ (hlines (plist-get params :hlines))
+ (vlines (plist-get params :vlines))
+ tbl id idpos nfields tmp)
+ (save-excursion
+ (save-restriction
+ (when (setq id (plist-get params :id))
+ (cond ((not id) nil)
+ ((eq id 'global) (goto-char (point-min)))
+ ((eq id 'local) nil)
+ ((setq idpos (org-find-entry-with-id id))
+ (goto-char idpos))
+ (t (error "Cannot find entry with :ID: %s" id))))
+ (org-columns)
+ (setq tbl (org-columns-capture-view))
+ (setq nfields (length (car tbl)))
+ (org-columns-quit)))
+ (goto-char pos)
+ (move-marker pos nil)
+ (when tbl
+ (when (plist-get params :hlines)
+ (setq tmp nil)
+ (while tbl
+ (if (eq (car tbl) 'hline)
+ (push (pop tbl) tmp)
+ (if (string-match "\\` *\\(\\*+\\)" (caar tbl))
+ (if (and (not (eq (car tmp) 'hline))
+ (or (eq hlines t)
+ (and (numberp hlines) (<= (- (match-end 1) (match-beginning 1)) hlines))))
+ (push 'hline tmp)))
+ (push (pop tbl) tmp)))
+ (setq tbl (nreverse tmp)))
+ (when vlines
+ (setq tbl (mapcar (lambda (x)
+ (if (eq 'hline x) x (cons "" x)))
+ tbl))
+ (setq tbl (append tbl (list (cons "/" (make-list nfields "<>"))))))
+ (setq pos (point))
+ (insert (org-listtable-to-string tbl))
+ (when (plist-get params :width)
+ (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x)))
+ org-columns-current-widths "|")))
+ (goto-char pos)
+ (org-table-align))))
+
+(defun org-listtable-to-string (tbl)
+ "Convert a listtable TBL to a string that contains the Org-mode table.
+The table still need to be alligned. The resulting string has no leading
+and tailing newline characters."
+ (mapconcat
+ (lambda (x)
+ (cond
+ ((listp x)
+ (concat "|" (mapconcat 'identity x "|") "|"))
+ ((eq x 'hline) "|-|")
+ (t (error "Garbage in listtable: %s" x))))
+ tbl "\n"))
+
+(defun org-insert-columns-dblock ()
+ "Create a dynamic block capturing a column view table."
+ (interactive)
+ (let ((defaults '(:name "columnview" :hlines 1))
+ (id (completing-read
+ "Capture columns (local, global, entry with :ID: property) [local]: "
+ (append '(("global") ("local"))
+ (mapcar 'list (org-property-values "ID"))))))
+ (if (equal id "") (setq id 'local))
+ (if (equal id "global") (setq id 'global))
+ (setq defaults (append defaults (list :id id)))
+ (org-create-dblock defaults)
+ (org-update-dblock)))
+
;;;; Timestamps
(defvar org-last-changed-timestamp nil)
22 sept 0:34 --> currentyear-09-22 0:34
12 --> currentyear-currentmonth-12
Fri --> nearest Friday (today or later)
- +4 --> four days from today (only if +N is the only thing given)
etc.
+
+Furthermore you can specify a relative date by giving, as the *first* thing
+in the input: a plus/minus sign, a number and a letter [dwmy] to indicate
+change in days weeks, months, years.
+With a single plus or minus, the date is relative to today. With a double
+plus or minus, it is relative to the date in DEFAULT-TIME. E.g.
+ +4d --> four days from today
+ +4 --> same as above
+ +2w --> two weeks from today
+ ++5 --> five days from default date
+
The function understands only English month and weekday abbreviations,
but this can be configured with the variables `parse-time-months' and
`parse-time-weekdays'.
(if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def))
(prompt (concat (if prompt (concat prompt " ") "")
(format "Date and/or time (default [%s]): " timestr)))
- ans (org-ans0 "") org-ans1 org-ans2 (deltadays 0)
+ ans (org-ans0 "") org-ans1 org-ans2 delta deltan deltaw deltadef
second minute hour day month year tl wday wday1 pm h2 m2)
(cond
(setq ans (read-string prompt "" nil timestr))))
(org-detach-overlay org-date-ovl)
- (if (string-match "^[ \t]*[-+][0-9]+[ \t]*$" org-ans0)
- (setq deltadays (string-to-number ans) ans ""))
+ (when (setq delta (org-read-date-get-relative ans (current-time) def))
+ (setq ans (replace-match "" t t ans)
+ deltan (car delta)
+ deltaw (nth 1 delta)
+ deltadef (nth 2 delta)))
;; Help matching ISO dates with single digit month ot day, like 2006-8-11.
(when (string-match
minute (if (match-end 3)
(string-to-number (match-string 3 ans))
0)
- pm (equal ?p
+ pm (equal ?p
(string-to-char (downcase (match-string 4 ans)))))
(if (and (= hour 12) (not pm))
(setq hour 0)
minute (or (nth 1 tl) (string-to-number (format-time-string "%M" def)))
second (or (nth 0 tl) 0)
wday (nth 6 tl))
- (setq day (+ day deltadays))
+ (when deltan
+ (unless deltadef
+ (let ((now (decode-time (current-time))))
+ (setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
+ (cond ((member deltaw '("d" "")) (setq day (+ day deltan)))
+ ((equal deltaw "w") (setq day (+ day (* 7 deltan))))
+ ((equal deltaw "m") (setq month (+ month deltan)))
+ ((equal deltaw "y") (setq year (+ year deltan)))))
(when (and wday (not (nth 3 tl)))
;; Weekday was given, but no day, so pick that day in the week
;; on or after the derived date.
(format "%04d-%02d-%02d %02d:%02d" year month day hour minute)
(format "%04d-%02d-%02d" year month day)))))
+(defvar parse-time-weekdays)
+
+(defun org-read-date-get-relative (s today default)
+ "Check string S for special relative date string.
+TODAY and DEFAULT are ionternal times, for today and for a default.
+Return shift list (N what def-flag)
+WHAT is \"d\", \"w\", \"m\", or \"y\" for day. week, month, year.
+N is the number if WHATs to shift
+DEF-FLAG is t when a double ++ or -- indicates shift relative to
+ the DEFAULT date rather than TODAY."
+ (when (string-match
+ (concat
+ "\\`[ \t]*\\([-+]\\{1,2\\}\\)?"
+ "\\([0-9]+\\)?"
+ "\\([dwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?"
+ "\\([ \t]\\|$\\)") s)
+ (let* ((dir (if (match-end 1)
+ (string-to-char (substring (match-string 1 s) -1))
+ ?+))
+ (rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1)))))
+ (n (if (match-end 2) (string-to-number (match-string 2 s)) 1))
+ (what (if (match-end 3) (match-string 3 s) "d"))
+ (wday1 (cdr (assoc (downcase what) parse-time-weekdays)))
+ (date (if rel default today))
+ (wday (nth 6 (decode-time date)))
+ delta)
+ (if wday1
+ (progn
+ (setq delta (mod (+ 7 (- wday1 wday)) 7))
+ (if (= dir ?-) (setq delta (- delta 7)))
+ (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7)))))
+ (list delta "d" rel))
+ (list (* n (if (= dir ?-) -1 1)) what rel)))))
+
(defun org-eval-in-calendar (form &optional keepdate)
"Eval FORM in the calendar window and return to current window.
Also, store the cursor date in variable org-ans2."
(let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats))
stamp)
(if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
- (insert (or pre ""))
- (insert (setq stamp (format-time-string fmt time)))
+ (insert-before-markers (or pre ""))
+ (insert-before-markers (setq stamp (format-time-string fmt time)))
(when (listp extra)
(setq extra (car extra))
(if (and (stringp extra)
(setq extra nil)))
(when extra
(backward-char 1)
- (insert extra)
+ (insert-before-markers extra)
(forward-char 1))
- (insert (or post ""))
+ (insert-before-markers (or post ""))
stamp))
(defun org-toggle-time-stamp-overlays ()
(if (> (point) (point-min)) (backward-char 1))
(and (looking-at tsr)
(> (- (match-end 0) pos) -1))))))
- (and (boundp 'org-ts-what)
+ (and ans
+ (boundp 'org-ts-what)
(setq org-ts-what
(cond
+ ((= pos (match-beginning 0)) 'bracket)
+ ((= pos (1- (match-end 0))) 'bracket)
((org-pos-in-match-range pos 2) 'year)
((org-pos-in-match-range pos 3) 'month)
((org-pos-in-match-range pos 7) 'hour)
(t 'day))))
ans))
+(defun org-toggle-timestamp-type ()
+ ""
+ (interactive)
+ (when (org-at-timestamp-p t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (insert (if (equal (char-after) ?<) "[" "<")) (delete-char 1)
+ (goto-char (1- (match-end 0)))
+ (insert (if (equal (char-after) ?>) "]" ">")) (delete-char 1))
+ (message "Timestamp is now %sactive"
+ (if (equal (char-before) ?>) "in" ""))))
+
(defun org-timestamp-change (n &optional what)
"Change the date in the time stamp at point.
The date will be changed by N times WHAT. WHAT can be `day', `month',
ts time time0)
(if (not (org-at-timestamp-p t))
(error "Not at a timestamp"))
- (if (and (not what) (not (eq org-ts-what 'day))
- org-display-custom-times
- (get-text-property (point) 'display)
- (not (get-text-property (1- (point)) 'display)))
- (setq org-ts-what 'day))
- (setq org-ts-what (or what org-ts-what)
- inactive (= (char-after (match-beginning 0)) ?\[)
- ts (match-string 0))
- (replace-match "")
- (if (string-match
- "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( [-+][0-9]+[dwmy]\\)*\\)[]>]"
- ts)
- (setq extra (match-string 1 ts)))
- (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
- (setq with-hm t))
- (setq time0 (org-parse-time-string ts))
- (setq time
- (apply 'encode-time
- (append
- (list (or (car time0) 0))
- (list (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)))
- (list (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)))
- (list (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)))
- (list (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)))
- (list (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)))
- (nthcdr 6 time0))))
- (when (integerp org-ts-what)
- (setq extra (org-modify-ts-extra extra org-ts-what n)))
- (if (eq what 'calendar)
- (let ((cal-date
- (save-excursion
- (save-match-data
- (set-buffer "*Calendar*")
- (calendar-cursor-to-date)))))
- (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
- (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
- (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
- (setcar time0 (or (car time0) 0))
- (setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
- (setcar (nthcdr 2 time0) (or (nth 1 time0) 0))
- (setq time (apply 'encode-time time0))))
- (setq org-last-changed-timestamp
- (org-insert-time-stamp time with-hm inactive nil nil extra))
- (org-clock-update-time-maybe)
- (goto-char pos)
- ;; Try to recenter the calendar window, if any
- (if (and org-calendar-follow-timestamp-change
- (get-buffer-window "*Calendar*" t)
- (memq org-ts-what '(day month year)))
- (org-recenter-calendar (time-to-days time)))))
+ (if (and (not what) (eq org-ts-what 'bracket))
+ (org-toggle-timestamp-type)
+ (if (and (not what) (not (eq org-ts-what 'day))
+ org-display-custom-times
+ (get-text-property (point) 'display)
+ (not (get-text-property (1- (point)) 'display)))
+ (setq org-ts-what 'day))
+ (setq org-ts-what (or what org-ts-what)
+ inactive (= (char-after (match-beginning 0)) ?\[)
+ ts (match-string 0))
+ (replace-match "")
+ (if (string-match
+ "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( [-+][0-9]+[dwmy]\\)*\\)[]>]"
+ ts)
+ (setq extra (match-string 1 ts)))
+ (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
+ (setq with-hm t))
+ (setq time0 (org-parse-time-string ts))
+ (setq time
+ (encode-time (or (car time0) 0)
+ (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))
+ (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))
+ (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))
+ (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))
+ (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))
+ (nthcdr 6 time0)))
+ (when (integerp org-ts-what)
+ (setq extra (org-modify-ts-extra extra org-ts-what n)))
+ (if (eq what 'calendar)
+ (let ((cal-date (org-get-date-from-calendar)))
+ (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
+ (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
+ (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
+ (setcar time0 (or (car time0) 0))
+ (setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
+ (setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
+ (setq time (apply 'encode-time time0))))
+ (setq org-last-changed-timestamp
+ (org-insert-time-stamp time with-hm inactive nil nil extra))
+ (org-clock-update-time-maybe)
+ (goto-char pos)
+ ;; Try to recenter the calendar window, if any
+ (if (and org-calendar-follow-timestamp-change
+ (get-buffer-window "*Calendar*" t)
+ (memq org-ts-what '(day month year)))
+ (org-recenter-calendar (time-to-days time))))))
;; FIXME: does not yet work for lead times
(defun org-modify-ts-extra (s pos n)
(setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx))))
((org-pos-in-match-range pos 5)
(setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s))))))))
-
+
(when ng
(setq s (concat
(substring s 0 (match-beginning ng))
(calendar-goto-today)
(if (and diff (not arg)) (calendar-forward-day diff))))
+(defun org-get-date-from-calendar ()
+ "Return a list (month day year) of date at point in calendar."
+ (with-current-buffer "*Calendar*"
+ (save-match-data
+ (calendar-cursor-to-date))))
+
(defun org-date-from-calendar ()
"Insert time stamp corresponding to cursor date in *Calendar* buffer.
If there is already a time stamp at the cursor position, update it."
(interactive)
- (org-timestamp-change 0 'calendar))
+ (if (org-at-timestamp-p t)
+ (org-timestamp-change 0 'calendar)
+ (let ((cal-date (org-get-date-from-calendar)))
+ (org-insert-time-stamp
+ (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
;; Make appt aware of appointments from the agenda
+;;;###autoload
(defun org-agenda-to-appt (&optional filter)
"Activate appointments found in `org-agenda-files'.
When prefixed, prompt for a regular expression and use it as a
will only add headlines containing IMPORTANT or headlines
belonging to the category \"Work\"."
(interactive "P")
- (require 'org)
+ (require 'calendar)
(if (equal filter '(4))
(setq filter (read-from-minibuffer "Regexp filter: ")))
- (let* ((today (org-date-to-gregorian
+ (let* ((cnt 0) ; count added events
+ (today (org-date-to-gregorian
(time-to-days (current-time))))
- (files org-agenda-files) entries file)
+ (files (org-agenda-files)) entries file)
+ ;; Get all entries which may contain an appt
(while (setq file (pop files))
- (setq entries (append entries (org-agenda-get-day-entries
- file today :timestamp))))
+ (setq entries
+ (append entries
+ (org-agenda-get-day-entries
+ file today
+ :timestamp :scheduled :deadline))))
(setq entries (delq nil entries))
- (mapc
+ ;; Map thru entries and find if they pass thru the filter
+ (mapc
(lambda(x)
(let* ((evt (org-trim (get-text-property 1 'txt x)))
(cat (get-text-property 1 'org-category x))
(tod (get-text-property 1 'time-of-day x))
- (ok (or (and (stringp filter) (string-match filter evt))
- (and (not (null filter)) (listp filter)
- (or (string-match
+ (ok (or (null filter)
+ (and (stringp filter) (string-match filter evt))
+ (and (listp filter)
+ (or (string-match
(cadr (assoc 'category filter)) cat)
- (string-match
+ (string-match
(cadr (assoc 'headline filter)) evt))))))
- ;; (setq evt (set-text-properties 0 (length event) nil evt))
+ ;; FIXME Shall we remove text-properties for the appt text?
+ ;; (setq evt (set-text-properties 0 (length evt) nil evt))
(when (and ok tod)
(setq tod (number-to-string tod)
- tod (when (string-match
+ tod (when (string-match
"\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)" tod)
(concat (match-string 1 tod) ":"
(match-string 2 tod))))
- (appt-add tod evt)))) entries)
- nil))
+ (appt-add tod evt)
+ (setq cnt (1+ cnt))))) entries)
+ (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))
;;; The clock for measuring work time.
(setq total-time (+ (or total-time 0)
org-clock-file-total-minutes)))))))
(goto-char pos)
-
+
(unless (eq scope 'agenda)
(org-clock-sum ts te)
(goto-char (point-min))
(insert-before-markers
"|-\n|"
(if (eq scope 'agenda) "|" "")
- "|"
+ "|"
"*Total time*| "
(format "*%d:%02d*" h m)
"|\n|-\n")
(defvar org-agenda-last-dispatch-buffer nil)
;;;###autoload
-(defun org-agenda (arg)
+(defun org-agenda (arg &optional keys restriction)
"Dispatch agenda commands to collect entries to the agenda buffer.
-Prompts for a character to select a command. Any prefix arg will be passed
+Prompts for a command to execute. Any prefix arg will be passed
on to the selected command. The default selections are:
a Call `org-agenda-list' to display the agenda for current day or week.
searches can be pre-defined in this way.
If the current buffer is in Org-mode and visiting a file, you can also
-first press `1' to indicate that the agenda should be temporarily (until the
-next use of \\[org-agenda]) restricted to the current file."
+first press `<' once to indicate that the agenda should be temporarily
+\(until the next use of \\[org-agenda]) restricted to the current file.
+Pressing `<' twice means to restrict to the current subtree or region
+\(if active)."
(interactive "P")
(catch 'exit
- (let* ((buf (current-buffer))
+ (let* ((prefix-descriptions nil)
+ (org-agenda-custom-commands
+ ;; normalize different versions
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (cond ((stringp (cdr x))
+ (push x prefix-descriptions)
+ nil)
+ ((stringp (nth 1 x)) x)
+ ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
+ (t (cons (car x) (cons "" (cdr x))))))
+ org-agenda-custom-commands)))
+ (buf (current-buffer))
(bfn (buffer-file-name (buffer-base-buffer)))
- (restrict-ok (and bfn (org-mode-p)))
- (custom org-agenda-custom-commands)
- c entry key type match lprops)
+ entry key type match lprops ans)
;; Turn off restriction
(put 'org-agenda-files 'org-restrict nil)
(setq org-agenda-restrict nil)
(put 'org-agenda-redo-command 'org-lprops nil)
;; Remember where this call originated
(setq org-agenda-last-dispatch-buffer (current-buffer))
- (save-window-excursion
- (delete-other-windows)
- (org-switch-to-buffer-other-window " *Agenda Commands*")
- (erase-buffer)
- (insert (eval-when-compile
- (let ((header
-"Press key for an agenda command:
--------------------------------- C Configure custom agenda commands
-a Agenda for current week or day e Export agenda views
-t List of all TODO entries T Entries with special TODO kwd
-m Match a TAGS query M Like m, but only TODO entries
-L Timeline for current buffer # List stuck projects (!=configure)
-")
- (start 0))
- (while (string-match "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" header start)
- (setq start (match-end 0))
- (add-text-properties (match-beginning 2) (match-end 2)
- '(face bold) header))
- header)))
- (while (setq entry (pop custom))
- (setq key (car entry) type (nth 1 entry) match (nth 2 entry))
- (insert (format "\n%-4s%-14s: %s"
- (org-add-props (copy-sequence key)
- '(face bold))
- (cond
- ((stringp type) type)
- ((eq type 'agenda) "Agenda for current week or day")
- ((eq type 'alltodo) "List of all TODO entries")
- ((eq type 'stuck) "List of stuck projects")
- ((eq type 'todo) "TODO keyword")
- ((eq type 'tags) "Tags query")
- ((eq type 'tags-todo) "Tags (TODO)")
- ((eq type 'tags-tree) "Tags tree")
- ((eq type 'todo-tree) "TODO kwd tree")
- ((eq type 'occur-tree) "Occur tree")
- ((functionp type) (symbol-name type))
- (t "???"))
- (if (stringp match)
- (org-add-props match nil 'face 'org-warning)
- (format "set of %d commands" (length match))))))
- (if restrict-ok
- (insert "\n"
- (org-add-props "1 Restrict call to current buffer 0 Restrict call to region or subtree" nil 'face 'org-table)))
- (goto-char (point-min))
- (if (fboundp 'fit-window-to-buffer) (fit-window-to-buffer))
- (message "Press key for agenda command%s"
- (if restrict-ok ", or [1] or [0] to restrict" ""))
- (setq c (read-char-exclusive))
- (message "")
- (when (memq c '(?L ?1 ?0))
- (if restrict-ok
- (put 'org-agenda-files 'org-restrict (list bfn))
- (error "Cannot restrict agenda to current buffer"))
- (with-current-buffer " *Agenda Commands*"
- (goto-char (point-max))
- (delete-region (point-at-bol) (point))
- (goto-char (point-min)))
- (when (eq c ?0)
+ (unless keys
+ (setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
+ keys (car ans)
+ restriction (cdr ans)))
+ ;; Estabish the restriction, if any
+ (when restriction
+ (put 'org-agenda-files 'org-restrict (list bfn))
+ (cond
+ ((eq restriction 'region)
+ (setq org-agenda-restrict t)
+ (move-marker org-agenda-restrict-begin (region-beginning))
+ (move-marker org-agenda-restrict-end (region-end)))
+ ((eq restriction 'subtree)
+ (save-excursion
(setq org-agenda-restrict t)
- (with-current-buffer buf
- (if (org-region-active-p)
- (progn
- (move-marker org-agenda-restrict-begin (region-beginning))
- (move-marker org-agenda-restrict-end (region-end)))
- (save-excursion
- (org-back-to-heading t)
- (move-marker org-agenda-restrict-begin (point))
- (move-marker org-agenda-restrict-end
- (progn (org-end-of-subtree t)))))))
- (unless (eq c ?L)
- (message "Press key for agenda command%s"
- (if restrict-ok " (restricted to current file)" ""))
- (setq c (read-char-exclusive)))
- (message "")))
+ (org-back-to-heading t)
+ (move-marker org-agenda-restrict-begin (point))
+ (move-marker org-agenda-restrict-end
+ (progn (org-end-of-subtree t)))))))
+
(require 'calendar) ; FIXME: can we avoid this for some commands?
;; For example the todo list should not need it (but does...)
(cond
- ((setq entry (assoc (char-to-string c) org-agenda-custom-commands))
- (if (symbolp (nth 1 entry))
+ ((setq entry (assoc keys org-agenda-custom-commands))
+ (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry)))
(progn
- (setq type (nth 1 entry) match (nth 2 entry) lprops (nth 3 entry)
- lprops (nth 3 entry))
+ (setq type (nth 2 entry) match (nth 3 entry) lprops (nth 4 entry))
(put 'org-agenda-redo-command 'org-lprops lprops)
(cond
((eq type 'agenda)
((eq type 'occur-tree)
(org-check-for-org-mode)
(org-let lprops '(org-occur match)))
+ ((functionp type)
+ (org-let lprops '(funcall type match)))
((fboundp type)
(org-let lprops '(funcall type match)))
(t (error "Invalid custom agenda command type %s" type))))
(org-run-agenda-series (nth 1 entry) (cddr entry))))
- ((equal c ?C) (customize-variable 'org-agenda-custom-commands))
- ((equal c ?a) (call-interactively 'org-agenda-list))
- ((equal c ?t) (call-interactively 'org-todo-list))
- ((equal c ?T) (org-call-with-arg 'org-todo-list (or arg '(4))))
- ((equal c ?m) (call-interactively 'org-tags-view))
- ((equal c ?M) (org-call-with-arg 'org-tags-view (or arg '(4))))
- ((equal c ?e) (call-interactively 'org-store-agenda-views))
- ((equal c ?L)
- (unless restrict-ok
+ ((equal keys "C") (customize-variable 'org-agenda-custom-commands))
+ ((equal keys "a") (call-interactively 'org-agenda-list))
+ ((equal keys "t") (call-interactively 'org-todo-list))
+ ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
+ ((equal keys "m") (call-interactively 'org-tags-view))
+ ((equal keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
+ ((equal keys "e") (call-interactively 'org-store-agenda-views))
+ ((equal keys "L")
+ (unless (org-mode-p)
(error "This is not an Org-mode file"))
- (org-call-with-arg 'org-timeline arg))
- ((equal c ?#) (call-interactively 'org-agenda-list-stuck-projects))
- ((equal c ?!) (customize-variable 'org-stuck-projects))
- (t (error "Invalid key"))))))
+ (unless restriction
+ (put 'org-agenda-files 'org-restrict (list bfn))
+ (org-call-with-arg 'org-timeline arg)))
+ ((equal keys "#") (call-interactively 'org-agenda-list-stuck-projects))
+ ((equal keys "/") (call-interactively 'org-occur-in-agenda-files))
+ ((equal keys "!") (customize-variable 'org-stuck-projects))
+ (t (error "Invalid agenda key"))))))
+
+(defun org-agenda-get-restriction-and-command (prefix-descriptions)
+ "The user interface for selecting an agenda command."
+ (catch 'exit
+ (let* ((bfn (buffer-file-name (buffer-base-buffer)))
+ (restrict-ok (and bfn (org-mode-p)))
+ (region-p (org-region-active-p))
+ (custom org-agenda-custom-commands)
+ (selstring "")
+ restriction
+ c entry key type match prefixes rmheader header-end custom1 desc)
+ (save-window-excursion
+ (delete-other-windows)
+ (org-switch-to-buffer-other-window " *Agenda Commands*")
+ (erase-buffer)
+ (insert (eval-when-compile
+ (let ((header
+"Press key for an agenda command: < Buffer,subtree/region restriction
+-------------------------------- C Configure custom agenda commands
+a Agenda for current week or day e Export agenda views
+t List of all TODO entries T Entries with special TODO kwd
+m Match a TAGS query M Like m, but only TODO entries
+L Timeline for current buffer # List stuck projects (!=configure)
+/ Multi-occur
+")
+ (start 0))
+ (while (string-match
+ "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)"
+ header start)
+ (setq start (match-end 0))
+ (add-text-properties (match-beginning 2) (match-end 2)
+ '(face bold) header))
+ header)))
+ (setq header-end (move-marker (make-marker) (point)))
+ (while t
+ (setq custom1 custom)
+ (when (eq rmheader t)
+ (goto-line 1)
+ (re-search-forward ":" nil t)
+ (delete-region (match-end 0) (line-end-position))
+ (forward-char 1)
+ (looking-at "-+")
+ (delete-region (match-end 0) (line-end-position))
+ (move-marker header-end (match-end 0)))
+ (goto-char header-end)
+ (delete-region (point) (point-max))
+ (while (setq entry (pop custom1))
+ (setq key (car entry) desc (nth 1 entry)
+ type (nth 2 entry) match (nth 3 entry))
+ (if (> (length key) 1)
+ (add-to-list 'prefixes (string-to-char key))
+ (insert
+ (format
+ "\n%-4s%-14s: %s"
+ (org-add-props (copy-sequence key)
+ '(face bold))
+ (cond
+ ((string-match "\\S-" desc) desc)
+ ((eq type 'agenda) "Agenda for current week or day")
+ ((eq type 'alltodo) "List of all TODO entries")
+ ((eq type 'stuck) "List of stuck projects")
+ ((eq type 'todo) "TODO keyword")
+ ((eq type 'tags) "Tags query")
+ ((eq type 'tags-todo) "Tags (TODO)")
+ ((eq type 'tags-tree) "Tags tree")
+ ((eq type 'todo-tree) "TODO kwd tree")
+ ((eq type 'occur-tree) "Occur tree")
+ ((functionp type) (if (symbolp type)
+ (symbol-name type)
+ "Lambda expression"))
+ (t "???"))
+ (cond
+ ((stringp match)
+ (org-add-props match nil 'face 'org-warning))
+ (match
+ (format "set of %d commands" (length match)))
+ (t ""))))))
+ (when prefixes
+ (mapcar (lambda (x)
+ (insert
+ (format "\n%s %s"
+ (org-add-props (char-to-string x)
+ nil 'face 'bold)
+ (or (cdr (assoc (concat selstring (char-to-string x))
+ prefix-descriptions))
+ "Prefix key"))))
+ prefixes))
+ (goto-char (point-min))
+ (if (and (fboundp 'fit-window-to-buffer)
+ (not (pos-visible-in-window-p (point-max))))
+ (fit-window-to-buffer))
+ (message "Press key for agenda command%s:"
+ (if restrict-ok
+ (if restriction
+ (format " (restricted to %s)" restriction)
+ " (unrestricted)")
+ ""))
+ (setq c (read-char-exclusive))
+ (message "")
+ (cond
+ ((assoc (char-to-string c) custom)
+ (setq selstring (concat selstring (char-to-string c)))
+ (throw 'exit (cons selstring restriction)))
+ ((memq c prefixes)
+ (setq selstring (concat selstring (char-to-string c))
+ prefixes nil
+ rmheader (or rmheader t)
+ custom (delq nil (mapcar
+ (lambda (x)
+ (if (or (= (length (car x)) 1)
+ (/= (string-to-char (car x)) c))
+ nil
+ (cons (substring (car x) 1) (cdr x))))
+ custom))))
+ ((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
+ (message "Restriction is only possible in Org-mode buffers")
+ (ding) (sit-for 1))
+ ((eq c ?1)
+ (setq restriction 'buffer))
+ ((eq c ?0)
+ (setq restriction (if region-p 'region 'subtree)))
+ ((eq c ?<)
+ (setq restriction
+ (cond
+ ((eq restriction 'buffer)
+ (if region-p 'region 'subtree))
+ ((memq restriction '(subtree region))
+ nil)
+ (t 'buffer))))
+ ((and (equal selstring "") (memq c '(?a ?t ?m ?L ?C ?e ?T ?M ?# ?/)))
+ (throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
+ ((equal c ?q) (error "Abort"))
+ (t (error "Invalid key %c" c))))))))
(defun org-run-agenda-series (name series)
(org-prepare-agenda name)
(let (pars)
(while parameters
(push (list (pop parameters) (if parameters (pop parameters))) pars))
- (if (> (length cmd-key) 1)
+ (if (> (length cmd-key) 2)
(eval (list 'let (nreverse pars)
(list 'org-tags-view nil cmd-key)))
- (flet ((read-char-exclusive () (string-to-char cmd-key)))
- (eval (list 'let (nreverse pars) '(org-agenda nil)))))
+ (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key))))
(set-buffer org-agenda-buffer-name)
(princ (org-encode-for-stdout (buffer-string)))))
(while parameters
(push (list (pop parameters) (if parameters (pop parameters))) pars))
(push (list 'org-agenda-remove-tags t) pars)
- (if (> (length cmd-key) 1)
+ (if (> (length cmd-key) 2)
(eval (list 'let (nreverse pars)
(list 'org-tags-view nil cmd-key)))
- (flet ((read-char-exclusive () (string-to-char cmd-key)))
- (eval (list 'let (nreverse pars) '(org-agenda nil)))))
+ (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key))))
(set-buffer org-agenda-buffer-name)
(let* ((lines (org-split-string (buffer-string) "\n"))
line)
files (nth 4 cmd))
(if (stringp files) (setq files (list files)))
(when files
- (flet ((read-char-exclusive () (string-to-char thiscmdkey)))
- (eval (list 'let (append org-agenda-exporter-settings opts pars)
- '(org-agenda nil))))
+ (eval (list 'let (append org-agenda-exporter-settings opts pars)
+ (list 'org-agenda nil thiscmdkey)))
(set-buffer org-agenda-buffer-name)
(while files
(eval (list 'let (append org-agenda-exporter-settings opts pars)
"Fit the window to the buffer size."
(and (memq org-agenda-window-setup '(reorganize-frame))
(fboundp 'fit-window-to-buffer)
- (fit-window-to-buffer nil (/ (* (frame-height) 3) 4)
- (/ (frame-height) 2))))
+ (fit-window-to-buffer
+ nil
+ (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
+ (floor (* (frame-height) (car org-agenda-window-frame-fractions))))))
;;; Agenda file list
((stringp org-agenda-files) (org-read-agenda-file-list))
((listp org-agenda-files) org-agenda-files)
(t (error "Invalid value of `org-agenda-files'")))))
+ (setq files (apply 'append
+ (mapcar (lambda (f)
+ (if (file-directory-p f)
+ (directory-files f t "\\.org\\'")
+ (list f)))
+ files)))
(if org-agenda-skip-unavailable-files
(delq nil
(mapcar (function
(if (and (boundp 'org-agenda-view-columns-initially)
org-agenda-view-columns-initially)
(org-agenda-columns))
+ (when org-agenda-fontify-priorities
+ (org-fontify-priorities))
(run-hooks 'org-finalize-agenda-hook))))
+(defun org-fontify-priorities ()
+ "Make highest priority lines bold, and lowest italic."
+ (interactive)
+ (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority)
+ (org-delete-overlay o)))
+ (overlays-in (point-min) (point-max)))
+ (save-excursion
+ (let ((ovs (org-overlays-in (point-min) (point-max)))
+ (inhibit-read-only t)
+ b e p ov h l)
+ (goto-char (point-min))
+ (while (re-search-forward "\\[#\\(.\\)\\]" nil t)
+ (setq h (or (get-char-property (point) 'org-highest-priority)
+ org-highest-priority)
+ l (or (get-char-property (point) 'org-lowest-priority)
+ org-lowest-priority)
+ p (string-to-char (match-string 1))
+ b (match-beginning 0) e (line-end-position)
+ ov (org-make-overlay b e))
+ (org-overlay-put
+ ov 'face
+ (cond ((listp org-agenda-fontify-priorities)
+ (cdr (assoc p org-agenda-fontify-priorities)))
+ ((equal p l) 'italic)
+ ((equal p h) 'bold)))
+ (org-overlay-put ov 'org-type 'org-priority)))))
+
(defun org-prepare-agenda-buffers (files)
"Create buffers for all agenda files, protect archived trees and comments."
(interactive)
;;; Agenda timeline
+(defvar org-agenda-only-exact-dates nil) ; dynamically scoped
+
(defun org-timeline (&optional include-all)
"Show a time-sorted view of the entries in the current org file.
Only entries with a time stamp of today or later will be listed. With
(day-numbers (org-get-all-dates beg end 'no-ranges
t doclosed ; always include today
org-timeline-show-empty-dates))
+ (org-deadline-warning-days 0)
+ (org-agenda-only-exact-dates t)
(today (time-to-days (current-time)))
(past t)
args
(file-name-nondirectory buffer-file-name)))
(if doclosed (push :closed args))
(push :timestamp args)
+ (push :deadline args)
+ (push :scheduled args)
(push :sexp args)
(if dotodo (push :todo args))
(while (setq d (pop day-numbers))
(d (- nt n1)))
(- sd (+ (if (< d 0) 7 0) d)))))
(day-numbers (list start))
+ (day-cnt 0)
(inhibit-redisplay (not debug-on-error))
s e rtn rtnall file date d start-pos end-pos todayp nd)
(setq org-agenda-redo-command
(setq rtnall (append rtnall rtn))))
(if (or rtnall org-agenda-show-all-dates)
(progn
+ (setq day-cnt (1+ day-cnt))
(insert
(if (stringp org-agenda-format-date)
(format-time-string org-agenda-format-date
"\n")
(put-text-property s (1- (point)) 'face 'org-agenda-structure)
(put-text-property s (1- (point)) 'org-date-line t)
+ (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
(if todayp (put-text-property s (1- (point)) 'org-today t))
(if rtnall (insert
(org-finalize-agenda-entries
(org-agenda-add-time-grid-maybe
rtnall nd todayp))
"\n"))
- (put-text-property s (1- (point)) 'day d))))
+ (put-text-property s (1- (point)) 'day d)
+ (put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
(goto-char (point-min))
(org-fit-agenda-window)
(unless (and (pos-visible-in-window-p (point-min))
;; FIXME: this works only if the cursor is *not* at the
;; beginning of the entry
+;(defun org-entry-is-done-p ()
+; "Is the current entry marked DONE?"
+; (save-excursion
+; (and (re-search-backward "[\r\n]\\*+ " nil t)
+; (looking-at org-nl-done-regexp))))
+
+(defun org-entry-is-todo-p ()
+ (member (org-get-todo-state) org-not-done-keywords))
+
(defun org-entry-is-done-p ()
- "Is the current entry marked DONE?"
+ (member (org-get-todo-state) org-done-keywords))
+
+(defun org-get-todo-state ()
(save-excursion
- (and (re-search-backward "[\r\n]\\*+ " nil t)
- (looking-at org-nl-done-regexp))))
+ (org-back-to-heading t)
+ (and (looking-at org-todo-line-regexp)
+ (match-end 2)
+ (match-string 2))))
(defun org-at-date-range-p (&optional inactive-ok)
"Is the cursor inside a date range?"
(save-match-data
(beginning-of-line)
(setq beg (point) end (progn (outline-next-heading) (point)))
- (when (or (and org-agenda-todo-ignore-scheduled (goto-char beg)
+ (when (or (and org-agenda-todo-ignore-with-date (goto-char beg)
+ (re-search-forward org-ts-regexp end t))
+ (and org-agenda-todo-ignore-scheduled (goto-char beg)
(re-search-forward org-scheduled-time-regexp end t))
(and org-agenda-todo-ignore-deadlines (goto-char beg)
(re-search-forward org-deadline-time-regexp end t)
;; When to show a deadline in the calendar:
;; If the expiration is within wdays warning time.
;; Past-due deadlines are only shown on the current date
- (if (or (and (<= diff wdays) todayp)
+ (if (or (and (<= diff wdays)
+ (and todayp (not org-agenda-only-exact-dates)))
(= diff 0))
(save-excursion
(setq category (org-get-category))
(setq txt nil)
(setq txt (org-format-agenda-item
(if (= diff 0)
- "Deadline: "
- (format "In %3d d.: " diff))
+ (car org-agenda-deadline-leaders)
+ (format (nth 1 org-agenda-deadline-leaders)
+ diff))
head category tags timestr))))
(setq txt org-agenda-no-heading-message))
(when txt
(setq pastschedp (and todayp (< diff 0)))
;; When to show a scheduled item in the calendar:
;; If it is on or past the date.
- (if (or (and (< diff 0) todayp)
+ (if (or (and (< diff 0)
+ (and todayp (not org-agenda-only-exact-dates)))
(= diff 0))
(save-excursion
(setq category (org-get-category))
(setq txt nil)
(setq txt (org-format-agenda-item
(if (= diff 0)
- "Scheduled: "
- (format "Sched.%2dx: " (- 1 diff)))
+ (car org-agenda-scheduled-leaders)
+ (format (nth 1 org-agenda-scheduled-leaders)
+ (- 1 diff)))
head category tags timestr))))
(setq txt org-agenda-no-heading-message))
(when txt
;; 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)
+ (not (equal ?\] (string-to-char (substring txt (match-end 0)))))
(if (eq org-agenda-remove-times-when-in-prefix 'beg)
(= (match-beginning 0) 0)
t))
;; And finally add the text properties
(org-add-props rtn nil
'org-category (downcase category) 'tags tags
+ 'org-highest-priority org-highest-priority
+ 'org-lowest-priority org-lowest-priority
'prefix-length (- (length rtn) (length txt))
'time-of-day time-of-day
'txt txt
HH:MM."
(save-match-data
(when
- (or
- (string-match
- "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
- (string-match
- "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
+ (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
+ (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
(let* ((h (string-to-number (match-string 1 s)))
(m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
(ampm (if (match-end 4) (downcase (match-string 4 s))))
(setf (nth 1 org-agenda-overriding-arguments) (car comp))
(setf (nth 2 org-agenda-overriding-arguments) (cdr comp))
(org-agenda-redo)
- (org-agenda-find-today-or-agenda)))
+ (org-agenda-find-same-or-today-or-agenda)))
(t (error "Cannot find today")))))
-(defun org-agenda-find-today-or-agenda ()
+(defun org-agenda-find-same-or-today-or-agenda (&optional cnt)
(goto-char
- (or (text-property-any (point-min) (point-max) 'org-today t)
+ (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt))
+ (text-property-any (point-min) (point-max) 'org-today t)
(text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
(point-min))))
(let* ((span org-agenda-span)
(sd org-starting-day)
(greg (calendar-gregorian-from-absolute sd))
+ (cnt (get-text-property (point) 'org-day-cnt))
greg2 nd)
(cond
((eq span 'day)
(setq nd (- (calendar-absolute-from-gregorian greg2) sd))))
(let ((org-agenda-overriding-arguments
(list (car org-agenda-last-arguments) sd nd t)))
- (org-agenda-redo)
- (org-agenda-find-today-or-agenda))))
-
+ (org-agenda-redo)
+ (org-agenda-find-same-or-today-or-agenda cnt))))
+
(defun org-agenda-earlier (arg)
"Go backward in time by the current span.
With prefix ARG, go backward that many times the current span."
(list (car org-agenda-last-arguments)
(car computed) (cdr computed) t)))
(org-agenda-redo)
- (org-agenda-find-today-or-agenda))
+ (org-agenda-find-same-or-today-or-agenda))
(org-agenda-set-mode-name)
(message "Switched to %s view" span))
(defun org-agenda-open-link ()
"Follow the link in the current line, if any."
(interactive)
- (let ((eol (point-at-eol)))
- (save-excursion
- (if (or (re-search-forward org-bracket-link-regexp eol t)
- (re-search-forward org-angle-link-re eol t)
- (re-search-forward org-plain-link-re eol t))
- (call-interactively 'org-open-at-point)
- (error "No link in current line")))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point-at-bol) (point-at-eol))
+ (org-open-at-point))))
(defun org-agenda-switch-to (&optional delete-other-windows)
"Go to the Org-mode file which contains the item at point."
(save-excursion
(org-back-to-heading t)
(if (looking-at
- (if no-tags
+ (if no-tags
(org-re "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@]+:[ \t]*\\)?$")
"\\*+[ \t]+\\([^\r\n]*\\)"))
(match-string 1) "")))
(:emphasize . org-export-with-emphasize)
(:sub-superscript . org-export-with-sub-superscripts)
(:footnotes . org-export-with-footnotes)
- (:property-drawer . org-export-with-property-drawer)
+ (:drawers . org-export-with-drawers)
+ (:tags . org-export-with-tags)
(:TeX-macros . org-export-with-TeX-macros)
(:LaTeX-fragments . org-export-with-LaTeX-fragments)
(:skip-before-1st-heading . org-export-skip-text-before-1st-heading)
("|" . :tables)
("^" . :sub-superscript)
("f" . :footnotes)
- ("p" . :property-drawer)
+ ("d" . :drawers)
+ ("tags" . :tags)
("*" . :emphasize)
("TeX" . :TeX-macros)
("LaTeX" . :LaTeX-fragments)
b (org-end-of-subtree t))
(if (> b a) (delete-region a b)))))
- ;; Get rid of property drawers
- (unless org-export-with-property-drawer
+ ;; Get rid of drawers
+ (unless (eq t org-export-with-drawers)
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*:PROPERTIES:[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n" nil t)
- (replace-match "")))
+ (let ((re (concat "^[ \t]*:\\("
+ (mapconcat 'identity
+ (if (listp org-export-with-drawers)
+ org-export-with-drawers
+ org-drawers)
+ "\\|")
+ "\\):[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n")))
+ (while (re-search-forward re nil t)
+ (replace-match ""))))
;; Find targets in comments and move them out of comments,
;; but mark them as targets that should be invisible
(setq fmt (pop formatters))
(when (car fmt)
(goto-char (point-min))
- (while (re-search-forward (concat "^#\\+" (cadr fmt)
+ (while (re-search-forward (concat "^#\\+" (cadr fmt)
":[ \t]*\\(.*\\)") nil t)
(replace-match "\\1" t)
(add-text-properties
'(org-protected t))))
(goto-char (point-min))
(while (re-search-forward
- (concat "^#\\+"
+ (concat "^#\\+"
(caddr fmt) "\\>.*\\(\\(\n.*\\)*?\n\\)#\\+"
(cadddr fmt) "\\>.*\n?") nil t)
(if (car fmt)
(add-text-properties (point) (1+ (point-at-eol))
(list :org-license-to-kill t)))))
title))
-
+
(defun org-solidify-link-text (s &optional alist)
"Take link text and make a safe target out of it."
(save-match-data
(fundamental-mode)
;; create local variables for all options, to make sure all called
;; functions get the correct information
- (mapc (lambda (x)
- (set (make-local-variable (cdr x))
- (plist-get opt-plist (car x))))
- org-export-plist-vars)
+ (mapcar (lambda (x)
+ (set (make-local-variable (cdr x))
+ (plist-get opt-plist (car x))))
+ org-export-plist-vars)
(org-set-local 'org-odd-levels-only odd)
(setq umax (if arg (prefix-numeric-value arg)
org-export-headline-levels))
(progn
(push (concat (nth 3 lang-words) "\n") thetoc)
(push (concat (make-string (length (nth 3 lang-words)) ?=) "\n") thetoc)
- (mapc '(lambda (line)
- (if (string-match org-todo-line-regexp
- line)
- ;; This is a headline
- (progn
- (setq have-headings t)
- (setq level (- (match-end 1) (match-beginning 1))
- level (org-tr-level level)
- txt (match-string 3 line)
- todo
- (or (and org-export-mark-todo-in-toc
- (match-beginning 2)
- (not (member (match-string 2 line)
- org-done-keywords)))
+ (mapcar '(lambda (line)
+ (if (string-match org-todo-line-regexp
+ line)
+ ;; This is a headline
+ (progn
+ (setq have-headings t)
+ (setq level (- (match-end 1) (match-beginning 1))
+ level (org-tr-level level)
+ txt (match-string 3 line)
+ todo
+ (or (and org-export-mark-todo-in-toc
+ (match-beginning 2)
+ (not (member (match-string 2 line)
+ org-done-keywords)))
; TODO, not DONE
- (and org-export-mark-todo-in-toc
- (= level umax-toc)
+ (and org-export-mark-todo-in-toc
+ (= level umax-toc)
(org-search-todo-below
line lines level))))
- (setq txt (org-html-expand-for-ascii txt))
-
- (if (and (memq org-export-with-tags '(not-in-toc nil))
- (string-match
- (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
- txt))
- (setq txt (replace-match "" t t txt)))
- (if (string-match quote-re0 txt)
- (setq txt (replace-match "" t t txt)))
-
- (if org-export-with-section-numbers
- (setq txt (concat (org-section-number level)
- " " txt)))
- (if (<= level umax-toc)
- (progn
- (push
- (concat
- (make-string
- (* (max 0 (- level org-min-level)) 4) ?\ )
- (format (if todo "%s (*)\n" "%s\n") txt))
- thetoc)
- (setq org-last-level level))
- ))))
- lines)
+ (setq txt (org-html-expand-for-ascii txt))
+
+ (while (string-match org-bracket-link-regexp txt)
+ (setq txt
+ (replace-match
+ (match-string (if (match-end 2) 3 1) txt)
+ t t txt)))
+
+ (if (and (memq org-export-with-tags '(not-in-toc nil))
+ (string-match
+ (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
+ txt))
+ (setq txt (replace-match "" t t txt)))
+ (if (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt)))
+
+ (if org-export-with-section-numbers
+ (setq txt (concat (org-section-number level)
+ " " txt)))
+ (if (<= level umax-toc)
+ (progn
+ (push
+ (concat
+ (make-string
+ (* (max 0 (- level org-min-level)) 4) ?\ )
+ (format (if todo "%s (*)\n" "%s\n") txt))
+ thetoc)
+ (setq org-last-level level))
+ ))))
+ lines)
(setq thetoc (if have-headings (nreverse thetoc) nil))))
(org-init-section-numbers)
(or (looking-at "[ \t]*\n[ \t]*\n")
(insert "\n\n")))
+ ;; Convert whitespace place holders
+ (goto-char (point-min))
+ (let (beg end)
+ (while (setq beg (next-single-property-change (point) 'org-whitespace))
+ (setq end (next-single-property-change beg 'org-whitespace))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (make-string (- end beg) ?\ ))))
+
(save-buffer)
;; remove display and invisible chars
(let (beg end)
#+EMAIL: %s
#+LANGUAGE: %s
#+TEXT: Some descriptive text to be emitted. Several lines OK.
-#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s f:%s *:%s TeX:%s LaTeX:%s skip:%s p:%s
+#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s f:%s *:%s TeX:%s LaTeX:%s skip:%s d:%s tags:%s
#+CATEGORY: %s
#+SEQ_TODO: %s
#+TYP_TODO: %s
#+PRIORITIES: %c %c %c
+#+DRAWERS: %s
#+STARTUP: %s %s %s %s %s
#+TAGS: %s
#+ARCHIVE: %s
org-export-with-TeX-macros
org-export-with-LaTeX-fragments
org-export-skip-text-before-1st-heading
- org-export-with-property-drawer
+ org-export-with-drawers
+ org-export-with-tags
(file-name-nondirectory buffer-file-name)
"TODO FEEDBACK VERIFY DONE"
"Me Jason Marie DONE"
org-highest-priority org-lowest-priority org-default-priority
+ (mapconcat 'identity org-drawers " ")
(cdr (assoc org-startup-folded
'((nil . "showall") (t . "overview") (content . "content"))))
(if org-odd-levels-only "odd" "oddeven")
(save-excursion
(org-back-to-heading)
(if (looking-at (concat outline-regexp
- "\\( *\\<" org-quote-string "\\>\\)"))
+ "\\( *\\<" org-quote-string "\\>[ \t]*\\)"))
(replace-match "" t t nil 1)
(if (looking-at outline-regexp)
(progn
(org-odd-levels-only odd))
;; create local variables for all options, to make sure all called
;; functions get the correct information
- (mapc (lambda (x)
- (set (make-local-variable (cdr x))
- (plist-get opt-plist (car x))))
- org-export-plist-vars)
+ (mapcar (lambda (x)
+ (set (make-local-variable (cdr x))
+ (plist-get opt-plist (car x))))
+ org-export-plist-vars)
(setq umax (if arg (prefix-numeric-value arg)
org-export-headline-levels))
(setq umax-toc (if (integerp org-export-with-toc)
(= level umax-toc)
(org-search-todo-below
line lines level))))
- (if (and (memq org-export-with-tags '(not-in-toc nil))
- (string-match
- (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
- txt))
- (setq txt (replace-match "" t t txt)))
+ (if (string-match
+ (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
+ (setq txt (replace-match " <span class=\"tag\"> \\1</span>" t nil txt)))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt)))
(if org-export-with-section-numbers
(if (and (string-match org-todo-line-regexp line)
(match-beginning 2))
- (setq line
+ (setq line
(concat (substring line 0 (match-beginning 2))
"<span class=\""
(if (member (match-string 2 line)
(pop local-list-num))
(setq local-list-indent nil
in-local-list nil))
- (org-html-level-start 1 nil umax
+ (org-html-level-start 0 nil umax
(and org-export-with-toc (<= level umax))
head-count)
(unless body-only
(when (plist-get opt-plist :auto-postamble)
+ (insert "<div id=\"postamble\">")
(when (and org-export-author-info author)
(insert "<p class=\"author\"> "
(nth 1 lang-words) ": " author "\n")
(when (and date org-export-time-stamp-file)
(insert "<p class=\"date\"> "
(nth 2 lang-words) ": "
- date "</p>\n")))
+ date "</p>\n"))
+ (insert "</div>"))
(if org-export-html-with-timestamp
(insert org-export-html-html-helper-timestamp))
(when (looking-at "\\s-*</p>")
(goto-char (match-end 0))
(insert "\n")))
- (mapc 'insert thetoc))
+ (insert "<div id=\"table-of-contents\">\n")
+ (mapc 'insert thetoc)
+ (insert "</div>\n"))
;; remove empty paragraphs and lists
(goto-char (point-min))
(while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
(goto-char (point-min))
(while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t)
(replace-match ""))
+ ;; Convert whitespace place holders
+ (goto-char (point-min))
+ (let (beg end n)
+ (while (setq beg (next-single-property-change (point) 'org-whitespace))
+ (setq n (get-text-property beg 'org-whitespace)
+ end (next-single-property-change beg 'org-whitespace))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (format "<span style=\"visibility:hidden;\">%s</span>"
+ (make-string n ?x)))))
+
(or to-buffer (save-buffer))
(goto-char (point-min))
(message "Exporting... done")
(lambda (x)
(setq gr (pop org-table-colgroup-info))
(format "%s<COL align=\"%s\"></COL>%s"
- (if (memq gr '(:start :startend))
+ (if (memq gr '(:start :startend))
(prog1
(if colgropen "</colgroup>\n<colgroup>" "<colgroup>")
(setq colgropen t))
"")
(if (> (/ (float x) nlines) org-table-number-fraction)
"right" "left")
- (if (memq gr '(:end :startend))
+ (if (memq gr '(:end :startend))
(progn (setq colgropen nil) "</colgroup>")
"")))
fnum "")
(defun org-export-cleanup-toc-line (s)
"Remove tags and time staps from lines going into the toc."
- (if (string-match (org-re " +:[[:alnum:]_@:]+: *$") s)
- (setq s (replace-match "" t t s)))
+ (when (memq org-export-with-tags '(not-in-toc nil))
+ (if (string-match (org-re " +:[[:alnum:]_@:]+: *$") s)
+ (setq s (replace-match "" t t s))))
(when org-export-remove-timestamps-from-toc
(while (string-match org-maybe-keyword-time-regexp s)
(setq s (replace-match "" t t s))))
(defun org-html-expand (string)
"Prepare STRING for HTML export. Applies all active conversions.
If there are links in the string, don't modify these."
- (let* (m s l res)
- (while (setq m (string-match org-bracket-link-regexp string))
+ (let* ((re (concat org-bracket-link-regexp "\\|"
+ (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$")))
+ m s l res)
+ (while (setq m (string-match re string))
(setq s (substring string 0 m)
l (match-string 0 string)
string (substring string (match-end 0)))
"Insert a new level in HTML export.
When TITLE is nil, just close all open levels."
(org-close-par-maybe)
- (let ((l (1+ (max level umax))))
- (while (<= l org-level-max)
+ (let ((l org-level-max))
+ (while (>= l (1+ level))
(if (aref org-levels-open (1- l))
(progn
- (org-html-level-close l)
+ (org-html-level-close l umax)
(aset org-levels-open (1- l) nil)))
- (setq l (1+ l)))
+ (setq l (1- l)))
(when title
;; If title is nil, this means this function is called to close
;; all levels, so the rest is done only if title is given
(aset org-levels-open (1- level) t)
(org-close-par-maybe)
(insert "<ul>\n<li>" title "<br/>\n")))
+ (aset org-levels-open (1- level) t)
(if (and org-export-with-section-numbers (not body-only))
(setq title (concat (org-section-number level) " " title)))
(setq level (+ level org-export-html-toplevel-hlevel -1))
(if with-toc
- (insert (format "\n<h%d id=\"sec-%d\">%s</h%d>\n"
- level head-count title level))
- (insert (format "\n<h%d>%s</h%d>\n" level title level)))
+ (insert (format "\n<div class=\"outline-%d\">\n<h%d id=\"sec-%d\">%s</h%d>\n"
+ level level head-count title level))
+ (insert (format "\n<div class=\"outline-%d\">\n<h%d>%s</h%d>\n" level level title level)))
(org-open-par)))))
-(defun org-html-level-close (&rest args)
+(defun org-html-level-close (level max-outline-level)
"Terminate one level in HTML export."
- (org-close-li)
- (insert "</ul>\n"))
+ (if (<= level max-outline-level)
+ (insert "</div>\n")
+ (org-close-li)
+ (insert "</ul>\n")))
;;; iCalendar export
(unless (featurep 'xemacs)
(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab))
(org-defkey org-mode-map [(shift tab)] 'org-shifttab)
-(define-key org-mode-map (kbd "<backtab>") 'org-shifttab)
+(define-key org-mode-map [backtab] 'org-shifttab)
(org-defkey org-mode-map [(shift return)] 'org-table-copy-down)
(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading)
(org-defkey org-mode-map "\C-c;" 'org-toggle-comment)
(org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree)
(org-defkey org-mode-map "\C-c\C-w" 'org-check-deadlines)
-(org-defkey org-mode-map "\C-c/" 'org-occur) ; Minor-mode reserved
-(org-defkey org-mode-map "\C-c\C-x/" 'org-occur-in-agenda-files)
+(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
(org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res.
(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading)
(org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus)
(org-defkey org-mode-map "\C-c^" 'org-sort)
(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
+(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
(org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count)
(org-defkey org-mode-map "\C-m" 'org-return)
(org-defkey org-mode-map "\C-c?" 'org-table-field-info)
(org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update)
(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment)
(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox)
+(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property)
+(org-defkey org-mode-map "\C-c\C-xr" 'org-insert-columns-dblock)
(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns)
((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
((org-on-heading-p) (call-interactively 'org-move-subtree-up))
((org-at-item-p) (call-interactively 'org-move-item-up))
- (t (org-shiftcursor-error))))
+ (t (transpose-lines 1) (beginning-of-line -1))))
(defun org-metadown (&optional arg)
"Move subtree down or move table row down.
((org-at-table-p) (call-interactively 'org-table-move-row))
((org-on-heading-p) (call-interactively 'org-move-subtree-down))
((org-at-item-p) (call-interactively 'org-move-item-down))
- (t (org-shiftcursor-error))))
+ (t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0))))
(defun org-shiftup (&optional arg)
"Increase item in timestamp or increase priority of current headline.
(cond
((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
((org-on-heading-p) (org-call-with-arg 'org-todo 'right))
+ ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet nil))
((org-at-property-p) (call-interactively 'org-property-next-allowed-value))
(t (org-shiftcursor-error))))
(cond
((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
((org-on-heading-p) (org-call-with-arg 'org-todo 'left))
+ ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet 'previous))
((org-at-property-p)
(call-interactively 'org-property-previous-allowed-value))
(t (org-shiftcursor-error))))
(let ((org-inhibit-startup t)) (org-mode))
(message "Org-mode restarted to refresh keyword and special line setup"))
+(defun org-kill-note-or-show-branches ()
+ "If this is a Note buffer, abort storing the note. Else call `show-branches'."
+ (interactive)
+ (if (not org-finish-function)
+ (call-interactively 'show-branches)
+ (let ((org-note-abort t))
+ (funcall org-finish-function))))
+
(defun org-return ()
"Goto next table row or insert a newline.
Calls `org-table-next-row' or `newline', depending on context.
(call-interactively 'org-table-next-row))
(t (newline))))
+
(defun org-ctrl-c-minus ()
"Insert separator line in table or modify bullet type in list.
Calls `org-table-insert-hline' or `org-cycle-list-bullet',
(cond
((org-at-table-p)
(call-interactively 'org-table-insert-hline))
+ ((org-on-heading-p)
+ ;; Convert to item
+ (save-excursion
+ (beginning-of-line 1)
+ (if (looking-at "\\*+ ")
+ (replace-match (concat (make-string (- (match-end 0) (point)) ?\ ) "- ")))))
((org-in-item-p)
(call-interactively 'org-cycle-list-bullet))
(t (error "`C-c -' does have no function here."))))
("TAGS and Properties"
["Set Tags" 'org-ctrl-c-ctrl-c (org-at-heading-p)]
["Change tag in region" 'org-change-tag-in-region (org-region-active-p)]
- ["Column view of properties" org-columns t])
+ "--"
+ ["Set property" 'org-set-property t]
+ ["Column view of properties" org-columns t]
+ ["Insert Column View DBlock" org-insert-columns-dblock t])
("Dates and Scheduling"
["Timestamp" org-time-stamp t]
["Timestamp (inactive)" org-time-stamp-inactive t]
(throw 'exit t)))
nil))))
-(defun org-occur-in-agenda-files (regexp)
+(defun org-occur-in-agenda-files (regexp &optional nlines)
"Call `multi-occur' with buffers for all agenda files."
- (interactive "sList all lines matching: ")
- (multi-occur
- (mapcar
- (lambda (x) (or (get-file-buffer x) (find-file-noselect x)))
- (org-agenda-files))
- regexp))
+ (interactive "sOrg-files matching: \np")
+ (let* ((files (org-agenda-files))
+ (tnames (mapcar 'file-truename files))
+ (extra org-agenda-multi-occur-extra-files)
+ f)
+ (while (setq f (pop extra))
+ (unless (member (file-truename f) tnames)
+ (add-to-list 'files f 'append)
+ (add-to-list 'tnames (file-truename f) 'append)))
+ (multi-occur
+ (mapcar (lambda (x) (or (get-file-buffer x) (find-file-noselect x))) files)
+ regexp)))
(defun org-uniquify (list)
"Remove duplicate elements from LIST."
;;;; Experimental code
-
(defun org-closed-in-range ()
"Sparse tree of items closed in a certain time range.
Still experimental, may disappear in the furture."
(push (cons k c) new))))
(nreverse new)))
-(defun org-parse-local-options (string var)
- "Parse STRING for startup setting relevant for variable VAR."
- (let ((rtn (symbol-value var))
- e opts)
- (save-match-data
- (if (or (not string) (not (string-match "\\S-" string)))
- rtn
- (setq opts (delq nil (mapcar (lambda (x)
- (setq e (assoc x org-startup-options))
- (if (eq (nth 1 e) var) e nil))
- (org-split-string string "[ \t]+"))))
- (if (not opts)
- rtn
- (setq rtn nil)
- (while (setq e (pop opts))
- (if (not (nth 3 e))
- (setq rtn (nth 2 e))
- (if (not (listp rtn)) (setq rtn nil))
- (push (nth 2 e) rtn)))
- rtn)))))
-
;;;; Finish up
(provide 'org)
projects / emacs.git / commitdiff