emacs: lisp/textmodes/org.el comparison

comparison lisp/textmodes/org.el @ 67692:f30b7a47672e

(org-agenda-custom-commands): New option. (org-agenda): Offer custom commands on splash screen. (org-make-tags-matcher): Parser for Boolean logic added. (org-agenda-set-tags): New command. (org-agenda-menu, org-agenda-mode-map): Add `org-agenda-set-tags'. (org-set-tags): Efficiency improvements. (org-auto-align-tags): New option. (org-todo, org-demote, org-promote): Realign tags. (org-tags-completion-function): Use also "&" and "|" as separators. (org-org-menu): Agenda commands simplified.

author	Carsten Dominik <dominik@science.uva.nl>
date	Tue, 20 Dec 2005 08:05:16 +0000
parents	58d7532b2ef1
children	f556787bf755

comparison

equal deleted inserted replaced

-:5e3db5999d74
+:f30b7a47672e
 ;; Copyright (c) 2004, 2005 Free Software Foundation
 ;;
 ;; Author: Carsten Dominik <dominik at science dot uva dot nl>
 ;; Keywords: outlines, hypermedia, calendar, wp
 ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
-;; Version: 4.00
+;; Version: 4.01
 ;;
 ;; This file is part of GNU Emacs.
 ;;
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; excellent reference card made by Philip Rooke.  This card can be found
 ;; in the etc/ directory of Emacs 22.
 ;;
 ;; Changes:
 ;; -------
+;; Version 4.01
+;;    - Tags can also be set remotely from agenda buffer.
+;;    - Boolean logic for tag searches.
+;;    - Additional agenda commands can be configured through the variable
+;;      `org-agenda-custom-commands'.
+;;    - Minor bug fixes.
+;;
 ;; 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.
 ;;    - "|" no longer allowed as part of a link, to allow links in tables.
 ;;    - The prefix of items in the agenda buffer can be configured.
 ;;    - Cleanup.
 ;;
 ;; Version 3.07
-;;    - Some folding incinsistencies removed.
+;;    - Some folding inconsistencies removed.
 ;;    - BBDB links to company-only entries.
 ;;    - Bug fixes and global cleanup.
 ;;
 ;; Version 3.06
 ;;    - M-S-RET inserts a new TODO heading.
 (defvar calc-embedded-open-formula)
 (defvar font-lock-unfontify-region-function)
 ;;; Customization variables
-(defvar org-version "4.00"
+(defvar org-version "4.01"
 "The version number of the file org.el.")
 (defun org-version ()
 (interactive)
 (message "Org-mode version %s" org-version))
 Entries are 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."
 :group 'org-agenda
 :type '(repeat file))
+(defcustom org-agenda-custom-commands
+'(("w" todo "WAITING")
+("u" tags "+WORK+URGENT-BOSS"))
+"Custom commands for the agenda.
+These commands will be offered on the splash screen displayed by the
+agenda dispatcher \\[org-agenda].  Each entry is a list of 3 items:
+key    The key (as a string) to be associated with the command.
+type   The command type, either `todo' for a todo list with a specific
+todo keyword, or `tags' for a tags search.
+match  What to search for.  Either a TODO keyword, or a tags match query."
+:group 'org-agenda
+:type '(repeat
+	  (list (string :tag "Key")
+		(choice :tag "Type" (const tags) (const todo))
+		(string :tag "Match"))))
 (defcustom org-select-timeline-window t
 "Non-nil means, after creating a timeline, move cursor into Timeline window.
 When nil, cursor will remain in the current window."
 :group 'org-agenda
 :type 'boolean)
 (defgroup org-tags nil
 "Options concerning startup of Org-mode."
 :tag "Org Tags"
 :group 'org)
-(defcustom org-tags-column 40
+(defcustom org-tags-column 48
 "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-auto-align-tags t
+"Non-nil means, realign tags after pro/demotion of TODO state change.
+These operations change the length of a headline and therefore shift
+the tags around.  With this options turned on, after each such operation
+the tags are again aligned to `org-tags-column'."
+:group 'org-tags
+:type 'boolean)
 (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."
+When nil, only the tags directly give in a specific line apply there.
+If you turn off this option, you very likely want to turn on the
+companion option `org-tags-match-list-sublevels'."
 :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."
+Setting this variable to nil causes subtrees to be skipped.
+This option is off by default, because inheritance in on.  If you turn
+inheritance off, you very likely want to turn this option on."
 :group 'org-tags
 :type 'boolean)
 (defvar org-tags-history nil
 "History of minibuffer reads for tags.")
 (org-back-to-heading t)
 (let* ((level (save-match-data (funcall outline-level)))
 	 (up-head (make-string (1- level) ?*)))
 (if (= level 1) (error "Cannot promote to level 0. UNDO to recover"))
 (replace-match up-head nil t)
+;; Fixup tag positioning
+(and org-auto-align-tags (org-set-tags nil t))
 (if org-adapt-indentation
 	(org-fixup-indentation "^ " "" "^ ?\\S-"))))
 (defun org-demote ()
 "Demote the current heading lower down the tree.
 in the region."
 (org-back-to-heading t)
 (let* ((level (save-match-data (funcall outline-level)))
 	 (down-head (make-string (1+ level) ?*)))
 (replace-match down-head nil t)
+;; Fixup tag positioning
+(and org-auto-align-tags (org-set-tags nil t))
 (if org-adapt-indentation
 	(org-fixup-indentation "^ " "  " "^\\S-"))))
 (defun org-map-tree (fun)
 "Call FUN for every heading underneath the current one."
 (when org-log-done
 	(if (equal state org-done-string)
 	    (org-log-done)
 	  (if (not this)
 	      (org-log-done t))))
+;; Fixup tag positioning
+(and org-auto-align-tags (org-set-tags nil t))
 (run-hooks 'org-after-todo-state-change-hook)))
 ;; Fixup cursor location if close to the keyword
 (if (and (outline-on-heading-p)
 	   (not (bolp))
 	   (save-excursion (beginning-of-line 1)
 (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 "t"        'org-agenda-todo)
+(define-key org-agenda-mode-map ":"        'org-agenda-set-tags)
 (define-key org-agenda-mode-map "."        'org-agenda-goto-today)
 (define-key org-agenda-mode-map "d"        'org-agenda-day-view)
 (define-key org-agenda-mode-map "w"        'org-agenda-week-view)
 (define-key org-agenda-mode-map (org-key 'S-right) 'org-agenda-date-later)
 (define-key org-agenda-mode-map (org-key 'S-left) 'org-agenda-date-earlier)
 ["Go To (one window)" org-agenda-switch-to t]
 ["Follow Mode" org-agenda-follow-mode
 :style toggle :selected org-agenda-follow-mode :active t]
 "--"
 ["Cycle TODO" org-agenda-todo t]
+["Set Tags" org-agenda-set-tags t]
 ("Reschedule"
 ["Reschedule +1 day" org-agenda-date-later t]
 ["Reschedule -1 day" org-agenda-date-earlier t]
 "--"
 ["Reschedule to ..." org-agenda-date-prompt 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:
+on to the selected command.  The default 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.
+More commands can be added by configuring the variable
+`org-agenda-custom-commands'.
 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)))
+(catch 'exit
-	c)
+(let ((restrict-ok (and (buffer-file-name) (eq major-mode 'org-mode)))
-(put 'org-agenda-files 'org-restrict nil)
+	  (custom org-agenda-custom-commands)
-(message"[a]genda [t]odoList [T]odoKwd [m]atchTags [M]atchTagsTodo%s"
+	  c entry key type string)
-	    (if restrict-ok " [1]JustThisFile" ""))
+(put 'org-agenda-files 'org-restrict nil)
-(setq c (read-char-exclusive))
+(save-window-excursion
-(message "")
+	(delete-other-windows)
-(when (equal c ?1)
+	(switch-to-buffer-other-window " *Agenda Commands*")
-(if restrict-ok
+	(erase-buffer)
-	  (put 'org-agenda-files 'org-restrict (list (buffer-file-name)))
+	(insert
-	(error "Cannot restrict agenda to current buffer"))
+	 "Press key for an agenda command:
-(message "Single file: [a]genda [t]odoList [T]odoKwd [m]atchTags [M]atchTagsTodo")
+--------------------------------
-(setq c (read-char-exclusive))
+a   Agenda for current week or day
-(message ""))
+t   List of all TODO entries             T   Entries with special TODO kwd
-(cond
+m   Match a TAGS query                   M   Like m, but only TODO entries.
-((equal c ?a) (call-interactively 'org-agenda-list))
+C   Configure your own agenda commands")
-((equal c ?t) (call-interactively 'org-todo-list))
+	(while (setq entry (pop custom))
-((equal c ?T)
+	  (setq key (car entry) type (nth 1 entry) string (nth 2 entry))
-(setq current-prefix-arg (or arg '(4)))
+	  (insert (format "\n%-4s%-12s: %s"
-(call-interactively 'org-todo-list))
+			  key
-((equal c ?m) (call-interactively 'org-tags-view))
+			  (if (eq type 'tags) "Tags query" "TODO keyword")
-((equal c ?M)
+			  string)))
-(setq current-prefix-arg (or arg '(4)))
+	(goto-char (point-min))
-(call-interactively 'org-tags-view))
+	(fit-window-to-buffer)
-(t (error "Invalid key")))))
+	(message "Press key for agenda command%s"
+		(if restrict-ok ", or [1] to restrict to current file" ""))
+	(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 "Press key for agenda command%s"
+		   (if restrict-ok " (restricted to current file)" ""))
+	  (setq c (read-char-exclusive))
+	  (message "")))
+(require 'calendar)  ; FIXME: can we avoid this for some commands?
+(cond
+((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)
+	(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))
+((setq entry (assoc (char-to-string c) org-agenda-custom-commands))
+	(setq type (nth 1 entry) string (nth 2 entry))
+	(cond
+	 ((eq type 'tags)
+	  (org-tags-view current-prefix-arg string))
+	 ((eq type 'todo)
+	  (org-todo-list string))
+	 (t (error "Invalid custom agenda command type %s" type))))
+(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)
 	 (date (calendar-gregorian-from-absolute today))
 	 (win (selected-window))
 	 (kwds org-todo-keywords)
 	 (completion-ignore-case t)
 	 (org-select-this-todo-keyword
-	  (and arg (integerp arg) (nth (1- arg) org-todo-keywords)))
+	  (if (stringp arg) arg
+	    (and arg (integerp arg) (nth (1- arg) org-todo-keywords))))
 	 rtn rtnall files file pos)
 (when (equal arg '(4))
 (setq org-select-this-todo-keyword
 	    (completing-read "Keyword: " (mapcar 'list org-todo-keywords)
 			     nil t)))
 (end-of-line 1)
 (setq newhead (org-get-heading)))
 (org-agenda-change-all-lines newhead hdmarker)
 (beginning-of-line 1)))
+(defun org-agenda-set-tags ()
+"Set tags for the current headline."
+(interactive)
+(org-agenda-check-no-diary)
+(let* ((marker (or (get-text-property (point) 'org-marker)
+		     (org-agenda-error)))
+	 (hdmarker (get-text-property (point) 'org-hd-marker))
+	 (buffer (marker-buffer hdmarker))
+	 (pos (marker-position hdmarker))
+	 (buffer-read-only nil)
+	 newhead)
+(with-current-buffer buffer
+(widen)
+(goto-char pos)
+(org-show-hidden-entry)
+(save-excursion
+	(and (outline-next-heading)
+	     (org-flag-heading nil)))   ; show the next heading
+(call-interactively 'org-set-tags)
+(end-of-line 1)
+(setq newhead (org-get-heading)))
+(org-agenda-change-all-lines newhead hdmarker)
+(beginning-of-line 1)))
 (defun org-agenda-date-later (arg &optional what)
 "Change the date of this item to one day later."
 (interactive "p")
 (org-agenda-check-no-diary)
 (let* ((marker (or (get-text-property (point) 'org-marker)
 (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
+;; Get a new match request, with completion
 (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)
+;; parse the string and create a lisp form
-(while (string-match "^\\([-+:]\\)?\\([A-Za-z_]+\\)" match)
+(let ((match0 match) minus tag mm matcher orterms term orlist)
-(setq minus (and (match-end 1) (equal (string-to-char match) ?-))
+(setq orterms (org-split-string match "|"))
-	    tag (match-string 2 match)
+(while (setq term (pop orterms))
-	    match (substring match (match-end 0))
+(while (string-match "^&?\\([-+:]\\)?\\([A-Za-z_]+\\)" term)
-	    mm (list 'member (downcase tag) 'tags-list)
+	(setq minus (and (match-end 1)
-	    mm (if minus (list 'not mm) mm))
+			 (equal (match-string 1 term) "-"))
-(push mm matcher))
+	      tag (match-string 2 term)
-(cons match0 (cons 'and matcher))))
+	      term (substring term (match-end 0))
+	      mm (list 'member (downcase tag) 'tags-list)
+	      mm (if minus (list 'not mm) mm))
+	(push mm matcher))
+(push (if (> (length matcher) 1) (cons 'and matcher) (car matcher))
+	    orlist)
+(setq matcher nil))
+(setq matcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist)))
+;; Return the string and lisp forms of the matcher
+(cons match0 matcher)))
+;;(org-make-tags-matcher "&hello&-you")
 ;;;###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."
 	    (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???
+	      (or (org-get-buffer-tags)
 		  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)
+	(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)
+(if (equal current "")
-(looking-at (concat "\\(.*\\)\\(" (regexp-quote current) "\\)[ \t]*"))
+	  (end-of-line 1)
-(setq hd (save-match-data (org-trim (match-string 1))))
+	(beginning-of-line 1)
-(delete-region (match-beginning 0) (match-end 0))
+	(looking-at (concat "\\(.*\\)\\(" (regexp-quote current) "\\)[ \t]*"))
-(insert hd " ")
+	(setq hd (match-string 1))
-(move-to-column (max (current-column)
+	(delete-region (match-beginning 0) (match-end 0))
-			   (if (> org-tags-column 0)
+	(insert (org-trim hd) " "))
-			       org-tags-column
+(unless (equal tags "")
-			     (- org-tags-column (length tags))))
+	(move-to-column (max (current-column)
-		      t)
+			     (if (> org-tags-column 0)
-(insert tags)
+				 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)
+(if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string)
 (setq s1 (match-string 1 string)
 s2 (match-string 2 string))
 (setq s1 "" s2 string))
 (cond
 ((eq flag nil)
 ["Deadline" org-deadline t]
 "--"
 ["Goto Calendar" org-goto-calendar t]
 ["Date from Calendar" org-date-from-calendar t])
 "--"
-("Agenda/Summary Views"
+["Agenda Command" org-agenda t]
-"Current File"
+("File List for Agenda")
+("Special 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]
+["Tags Tree" org-tags-sparse-tree 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"
 ["Store Link (Global)" org-store-link t]
 ["Insert Link" org-insert-link t]
 ["Follow Link" org-open-at-point t])
 (run-hooks 'org-load-hook)
 ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
 ;;; org.el ends here

Mercurial > emacs

comparison lisp/textmodes/org.el @ 67692:f30b7a47672e