[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/textmodes/org.el
|
From: |
Carsten Dominik |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/textmodes/org.el |
|
Date: |
Fri, 16 Dec 2005 14:31:22 +0000 |
Index: emacs/lisp/textmodes/org.el
diff -u emacs/lisp/textmodes/org.el:1.52 emacs/lisp/textmodes/org.el:1.53
--- emacs/lisp/textmodes/org.el:1.52 Mon Dec 12 11:47:25 2005
+++ emacs/lisp/textmodes/org.el Fri Dec 16 14:31:22 2005
@@ -3,9 +3,9 @@
;; Copyright (c) 2004, 2005 Free Software Foundation
;;
;; Author: Carsten Dominik <dominik at science dot uva dot nl>
-;; Keywords: outlines, hypermedia, calendar
+;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
-;; Version: 3.24
+;; Version: 4.00
;;
;; This file is part of GNU Emacs.
;;
@@ -59,7 +59,6 @@
;; (autoload 'org-mode "org" "Org mode" t)
;; (autoload 'org-diary "org" "Diary entries from Org mode")
;; (autoload 'org-agenda "org" "Multi-file agenda from Org mode" t)
-;; (autoload 'org-todo-list "org" "Multi-file todo list from Org mode" t)
;; (autoload 'org-store-link "org" "Store a link to the current location" t)
;; (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t)
;; (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode")
@@ -82,6 +81,12 @@
;;
;; Changes:
;; -------
+;; Version 4.00
+;; - Headlines can contain TAGS, and Org-mode can produced a list
+;; of matching headlines based on a TAG search expression.
+;; - `org-agenda' has now become a dispatcher that will produce the agenda
+;; and other views on org-mode data with an additional keypress.
+;;
;; Version 3.24
;; - Switching and item to DONE records a time stamp when the variable
;; `org-log-done' is turned on. Default is off.
@@ -261,7 +266,7 @@
;;; Customization variables
-(defvar org-version "3.24"
+(defvar org-version "4.00"
"The version number of the file org.el.")
(defun org-version ()
(interactive)
@@ -971,11 +976,56 @@
:group 'org-structure
:type 'boolean)
+(defgroup org-tags nil
+ "Options concerning startup of Org-mode."
+ :tag "Org Tags"
+ :group 'org)
+
+(defcustom org-tags-column 40
+ "The column to which tags should be indented in a headline.
+If this number is positive, it specified the column. If it is negative,
+it means that the tags should be flushright to that column. For example,
+-79 works well for a normal 80 character screen."
+ :group 'org-tags
+ :type 'integer)
+
+(defcustom org-use-tag-inheritance t
+ "Non-nil means, tags in levels apply also for sublevels.
+When nil, only the tags directly give in a specific line apply there."
+ :group 'org-tags
+ :type 'boolean)
+
+(defcustom org-tags-match-list-sublevels nil
+ "Non-nil means list also sublevels of headlines matching tag search.
+Because of tag inheritance (see variable `org-use-tag-inheritance'),
+the sublevels of a headline matching a tag search often also match
+the same search. Listing all of them can create very long lists.
+Setting this variable to nil causes subtrees to be skipped."
+ :group 'org-tags
+ :type 'boolean)
+
+(defvar org-tags-history nil
+ "History of minibuffer reads for tags.")
+(defvar org-last-tags-completion-table nil
+ "The last used completion table for tags.")
+
(defgroup org-link nil
"Options concerning links in Org-mode."
:tag "Org Link"
:group 'org)
+(defcustom org-tab-follows-link nil
+ "Non-nil means, on links TAB will follow the link.
+Needs to be set before org.el is loaded."
+ :group 'org-link
+ :type 'boolean)
+
+(defcustom org-return-follows-link nil
+ "Non-nil means, on links RET will follow the link.
+Needs to be set before org.el is loaded."
+ :group 'org-link
+ :type 'boolean)
+
(defcustom org-link-format "<%s>"
"Default format for linkes in the buffer.
This is a format string for printf, %s will be replaced by the link text.
@@ -2094,6 +2144,12 @@
(if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse)
(define-key org-mouse-map
(if org-xemacs-p [button3] [mouse-3]) 'org-find-file-at-mouse)
+(when org-tab-follows-link
+ (define-key org-mouse-map [(tab)] 'org-open-at-point)
+ (define-key org-mouse-map "\C-i" 'org-open-at-point))
+(when org-return-follows-link
+ (define-key org-mouse-map [(return)] 'org-open-at-point)
+ (define-key org-mouse-map "\C-m" 'org-open-at-point))
(require 'font-lock)
@@ -2160,6 +2216,14 @@
'keymap org-mouse-map))
t)))
+(defun org-activate-tags (limit)
+ (if (re-search-forward "[ \t]\\(:[A-Za-z_:]+:\\)[ \r\n]" limit t)
+ (progn
+ (add-text-properties (match-beginning 1) (match-end 1)
+ (list 'mouse-face 'highlight
+ 'keymap org-mouse-map))
+ t)))
+
(defun org-font-lock-level ()
(save-excursion
(org-back-to-heading t)
@@ -2177,14 +2241,13 @@
(defun org-set-font-lock-defaults ()
(let ((org-font-lock-extra-keywords
(list
- '(org-activate-links (0 'org-link))
- '(org-activate-dates (0 'org-link))
- '(org-activate-camels (0 'org-link))
+ '(org-activate-links (0 'org-link t))
+ '(org-activate-dates (0 'org-link t))
+ '(org-activate-camels (0 'org-link t))
+ '(org-activate-tags (1 'org-link t))
(list (concat "^\\*+[ \t]*" org-not-done-regexp)
'(1 'org-warning t))
(list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t))
-; (list (concat "\\<" org-deadline-string) '(0 'org-warning t))
-; (list (concat "\\<" org-scheduled-string) '(0 'org-warning t))
(list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
@@ -2217,7 +2280,7 @@
; on XEmacs if noutline is ever ported
`((eval . (list "^\\(\\*+\\).*"
,(if org-level-color-stars-only 1 0)
- '(nth ;; FIXME: 1<->0 ????
+ '(nth
(% (- (match-end 1) (match-beginning 1) 1)
org-n-levels)
org-level-faces)
@@ -2908,7 +2971,7 @@
(throw 'exit nil)))
t))))
-;;; Plain list item
+;;; Plain list items
(defun org-at-item-p ()
"Is point in a line starting a hand-formatted item?"
@@ -3069,7 +3132,7 @@
(col (current-column))
(ind (org-get-string-indentation
(buffer-substring (point-at-bol) (match-beginning 3))))
- (term (substring (match-string 3) -1))
+ ;; (term (substring (match-string 3) -1))
ind1 (n (1- arg)))
;; find where this list begins
(catch 'exit
@@ -3134,7 +3197,6 @@
(beginning-of-line 2))
(goto-char beg)))
-
;;; Archiving
(defun org-archive-subtree ()
@@ -3250,16 +3312,20 @@
(interactive "P")
(catch 'exit
(let* ((end (point))
+ (beg1 (save-excursion
+ (if (equal (char-before (point)) ?\ ) (backward-char 1))
+ (skip-chars-backward "a-zA-Z_")
+ (point)))
(beg (save-excursion
(if (equal (char-before (point)) ?\ ) (backward-char 1))
(skip-chars-backward "a-zA-Z0-9_:$")
(point)))
(camel (equal (char-before beg) ?*))
+ (tag (equal (char-before beg1) ?:))
(texp (equal (char-before beg) ?\\))
(opt (equal (buffer-substring (max (point-at-bol) (- beg 2))
beg)
"#+"))
- (pattern (buffer-substring-no-properties beg end))
(completion-ignore-case opt)
(type nil)
(tbl nil)
@@ -3285,7 +3351,10 @@
(push (list (org-make-org-heading-camel (match-string
3)))
tbl)))
tbl)
+ (tag (setq type :tag beg beg1)
+ (org-get-buffer-tags))
(t (progn (ispell-complete-word arg) (throw 'exit nil)))))
+ (pattern (buffer-substring-no-properties beg end))
(completion (try-completion pattern table)))
(cond ((eq completion t)
(if (equal type :opt)
@@ -3301,9 +3370,9 @@
(insert completion)
(if (get-buffer-window "*Completions*")
(delete-window (get-buffer-window "*Completions*")))
- (if (and (eq type :todo)
- (assoc completion table))
- (insert " "))
+ (if (assoc completion table)
+ (if (eq type :todo) (insert " ")
+ (if (eq type :tag) (insert ":"))))
(if (and (equal type :opt) (assoc completion table))
(message "%s" (substitute-command-keys
"Press \\[org-complete] again to insert example
settings"))))
@@ -3676,6 +3745,7 @@
(insert (format-time-string fmt time))))
;;; FIXME: Make the function take "Fri" as "next friday"
+;;; because these are mostly being used to record the current time.
(defun org-read-date (&optional with-time to-time)
"Read a date and make things smooth for the user.
The prompt will suggest to enter an ISO date, but you can also enter anything
@@ -3812,6 +3882,7 @@
(let* ((date (calendar-cursor-to-date))
(time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
(setq ans2 (format-time-string "%Y-%m-%d" time))))
+ (and org-xemacs-p (sit-for .2))
(select-window sw)))
(defun org-calendar-select ()
@@ -4108,6 +4179,8 @@
(defvar org-agenda-redo-command nil)
(defvar org-agenda-mode-hook nil)
+(defvar org-agenda-force-single-file nil)
+
;;;###autoload
(defun org-agenda-mode ()
"Mode for time-sorted view on action items in Org-mode files.
@@ -4133,9 +4206,14 @@
'("Agenda") "Agenda Files"
(append
(list
- ["Edit File List" (customize-variable 'org-agenda-files) t]
+ (vector
+ (if (get 'org-agenda-files 'org-restrict)
+ "Restricted to single file"
+ "Edit File List")
+ '(customize-variable 'org-agenda-files)
+ (not (get 'org-agenda-files 'org-restrict)))
"--")
- (mapcar 'org-file-menu-entry org-agenda-files)))
+ (mapcar 'org-file-menu-entry (org-agenda-files))))
(org-agenda-set-mode-name)
(apply
(if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks)
@@ -4146,7 +4224,7 @@
(define-key org-agenda-mode-map " " 'org-agenda-show)
(define-key org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo)
(define-key org-agenda-mode-map "o" 'delete-other-windows)
-(define-key org-agenda-mode-map "l" 'org-agenda-recenter)
+(define-key org-agenda-mode-map "L" 'org-agenda-recenter)
(define-key org-agenda-mode-map "t" 'org-agenda-todo)
(define-key org-agenda-mode-map "." 'org-agenda-goto-today)
(define-key org-agenda-mode-map "d" 'org-agenda-day-view)
@@ -4162,7 +4240,7 @@
(int-to-string (pop l)) 'digit-argument)))
(define-key org-agenda-mode-map "f" 'org-agenda-follow-mode)
-(define-key org-agenda-mode-map "L" 'org-agenda-log-mode)
+(define-key org-agenda-mode-map "l" 'org-agenda-log-mode)
(define-key org-agenda-mode-map "D" 'org-agenda-toggle-diary)
(define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid)
(define-key org-agenda-mode-map "r" 'org-agenda-redo)
@@ -4228,12 +4306,12 @@
"--"
["Rebuild buffer" org-agenda-redo t]
["Goto Today" org-agenda-goto-today t]
- ["Next Dates" org-agenda-later (local-variable-p 'starting-day)]
- ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)]
+ ["Next Dates" org-agenda-later (local-variable-p 'starting-day
(current-buffer))]
+ ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day
(current-buffer))]
"--"
- ["Day View" org-agenda-day-view :active (local-variable-p 'starting-day)
+ ["Day View" org-agenda-day-view :active (local-variable-p 'starting-day
(current-buffer))
:style radio :selected (equal org-agenda-ndays 1)]
- ["Week View" org-agenda-week-view :active (local-variable-p 'starting-day)
+ ["Week View" org-agenda-week-view :active (local-variable-p 'starting-day
(current-buffer))
:style radio :selected (equal org-agenda-ndays 7)]
"--"
["Show Logbook entries" org-agenda-log-mode
@@ -4256,6 +4334,63 @@
["Exit and Release Buffers" org-agenda-exit t]
))
+;;;###autoload
+(defun org-agenda (arg)
+ "Dispatch agenda commands to collect entries to the agenda buffer.
+Prompts for a character to select a command. Any prefix arg will be passed
+on to the selected command. Possible selections are:
+
+a Call `org-agenda' to display the agenda for the current day or week.
+t Call `org-todo-list' to display the global todo list.
+T Call `org-todo-list' to display the global todo list, put
+ select only entries with a specific TODO keyword.
+m Call `org-tags-view' to display headlines with tags matching
+ a condition. The tags condition is a list of positive and negative
+ selections, like `+WORK+URGENT-WITHBOSS'.
+M like `m', but select only TODO entries, no ordinary headlines.
+
+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
+restricted to the current file."
+ (interactive "P")
+ (let ((restrict-ok (and (buffer-file-name) (eq major-mode 'org-mode)))
+ c)
+ (put 'org-agenda-files 'org-restrict nil)
+ (message"[a]genda [t]odoList [T]odoKwd [m]atchTags [M]atchTagsTodo%s"
+ (if restrict-ok " [1]JustThisFile" ""))
+ (setq c (read-char-exclusive))
+ (message "")
+ (when (equal c ?1)
+ (if restrict-ok
+ (put 'org-agenda-files 'org-restrict (list (buffer-file-name)))
+ (error "Cannot restrict agenda to current buffer"))
+ (message "Single file: [a]genda [t]odoList [T]odoKwd [m]atchTags
[M]atchTagsTodo")
+ (setq c (read-char-exclusive))
+ (message ""))
+ (cond
+ ((equal c ?a) (call-interactively 'org-agenda-list))
+ ((equal c ?t) (call-interactively 'org-todo-list))
+ ((equal c ?T)
+ (setq current-prefix-arg (or arg '(4)))
+ (call-interactively 'org-todo-list))
+ ((equal c ?m) (call-interactively 'org-tags-view))
+ ((equal c ?M)
+ (setq current-prefix-arg (or arg '(4)))
+ (call-interactively 'org-tags-view))
+ (t (error "Invalid key")))))
+
+(defun org-fit-agenda-window ()
+ "Fit the window to the buffer size."
+ (and org-fit-agenda-window
+ (fboundp 'fit-window-to-buffer)
+ (fit-window-to-buffer nil (/ (* (frame-height) 3) 4)
+ (/ (frame-height) 2))))
+
+(defun org-agenda-files ()
+ "Get the list of agenda files."
+ (or (get 'org-agenda-files 'org-restrict)
+ org-agenda-files))
+
(defvar org-agenda-markers nil
"List of all currently active markers created by `org-agenda'.")
(defvar org-agenda-last-marker-time (time-to-seconds (current-time))
@@ -4311,8 +4446,7 @@
(defun org-timeline (&optional include-all keep-modes)
"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
-one \\[universal-argument] prefix argument, past entries will also be listed.
-With two \\[universal-argument] prefixes, all unfinished TODO items will also
be shown,
+\\[universal-argument] prefix, all unfinished TODO items will also be shown,
under the current date.
If the buffer contains an active region, only check the region for
dates."
@@ -4320,8 +4454,8 @@
(require 'calendar)
(org-agenda-maybe-reset-markers 'force)
(org-compile-prefix-format org-timeline-prefix-format)
- (let* ((dopast (or include-all org-agenda-show-log))
- (dotodo (member include-all '((16))))
+ (let* ((dopast t)
+ (dotodo include-all)
(doclosed org-agenda-show-log)
(org-agenda-keep-modes keep-modes)
(entry (buffer-file-name))
@@ -4387,7 +4521,7 @@
(goto-char pos1))))
;;;###autoload
-(defun org-agenda (&optional include-all start-day ndays keep-modes)
+(defun org-agenda-list (&optional include-all start-day ndays keep-modes)
"Produce a weekly view from all files in variable `org-agenda-files'.
The view will be for the current week, but from the overview buffer you
will be able to go to other weeks.
@@ -4408,7 +4542,7 @@
(and (null ndays) (equal 1 org-agenda-ndays)))
nil org-agenda-start-on-weekday))
(org-agenda-keep-modes keep-modes)
- (files (copy-sequence org-agenda-files))
+ (files (copy-sequence (org-agenda-files)))
(win (selected-window))
(today (time-to-days (current-time)))
(sd (or start-day today))
@@ -4424,7 +4558,7 @@
(inhibit-redisplay t)
s e rtn rtnall file date d start-pos end-pos todayp nd)
(setq org-agenda-redo-command
- (list 'org-agenda (list 'quote include-all) start-day ndays t))
+ (list 'org-agenda-list (list 'quote include-all) start-day ndays t))
;; Make the list of days
(setq ndays (or ndays org-agenda-ndays)
nd ndays)
@@ -4444,7 +4578,7 @@
(set (make-local-variable 'include-all-loc) include-all)
(when (and (or include-all org-agenda-include-all-todo)
(member today day-numbers))
- (setq files org-agenda-files
+ (setq files (org-agenda-files)
rtnall nil)
(while (setq file (pop files))
(catch 'nextfile
@@ -4466,7 +4600,7 @@
(setq start-pos (point))
(if (and start-pos (not end-pos))
(setq end-pos (point))))
- (setq files org-agenda-files
+ (setq files (org-agenda-files)
rtnall nil)
(while (setq file (pop files))
(catch 'nextfile
@@ -4501,9 +4635,7 @@
(put-text-property s (1- (point)) 'day d))))
(goto-char (point-min))
(setq buffer-read-only t)
- (if org-fit-agenda-window
- (fit-window-to-buffer nil (/ (* (frame-height) 3) 4)
- (/ (frame-height) 2)))
+ (org-fit-agenda-window)
(unless (and (pos-visible-in-window-p (point-min))
(pos-visible-in-window-p (point-max)))
(goto-char (1- (point-max)))
@@ -4554,7 +4686,7 @@
(set (make-local-variable 'org-todo-keywords) kwds)
(set (make-local-variable 'org-agenda-redo-command)
'(org-todo-list (or current-prefix-arg last-arg) t))
- (setq files org-agenda-files
+ (setq files (org-agenda-files)
rtnall nil)
(while (setq file (pop files))
(catch 'nextfile
@@ -4580,9 +4712,7 @@
(insert (org-finalize-agenda-entries rtnall) "\n"))
(goto-char (point-min))
(setq buffer-read-only t)
- (if org-fit-agenda-window
- (fit-window-to-buffer nil (/ (* (frame-height) 3) 4)
- (/ (frame-height) 2)))
+ (org-fit-agenda-window)
(if (not org-select-agenda-window) (select-window win))))
(defun org-check-agenda-file (file)
@@ -4640,8 +4770,8 @@
(interactive "p")
(unless (boundp 'starting-day)
(error "Not allowed"))
- (org-agenda (if (boundp 'include-all-loc) include-all-loc nil)
- (+ starting-day (* arg org-agenda-ndays)) nil t))
+ (org-agenda-list (if (boundp 'include-all-loc) include-all-loc nil)
+ (+ starting-day (* arg org-agenda-ndays)) nil t))
(defun org-agenda-earlier (arg)
"Go back in time by `org-agenda-ndays' days.
@@ -4649,8 +4779,8 @@
(interactive "p")
(unless (boundp 'starting-day)
(error "Not allowed"))
- (org-agenda (if (boundp 'include-all-loc) include-all-loc nil)
- (- starting-day (* arg org-agenda-ndays)) nil t))
+ (org-agenda-list (if (boundp 'include-all-loc) include-all-loc nil)
+ (- starting-day (* arg org-agenda-ndays)) nil t))
(defun org-agenda-week-view ()
"Switch to weekly view for agenda."
@@ -4658,10 +4788,10 @@
(unless (boundp 'starting-day)
(error "Not allowed"))
(setq org-agenda-ndays 7)
- (org-agenda include-all-loc
- (or (get-text-property (point) 'day)
- starting-day)
- nil t)
+ (org-agenda-list include-all-loc
+ (or (get-text-property (point) 'day)
+ starting-day)
+ nil t)
(org-agenda-set-mode-name)
(message "Switched to week view"))
@@ -4671,10 +4801,10 @@
(unless (boundp 'starting-day)
(error "Not allowed"))
(setq org-agenda-ndays 1)
- (org-agenda include-all-loc
- (or (get-text-property (point) 'day)
- starting-day)
- nil t)
+ (org-agenda-list include-all-loc
+ (or (get-text-property (point) 'day)
+ starting-day)
+ nil t)
(org-agenda-set-mode-name)
(message "Switched to day view"))
@@ -4939,7 +5069,7 @@
(defun org-file-menu-entry (file)
(vector file (list 'find-file file) t))
-;; FIXME: Maybe removed a buffer visited through the menu from
+;; FIXME: Maybe we removed a buffer visited through the menu from
;; org-agenda-new-buffers, so that the buffer will not be removed
;; when exiting the agenda????
@@ -5270,7 +5400,7 @@
(apply 'encode-time ; DATE bound by calendar
(list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
1 11))))
- marker hdmarker deadlinep scheduledp donep tmp priority category
+ marker hdmarker priority category
ee txt timestr)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -5279,7 +5409,8 @@
(setq marker (org-agenda-new-marker (match-beginning 0))
category (org-get-category (match-beginning 0))
timestr (buffer-substring (match-beginning 0) (point-at-eol))
- donep (org-entry-is-done-p))
+ ;; donep (org-entry-is-done-p)
+ )
(if (string-match "\\]" timestr)
;; substring should only run to end of time stamp
(setq timestr (substring timestr 0 (match-end 0))))
@@ -5584,7 +5715,7 @@
(unless (and remove (member time have))
(setq time (int-to-string time))
(push (org-format-agenda-item
- nil string "" ;; FIXME: put a category?
+ nil string "" ;; FIXME: put a category for the grid?
(concat (substring time 0 -2) ":" (substring time -2)))
new)
(put-text-property
@@ -6022,9 +6153,9 @@
"Compute the Org-mode agenda for the calendar date displayed at the cursor.
This is a command that has to be installed in `calendar-mode-map'."
(interactive)
- (org-agenda nil (calendar-absolute-from-gregorian
- (calendar-cursor-to-date))
- nil t))
+ (org-agenda-list nil (calendar-absolute-from-gregorian
+ (calendar-cursor-to-date))
+ nil t))
(defun org-agenda-convert-date ()
(interactive)
@@ -6052,6 +6183,259 @@
(princ s))
(fit-window-to-buffer (get-buffer-window "*Dates*"))))
+;;; Tags
+
+(defun org-scan-tags (action matcher &optional todo-only)
+ "Scan headline tags with inheritance and produce output ACTION.
+ACTION can be `sparse-tree' or `agenda'. MATCHER is a Lisp form to be
+evaluated, testing if a given set of tags qualifies a headline for
+inclusion. When TODO-ONLY is non-nil, only lines with a TDOD keyword
+d are included in the output."
+ (let* ((re (concat "[\n\r]" outline-regexp " *\\(\\<\\("
+ (mapconcat 'regexp-quote
+ (nreverse (cdr (reverse org-todo-keywords)))
+ "\\|")
+ "\\>\\)\\)? *\\(.*?\\)\\(:[A-Za-z_:]+:\\)?[ \t]*[\n\r]"))
+ (props (list 'face nil
+ 'done-face 'org-done
+ 'undone-face nil
+ 'mouse-face 'highlight
+ 'keymap org-agenda-keymap
+ 'help-echo
+ (format "mouse-2 or RET jump to org file %s"
+ (abbreviate-file-name (buffer-file-name)))))
+ tags tags-list tags-alist (llast 0) rtn level category i txt
+ todo marker)
+
+ (save-excursion
+ (goto-char (point-min))
+ (when (eq action 'sparse-tree) (hide-sublevels 1))
+ (while (re-search-forward re nil t)
+ (setq todo (if (match-end 1) (match-string 2))
+ tags (if (match-end 4) (match-string 4)))
+ (goto-char (1+ (match-beginning 0)))
+ (setq level (outline-level)
+ category (org-get-category))
+ (setq i llast llast level)
+ ;; remove tag lists from same and sublevels
+ (while (>= i level)
+ (when (setq entry (assoc i tags-alist))
+ (setq tags-alist (delete entry tags-alist)))
+ (setq i (1- i)))
+ ;; add the nex tags
+ (when tags
+ (setq tags (mapcar 'downcase (org-split-string tags ":"))
+ tags-alist
+ (cons (cons level tags) tags-alist)))
+ ;; compile tags for current headline
+ (setq tags-list
+ (if org-use-tag-inheritance
+ (apply 'append (mapcar 'cdr tags-alist))
+ tags))
+ (when (and (or (not todo-only) todo)
+ (eval matcher))
+ ;; list this headline
+ (if (eq action 'sparse-tree)
+ (progn
+ (org-show-hierarchy-above))
+ (setq txt (org-format-agenda-item
+ ""
+ (concat
+ (if org-tags-match-list-sublevels
+ (make-string (1- level) ?.) "")
+ (org-get-heading))
+ category))
+ (setq marker (org-agenda-new-marker))
+ (add-text-properties
+ 0 (length txt)
+ (append (list 'org-marker marker 'org-hd-marker marker
+ 'category category)
+ props)
+ txt)
+ (push txt rtn))
+ ;; if we are to skip sublevels, jump to end of subtree
+ (or org-tags-match-list-sublevels (outline-end-of-subtree)))))
+ (nreverse rtn)))
+
+(defun org-tags-sparse-tree (&optional arg match)
+ "Create a sparse tree according to tags search string MATCH.
+MATCH can contain positive and negative selection of tags, like
+\"+WORK+URGENT-WITHBOSS\"."
+ (interactive "P")
+ (let ((org-show-following-heading nil)
+ (org-show-hierarchy-above nil))
+ (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)))))
+
+(defun org-make-tags-matcher (match)
+ "Create the TAGS matcher form for the tags-selecting string MATCH."
+ (unless match
+ (setq org-last-tags-completion-table
+ (or (org-get-buffer-tags)
+ org-last-tags-completion-table))
+ (setq match (completing-read
+ "Tags: " 'org-tags-completion-function nil nil nil
+ 'org-tags-history)))
+ (let ((match0 match) minus tag mm matcher)
+ (while (string-match "^\\([-+:]\\)?\\([A-Za-z_]+\\)" match)
+ (setq minus (and (match-end 1) (equal (string-to-char match) ?-))
+ tag (match-string 2 match)
+ match (substring match (match-end 0))
+ mm (list 'member (downcase tag) 'tags-list)
+ mm (if minus (list 'not mm) mm))
+ (push mm matcher))
+ (cons match0 (cons 'and matcher))))
+
+;;;###autoload
+(defun org-tags-view (&optional todo-only match keep-modes)
+ "Show all headlines for all `org-agenda-files' matching a TAGS criterions.
+The prefix arg TODO-ONLY limits the search to TODO entries."
+ (interactive "P")
+ (org-agenda-maybe-reset-markers 'force)
+ (org-compile-prefix-format org-agenda-prefix-format)
+ (let* ((org-agenda-keep-modes keep-modes)
+ (win (selected-window))
+ (completion-ignore-case t)
+ rtn rtnall files file pos matcher
+ buffer)
+ (setq matcher (org-make-tags-matcher match)
+ match (car matcher) matcher (cdr matcher))
+ (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name)))
+ (progn
+ (delete-other-windows)
+ (switch-to-buffer-other-window
+ (get-buffer-create org-agenda-buffer-name))))
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (org-agenda-mode) (setq buffer-read-only nil)
+ (set (make-local-variable 'org-agenda-redo-command)
+ '(call-interactively 'org-tags-view))
+ (setq files (org-agenda-files)
+ rtnall nil)
+ (while (setq file (pop files))
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (setq buffer (if (file-exists-p file)
+ (org-get-agenda-file-buffer file)
+ (error "No such file %s" file)))
+ (if (not buffer)
+ ;; If file does not exist, merror message to agenda
+ (setq rtn (list
+ (format "ORG-AGENDA-ERROR: No such org-file %s" file))
+ rtnall (append rtnall rtn))
+ (with-current-buffer buffer
+ (unless (eq major-mode 'org-mode)
+ (error "Agenda file %s is not in `org-mode'" file))
+ (save-excursion
+ (save-restriction
+ (if org-respect-restriction
+ (if (org-region-active-p)
+ ;; Respect a region to restrict search
+ (narrow-to-region (region-beginning) (region-end)))
+ ;; If we work for the calendar or many files,
+ ;; get rid of any restriction
+ (widen))
+ (setq rtn (org-scan-tags 'agenda matcher todo-only))
+ (setq rtnall (append rtnall rtn))))))))
+ (insert "Headlines with TAGS match: ")
+ (add-text-properties (point-min) (1- (point))
+ (list 'face 'org-link))
+ (setq pos (point))
+ (insert match "\n")
+ (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+ (when rtnall
+ (insert (mapconcat 'identity rtnall "\n")))
+ (goto-char (point-min))
+ (setq buffer-read-only t)
+ (org-fit-agenda-window)
+ (if (not org-select-agenda-window) (select-window win))))
+
+(defvar org-add-colon-after-tag-completion nil) ;; dynamically skoped param
+(defun org-set-tags (&optional arg just-align)
+ "Set the tags for the current headline.
+With prefix ARG, realign all tags in headings in the current buffer."
+ (interactive)
+ (let* (;(inherit (org-get-inherited-tags))
+ (re (concat "^" outline-regexp))
+ (col (current-column))
+ (current (org-get-tags))
+ tags hd)
+ (if arg
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (org-set-tags nil t))
+ (message "All tags realigned to column %d" org-tags-column))
+ (if just-align
+ (setq tags current)
+ (setq org-last-tags-completion-table
+ (or (org-get-buffer-tags);; FIXME: replace +- with :, so that we
can use history stuff???
+ org-last-tags-completion-table))
+ (setq tags
+ (let ((org-add-colon-after-tag-completion t))
+ (completing-read "Tags: " 'org-tags-completion-function
+ nil nil current 'org-tags-history)))
+ (while (string-match "[-+]" tags)
+ (setq tags (replace-match ":" t t tags)))
+ (unless (string-match ":$" tags) (setq tags (concat tags ":")))
+ (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
+ (beginning-of-line 1)
+ (looking-at (concat "\\(.*\\)\\(" (regexp-quote current) "\\)[ \t]*"))
+ (setq hd (save-match-data (org-trim (match-string 1))))
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert hd " ")
+ (move-to-column (max (current-column)
+ (if (> org-tags-column 0)
+ org-tags-column
+ (- org-tags-column (length tags))))
+ t)
+ (insert tags)
+ (move-to-column col))))
+
+(defun org-tags-completion-function (string predicate &optional flag)
+ (let (s1 s2 rtn (ctable org-last-tags-completion-table))
+ (if (string-match "^\\(.*[-+:]\\)\\([^-+:]*\\)$" string)
+ (setq s1 (match-string 1 string)
+ s2 (match-string 2 string))
+ (setq s1 "" s2 string))
+ (cond
+ ((eq flag nil)
+ ;; try completion
+ (setq rtn (try-completion s2 ctable))
+ (if (stringp rtn)
+ (concat s1 s2 (substring rtn (length s2))
+ (if (and org-add-colon-after-tag-completion
+ (assoc rtn ctable))
+ ":" "")))
+ )
+ ((eq flag t)
+ ;; all-completions
+ (all-completions s2 ctable)
+ )
+ ((eq flag 'lambda)
+ ;; exact match?
+ (assoc s2 ctable)))
+ ))
+
+(defun org-get-tags ()
+ "Get the TAGS string in the current headline."
+ (unless (org-on-heading-p)
+ (error "Not on a heading"))
+ (save-excursion
+ (beginning-of-line 1)
+ (if (looking-at ".*[ \t]\\(:[A-Za-z_:]+:\\)[ \t]*\\(\r\\|$\\)")
+ (match-string 1)
+ "")))
+
+(defun org-get-buffer-tags ()
+ "Get a table of all tags used in the buffer, for completion."
+ (let (tags)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "[ \t]:\\([A-Za-z_:]+\\):[ \t\r\n]" nil t)
+ (mapc (lambda (x) (add-to-list 'tags x))
+ (org-split-string (match-string-no-properties 1) ":"))))
+ (mapcar 'list tags)))
+
;;; Link Stuff
(defun org-find-file-at-mouse (ev)
@@ -6075,9 +6459,9 @@
(interactive "P")
(org-remove-occur-highlights nil nil t)
(if (org-at-timestamp-p)
- (org-agenda nil (time-to-days (org-time-string-to-time
- (substring (match-string 1) 0 10)))
- 1)
+ (org-agenda-list nil (time-to-days (org-time-string-to-time
+ (substring (match-string 1) 0 10)))
+ 1)
(let (type path line search (pos (point)))
(catch 'match
(save-excursion
@@ -6089,6 +6473,14 @@
path (match-string 2))
(throw 'match t)))
(save-excursion
+ (skip-chars-backward "^ \t\n\r")
+ (when (looking-at "\\(:[A-Za-z_:]+\\):[ \t\r\n]")
+ (setq type "tags"
+ path (match-string 1))
+ (while (string-match ":" path)
+ (setq path (replace-match "+" t t path)))
+ (throw 'match t)))
+ (save-excursion
(skip-chars-backward "a-zA-Z_")
(when (looking-at org-camel-regexp)
(setq type "camel" path (match-string 0))
@@ -6113,6 +6505,8 @@
(cond
+ ((string= type "tags")
+ (org-tags-view path in-emacs))
((string= type "camel")
(org-link-search
path
@@ -10564,7 +10958,7 @@
(dts (org-ical-ts-to-string
(format-time-string (cdr org-time-stamp-formats) (current-time))
"DTSTART"))
- hd ts ts2 state (inc t) pos scheduledp deadlinep donep tmp pri)
+ hd ts ts2 state (inc t) pos scheduledp deadlinep tmp pri)
(save-excursion
(goto-char (point-min))
(while (re-search-forward org-ts-regexp nil t)
@@ -10582,7 +10976,8 @@
pos)
deadlinep (string-match org-deadline-regexp tmp)
scheduledp (string-match org-scheduled-regexp tmp)
- donep (org-entry-is-done-p)))
+ ;; donep (org-entry-is-done-p)
+ ))
(if (or (string-match org-tr-regexp hd)
(string-match org-ts-regexp hd))
(setq hd (replace-match "" t t hd)))
@@ -10623,9 +11018,8 @@
(defun org-start-icalendar-file (name)
"Start an iCalendar file by inserting the header."
(let ((user user-full-name)
- (calname "something")
(name (or name "unknown"))
- (timezone "Europe/Amsterdam")) ;; FIXME: How can I get the real
timezone?
+ (timezone (cadr (current-time-zone))))
(princ
(format "BEGIN:VCALENDAR
VERSION:2.0
@@ -10727,6 +11121,7 @@
(define-key org-mode-map "\C-c\C-v" 'org-show-todo-tree)
(define-key org-mode-map "\C-c\C-w" 'org-check-deadlines)
(define-key org-mode-map "\C-c/" 'org-occur) ; Minor-mode reserved
+(define-key org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res.
(define-key org-mode-map "\C-c\C-m" 'org-insert-heading)
(define-key org-mode-map "\M-\C-m" 'org-insert-heading)
(define-key org-mode-map "\C-c\C-l" 'org-insert-link)
@@ -11027,6 +11422,7 @@
(org-table-paste-rectangle)
(org-paste-subtree arg)))
+;; FIXME: document tags
(defun org-ctrl-c-ctrl-c (&optional arg)
"Call realign table, or recognize a table.el table, or update keywords.
When the cursor is inside a table created by the table.el package,
@@ -11039,6 +11435,7 @@
(interactive "P")
(let ((org-enable-table-editor t))
(cond
+ ((org-on-heading-p) (org-set-tags arg))
((org-at-table.el-p)
(require 'table)
(beginning-of-line 1)
@@ -11213,12 +11610,18 @@
["Goto Calendar" org-goto-calendar t]
["Date from Calendar" org-date-from-calendar t])
"--"
- ("Timeline/Agenda"
- ["Show TODO Tree this File" org-show-todo-tree t]
- ["Check Deadlines this File" org-check-deadlines t]
- ["Timeline Current File" org-timeline t]
+ ("Agenda/Summary Views"
+ "Current File"
+ ["TODO Tree" org-show-todo-tree t]
+ ["Check Deadlines" org-check-deadlines t]
+ ["Timeline" org-timeline t]
+ ["Tags Tree" org-tags-sparse-tree t]
"--"
- ["Agenda" org-agenda t])
+ "All Agenda Files"
+ ["Command Dispatcher" org-agenda t]
+ ["TODO list" org-todo-list t]
+ ["Agenda" org-agenda-list t]
+ ["Tags View" org-tags-view t])
("File List for Agenda")
"--"
("Hyperlinks"
@@ -11610,4 +12013,3 @@
;;; org.el ends here
-