瀏覽代碼

Merge branch 'master' of git+ssh://repo.or.cz/srv/git/org-mode

Conflicts:
	lisp/org-agenda.el
Carsten Dominik 15 年之前
父節點
當前提交
316e7e5fbc
共有 18 個文件被更改,包括 529 次插入239 次删除
  1. 19 11
      doc/org.texi
  2. 3 3
      doc/orgguide.texi
  3. 12 10
      lisp/ob-R.el
  4. 3 2
      lisp/ob-clojure.el
  5. 0 1
      lisp/ob-eval.el
  6. 25 18
      lisp/ob-python.el
  7. 30 2
      lisp/ob-sql.el
  8. 0 1
      lisp/ob-sqlite.el
  9. 14 13
      lisp/ob.el
  10. 192 114
      lisp/org-agenda.el
  11. 187 55
      lisp/org-clock.el
  12. 6 0
      lisp/org-compat.el
  13. 18 0
      lisp/org-complete.el
  14. 1 1
      lisp/org-latex.el
  15. 5 1
      lisp/org-list.el
  16. 2 2
      lisp/org-mouse.el
  17. 4 5
      lisp/org.el
  18. 8 0
      testing/lisp/test-org.el

+ 19 - 11
doc/org.texi

@@ -5820,6 +5820,7 @@ be selected:
              2007-12-31    @r{New year eve 2007}
              2007-12-31    @r{New year eve 2007}
              2007-12       @r{December 2007}
              2007-12       @r{December 2007}
              2007-W50      @r{ISO-week 50 in 2007}
              2007-W50      @r{ISO-week 50 in 2007}
+             2007-Q2       @r{2nd quarter in 2007}
              2007          @r{the year 2007}
              2007          @r{the year 2007}
              today, yesterday, today-@var{N}          @r{a relative day}
              today, yesterday, today-@var{N}          @r{a relative day}
              thisweek, lastweek, thisweek-@var{N}     @r{a relative week}
              thisweek, lastweek, thisweek-@var{N}     @r{a relative week}
@@ -6965,16 +6966,22 @@ paper agenda, showing all the tasks for the current week or day.
 @table @kbd
 @table @kbd
 @cindex org-agenda, command
 @cindex org-agenda, command
 @orgcmd{C-c a a,org-agenda-list}
 @orgcmd{C-c a a,org-agenda-list}
-@vindex org-agenda-ndays
 Compile an agenda for the current week from a list of Org files.  The agenda
 Compile an agenda for the current week from a list of Org files.  The agenda
 shows the entries for each day.  With a numeric prefix@footnote{For backward
 shows the entries for each day.  With a numeric prefix@footnote{For backward
 compatibility, the universal prefix @kbd{C-u} causes all TODO entries to be
 compatibility, the universal prefix @kbd{C-u} causes all TODO entries to be
 listed before the agenda.  This feature is deprecated, use the dedicated TODO
 listed before the agenda.  This feature is deprecated, use the dedicated TODO
 list, or a block agenda instead (@pxref{Block agenda}).}  (like @kbd{C-u 2 1
 list, or a block agenda instead (@pxref{Block agenda}).}  (like @kbd{C-u 2 1
-C-c a a}) you may set the number of days to be displayed (see also the
-variable @code{org-agenda-ndays})
+C-c a a}) you may set the number of days to be displayed.
 @end table
 @end table
 
 
+@vindex org-agenda-span
+@vindex org-agenda-ndays
+The default number of days displayed in the agenda is set by the variable
+@code{org-agenda-span} (or the obsolete @code{org-agenda-ndays}).  This
+variable can be set to any number of days you want to see by default in the
+agenda, or to a span name, such a @code{day}, @code{week}, @code{month} or
+@code{year}.
+
 Remote editing from the agenda buffer means, for example, that you can
 Remote editing from the agenda buffer means, for example, that you can
 change the dates of deadlines and appointments from the agenda buffer.
 change the dates of deadlines and appointments from the agenda buffer.
 The commands available in the Agenda buffer are listed in @ref{Agenda
 The commands available in the Agenda buffer are listed in @ref{Agenda
@@ -7120,13 +7127,15 @@ it more compact:
 @item
 @item
 @vindex org-agenda-todo-ignore-scheduled
 @vindex org-agenda-todo-ignore-scheduled
 @vindex org-agenda-todo-ignore-deadlines
 @vindex org-agenda-todo-ignore-deadlines
+@vindex org-agenda-todo-ignore-timestamp
 @vindex org-agenda-todo-ignore-with-date
 @vindex org-agenda-todo-ignore-with-date
 Some people view a TODO item that has been @emph{scheduled} for execution or
 Some people view a TODO item that has been @emph{scheduled} for execution or
 have a @emph{deadline} (@pxref{Timestamps}) as no longer @emph{open}.
 have a @emph{deadline} (@pxref{Timestamps}) as no longer @emph{open}.
 Configure the variables @code{org-agenda-todo-ignore-scheduled},
 Configure the variables @code{org-agenda-todo-ignore-scheduled},
-@code{org-agenda-todo-ignore-deadlines}, and/or
-@code{org-agenda-todo-ignore-with-date} to exclude such items from the
-global TODO list.
+@code{org-agenda-todo-ignore-deadlines},
+@code{org-agenda-todo-ignore-timestamp} and/or
+@code{org-agenda-todo-ignore-with-date} to exclude such items from the global
+TODO list.
 @item
 @item
 @vindex org-agenda-todo-list-sublevels
 @vindex org-agenda-todo-list-sublevels
 TODO items may have sublevels to break up the task into subtasks.  In
 TODO items may have sublevels to break up the task into subtasks.  In
@@ -7618,10 +7627,9 @@ argument as well.  For example, @kbd{200712 w} will jump to week 12 in
 be mapped to the interval 1938-2037.
 be mapped to the interval 1938-2037.
 @c
 @c
 @orgcmd{f,org-agenda-later}
 @orgcmd{f,org-agenda-later}
-@vindex org-agenda-ndays
-Go forward in time to display the following @code{org-agenda-ndays} days.
+Go forward in time to display the following @code{org-agenda-current-span} days.
 For example, if the display covers a week, switch to the following week.
 For example, if the display covers a week, switch to the following week.
-With prefix arg, go forward that many times @code{org-agenda-ndays} days.
+With prefix arg, go forward that many times @code{org-agenda-current-span} days.
 @c
 @c
 @orgcmd{b,org-agenda-earlier}
 @orgcmd{b,org-agenda-earlier}
 Go backward in time to display earlier dates.
 Go backward in time to display earlier dates.
@@ -8366,7 +8374,7 @@ or, if you need to modify some parameters@footnote{Quoting depends on the
 system you use, please check the FAQ for examples.}
 system you use, please check the FAQ for examples.}
 @example
 @example
 emacs -eval '(org-batch-store-agenda-views                      \
 emacs -eval '(org-batch-store-agenda-views                      \
-              org-agenda-ndays 30                               \
+              org-agenda-span month                             \
               org-agenda-start-day "2007-11-01"                 \
               org-agenda-start-day "2007-11-01"                 \
               org-agenda-include-diary nil                      \
               org-agenda-include-diary nil                      \
               org-agenda-files (quote ("~/org/project.org")))'  \
               org-agenda-files (quote ("~/org/project.org")))'  \
@@ -14030,7 +14038,7 @@ You may also modify parameters on the fly like this:
 @example
 @example
 emacs -batch -l ~/.emacs                                      \
 emacs -batch -l ~/.emacs                                      \
    -eval '(org-batch-agenda "a"                               \
    -eval '(org-batch-agenda "a"                               \
-            org-agenda-ndays 30                               \
+            org-agenda-span month                             \
             org-agenda-include-diary nil                      \
             org-agenda-include-diary nil                      \
             org-agenda-files (quote ("~/org/project.org")))'  \
             org-agenda-files (quote ("~/org/project.org")))'  \
    | lpr
    | lpr

+ 3 - 3
doc/orgguide.texi

@@ -1931,9 +1931,9 @@ Delete other windows.
 Switch to day/week view. 
 Switch to day/week view. 
 @c
 @c
 @item f @r{and} b
 @item f @r{and} b
-Go forward/backward in time to display the following @code{org-agenda-ndays}
-days.  For example, if the display covers a week, switch to the
-following/previous week.
+Go forward/backward in time to display the following
+@code{org-agenda-current-span} days.  For example, if the display covers a
+week, switch to the following/previous week.
 @c
 @c
 @item .
 @item .
 Go to today.
 Go to today.

+ 12 - 10
lisp/ob-R.el

@@ -276,16 +276,18 @@ last statement in BODY, as elisp."
       (butlast
       (butlast
        (delq nil
        (delq nil
 	     (mapcar
 	     (mapcar
-	      (lambda (line) ;; cleanup extra prompts left in output
-		(if (string-match
-		     "^\\([ ]*[>+][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
-		    (substring line (match-end 1))
-		  line))
-	      (org-babel-comint-with-output (session org-babel-R-eoe-output)
-		(insert (mapconcat #'org-babel-chomp
-				   (list body org-babel-R-eoe-indicator)
-				   "\n"))
-		(inferior-ess-send-input)))) 2) "\n"))))
+	      (lambda (line) (when (> (length line) 0) line))
+	      (mapcar
+	       (lambda (line) ;; cleanup extra prompts left in output
+		 (if (string-match
+		      "^\\([ ]*[>+][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
+		     (substring line (match-end 1))
+		   line))
+	       (org-babel-comint-with-output (session org-babel-R-eoe-output)
+		 (insert (mapconcat #'org-babel-chomp
+				    (list body org-babel-R-eoe-indicator)
+				    "\n"))
+		 (inferior-ess-send-input)))))) "\n"))))
 
 
 (defun org-babel-R-process-value-result (result column-names-p)
 (defun org-babel-R-process-value-result (result column-names-p)
   "R-specific processing of return value.
   "R-specific processing of return value.

+ 3 - 2
lisp/ob-clojure.el

@@ -28,7 +28,7 @@
 
 
 ;;; Requirements:
 ;;; Requirements:
 
 
-;;; A working clojure install. This also implies a working java executable
+;;; - clojure (at least 1.2.0)
 ;;; - clojure-mode
 ;;; - clojure-mode
 ;;; - slime
 ;;; - slime
 ;;; - swank-clojure
 ;;; - swank-clojure
@@ -49,6 +49,7 @@
 (defun org-babel-expand-body:clojure (body params)
 (defun org-babel-expand-body:clojure (body params)
   "Expand BODY according to PARAMS, return the expanded body."
   "Expand BODY according to PARAMS, return the expanded body."
   (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
   (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+	 (result-params (cdr (assoc :result-params params)))
 	 (print-level nil) (print-length nil)
 	 (print-level nil) (print-length nil)
 	 (body (org-babel-trim
 	 (body (org-babel-trim
 		(if (> (length vars) 0)
 		(if (> (length vars) 0)
@@ -62,7 +63,7 @@
     (if (or (member "code" result-params)
     (if (or (member "code" result-params)
 	    (member "pp" result-params))
 	    (member "pp" result-params))
 	(format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)]"
 	(format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)]"
-			"(with-pprint-dispatch %s-dispatch"
+			"(clojure.pprint/with-pprint-dispatch %s-dispatch"
 			"(clojure.pprint/pprint %s org-mode-print-catcher)"
 			"(clojure.pprint/pprint %s org-mode-print-catcher)"
 			"(str org-mode-print-catcher)))")
 			"(str org-mode-print-catcher)))")
 		(if (member "code" result-params) "code" "simple") body)
 		(if (member "code" result-params) "code" "simple") body)

+ 0 - 1
lisp/ob-eval.el

@@ -28,7 +28,6 @@
 ;; shell commands.
 ;; shell commands.
 
 
 ;;; Code:
 ;;; Code:
-(require 'ob)
 (eval-when-compile (require 'cl))
 (eval-when-compile (require 'cl))
 
 
 (defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
 (defvar org-babel-error-buffer-name "*Org-Babel Error Output*")

+ 25 - 18
lisp/ob-python.el

@@ -56,11 +56,15 @@ This function is called by `org-babel-execute-src-block'."
 		   (cdr (assoc :session params))))
 		   (cdr (assoc :session params))))
          (result-params (cdr (assoc :result-params params)))
          (result-params (cdr (assoc :result-params params)))
          (result-type (cdr (assoc :result-type params)))
          (result-type (cdr (assoc :result-type params)))
+	 (return-val (when (and (eq result-type 'value) (not session))
+		       (cdr (assoc :return params))))
+	 (preamble (cdr (assoc :preamble params)))
          (full-body
          (full-body
 	  (org-babel-expand-body:generic
 	  (org-babel-expand-body:generic
-	   body params (org-babel-variable-assignments:python params)))
+	   (concat body (if return-val (format "return %s" return-val) ""))
+	   params (org-babel-variable-assignments:python params)))
          (result (org-babel-python-evaluate
          (result (org-babel-python-evaluate
-		  session full-body result-type result-params)))
+		  session full-body result-type result-params preamble)))
     (or (cdr (assoc :file params))
     (or (cdr (assoc :file params))
         (org-babel-reassemble-table
         (org-babel-reassemble-table
          result
          result
@@ -178,35 +182,38 @@ def main():
 open('%s', 'w').write( pprint.pformat(main()) )")
 open('%s', 'w').write( pprint.pformat(main()) )")
 
 
 (defun org-babel-python-evaluate
 (defun org-babel-python-evaluate
-  (session body &optional result-type result-params)
+  (session body &optional result-type result-params preamble)
   "Evaluate BODY as python code."
   "Evaluate BODY as python code."
   (if session
   (if session
       (org-babel-python-evaluate-session
       (org-babel-python-evaluate-session
        session body result-type result-params)
        session body result-type result-params)
     (org-babel-python-evaluate-external-process
     (org-babel-python-evaluate-external-process
-     body result-type result-params)))
+     body result-type result-params preamble)))
 
 
 (defun org-babel-python-evaluate-external-process
 (defun org-babel-python-evaluate-external-process
-  (body &optional result-type result-params)
+  (body &optional result-type result-params preamble)
   "Evaluate BODY in external python process.
   "Evaluate BODY in external python process.
 If RESULT-TYPE equals 'output then return standard output as a
 If RESULT-TYPE equals 'output then return standard output as a
 string. If RESULT-TYPE equals 'value then return the value of the
 string. If RESULT-TYPE equals 'value then return the value of the
 last statement in BODY, as elisp."
 last statement in BODY, as elisp."
   (case result-type
   (case result-type
-    (output (org-babel-eval org-babel-python-command body))
+    (output (org-babel-eval org-babel-python-command
+			    (concat (if preamble (concat preamble "\n") "") body)))
     (value (let ((tmp-file (org-babel-temp-file "python-")))
     (value (let ((tmp-file (org-babel-temp-file "python-")))
 	     (org-babel-eval org-babel-python-command
 	     (org-babel-eval org-babel-python-command
-			     (format
-			      (if (member "pp" result-params)
-				  org-babel-python-pp-wrapper-method
-				org-babel-python-wrapper-method)
-			      (mapconcat
-			       (lambda (line) (format "\t%s" line))
-			       (split-string
-				(org-remove-indentation
-				 (org-babel-trim body))
-				"[\r\n]") "\n")
-			      (org-babel-process-file-name tmp-file 'noquote)))
+			     (concat
+			      (if preamble (concat preamble "\n") "")
+			      (format
+			       (if (member "pp" result-params)
+				   org-babel-python-pp-wrapper-method
+				 org-babel-python-wrapper-method)
+			       (mapconcat
+				(lambda (line) (format "\t%s" line))
+				(split-string
+				 (org-remove-indentation
+				  (org-babel-trim body))
+				 "[\r\n]") "\n")
+			       (org-babel-process-file-name tmp-file 'noquote))))
 	     ((lambda (raw)
 	     ((lambda (raw)
 		(if (or (member "code" result-params)
 		(if (or (member "code" result-params)
 			(member "pp" result-params))
 			(member "pp" result-params))
@@ -226,7 +233,7 @@ last statement in BODY, as elisp."
 	   (lambda (statement) (insert statement) (comint-send-input))
 	   (lambda (statement) (insert statement) (comint-send-input))
 	   (if pp
 	   (if pp
 	       (list
 	       (list
-		"import pp"
+		"import pprint"
 		(format "open('%s', 'w').write(pprint.pformat(_))"
 		(format "open('%s', 'w').write(pprint.pformat(_))"
 			(org-babel-process-file-name tmp-file 'noquote)))
 			(org-babel-process-file-name tmp-file 'noquote)))
 	     (list (format "open('%s', 'w').write(str(_))"
 	     (list (format "open('%s', 'w').write(str(_))"

+ 30 - 2
lisp/ob-sql.el

@@ -47,9 +47,15 @@
 (eval-when-compile (require 'cl))
 (eval-when-compile (require 'cl))
 
 
 (declare-function org-table-import "org-table" (file arg))
 (declare-function org-table-import "org-table" (file arg))
+(declare-function orgtbl-to-csv "org-table" (TABLE PARAMS))
 
 
 (defvar org-babel-default-header-args:sql '())
 (defvar org-babel-default-header-args:sql '())
 
 
+(defun org-babel-expand-body:sql (body params)
+  "Expand BODY according to the values of PARAMS."
+  (org-babel-sql-expand-vars
+   body (mapcar #'cdr (org-babel-get-header params :var))))
+
 (defun org-babel-execute:sql (body params)
 (defun org-babel-execute:sql (body params)
   "Execute a block of Sql code with Babel.
   "Execute a block of Sql code with Babel.
 This function is called by `org-babel-execute-src-block'."
 This function is called by `org-babel-execute-src-block'."
@@ -70,11 +76,11 @@ This function is called by `org-babel-execute-src-block'."
 				    (or cmdline "")))
 				    (or cmdline "")))
                     (t (error "no support for the %s sql engine" engine)))))
                     (t (error "no support for the %s sql engine" engine)))))
     (with-temp-file in-file
     (with-temp-file in-file
-      (insert (org-babel-expand-body:generic body params)))
+      (insert (org-babel-expand-body:sql body params)))
     (message command)
     (message command)
     (shell-command command)
     (shell-command command)
     (with-temp-buffer
     (with-temp-buffer
-      (org-table-import out-file nil)
+      (org-table-import out-file '(16))
       (org-babel-reassemble-table
       (org-babel-reassemble-table
        (org-table-to-lisp)
        (org-table-to-lisp)
        (org-babel-pick-name (cdr (assoc :colname-names params))
        (org-babel-pick-name (cdr (assoc :colname-names params))
@@ -82,6 +88,28 @@ This function is called by `org-babel-execute-src-block'."
        (org-babel-pick-name (cdr (assoc :rowname-names params))
        (org-babel-pick-name (cdr (assoc :rowname-names params))
 			    (cdr (assoc :rownames params)))))))
 			    (cdr (assoc :rownames params)))))))
 
 
+(defun org-babel-sql-expand-vars (body vars)
+  "Expand the variables held in VARS in BODY."
+  (mapc
+   (lambda (pair)
+     (setq body
+	   (replace-regexp-in-string
+	    (format "\$%s" (car pair))
+	    ((lambda (val)
+	       (if (listp val)
+		   ((lambda (data-file)
+		      (with-temp-file data-file
+			(insert (orgtbl-to-csv
+				 val '(:fmt (lambda (el) (if (stringp el)
+							el
+						      (format "%S" el)))))))
+		      data-file)
+		    (org-babel-temp-file "sql-data-"))
+		 (if (stringp val) val (format "%S" val))))
+	     (cdr pair))
+	    body)))
+   vars)
+  body)
 
 
 (defun org-babel-prep-session:sql (session params)
 (defun org-babel-prep-session:sql (session params)
   "Raise an error because Sql sessions aren't implemented."
   "Raise an error because Sql sessions aren't implemented."

+ 0 - 1
lisp/ob-sqlite.el

@@ -53,7 +53,6 @@
   "Execute a block of Sqlite code with Babel.
   "Execute a block of Sqlite code with Babel.
 This function is called by `org-babel-execute-src-block'."
 This function is called by `org-babel-execute-src-block'."
   (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
   (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
-	(vars (org-babel-get-header params :var))
 	(db (cdr (assoc :db params)))
 	(db (cdr (assoc :db params)))
 	(separator (cdr (assoc :separator params)))
 	(separator (cdr (assoc :separator params)))
 	(nullvalue (cdr (assoc :nullvalue params)))
 	(nullvalue (cdr (assoc :nullvalue params)))

+ 14 - 13
lisp/ob.el

@@ -32,6 +32,7 @@
 (eval-when-compile
 (eval-when-compile
   (require 'org-list)
   (require 'org-list)
   (require 'cl))
   (require 'cl))
+(require 'ob-eval)
 (require 'org-macs)
 (require 'org-macs)
 
 
 (defvar org-babel-call-process-region-original)
 (defvar org-babel-call-process-region-original)
@@ -78,7 +79,6 @@
 (declare-function org-list-to-generic "org-list" (LIST PARAMS))
 (declare-function org-list-to-generic "org-list" (LIST PARAMS))
 (declare-function org-list-bottom-point "org-list" ())
 (declare-function org-list-bottom-point "org-list" ())
 
 
-(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
 (defgroup org-babel nil
 (defgroup org-babel nil
   "Code block evaluation and management in `org-mode' documents."
   "Code block evaluation and management in `org-mode' documents."
   :tag "Babel"
   :tag "Babel"
@@ -218,8 +218,10 @@ of potentially harmful code."
     (if (or (equal eval "never") (equal eval "no")
     (if (or (equal eval "never") (equal eval "no")
 	    (and query
 	    (and query
 		 (not (yes-or-no-p
 		 (not (yes-or-no-p
-		       (format "Evaluate this%scode on your system? "
-			       (if info (format " %s " (nth 0 info)) " "))))))
+		       (format "Evaluate this%scode block%son your system? "
+			       (if info (format " %s " (nth 0 info)) " ")
+			       (if (nth 4 info)
+				   (format " (%s) " (nth 4 info)) " "))))))
 	(prog1 nil (message "Evaluation %s"
 	(prog1 nil (message "Evaluation %s"
 			    (if (or (equal eval "never") (equal eval "no"))
 			    (if (or (equal eval "never") (equal eval "no"))
 				"Disabled" "Aborted")))
 				"Disabled" "Aborted")))
@@ -1440,7 +1442,7 @@ code ---- the results are extracted in the syntax of the source
 	   ((member "replace" result-params)
 	   ((member "replace" result-params)
 	    (delete-region (point) (org-babel-result-end)))
 	    (delete-region (point) (org-babel-result-end)))
 	   ((member "append" result-params)
 	   ((member "append" result-params)
-	    (goto-char (org-babel-result-end)) (setq beg (point)))
+	    (goto-char (org-babel-result-end)) (setq beg (point-marker)))
 	   ((member "prepend" result-params)))) ; already there
 	   ((member "prepend" result-params)))) ; already there
 	(setq results-switches
 	(setq results-switches
 	      (if results-switches (concat " " results-switches) ""))
 	      (if results-switches (concat " " results-switches) ""))
@@ -1468,13 +1470,13 @@ code ---- the results are extracted in the syntax of the source
 	 ((member "file" result-params)
 	 ((member "file" result-params)
 	  (insert result))
 	  (insert result))
 	 (t (goto-char beg) (insert result)))
 	 (t (goto-char beg) (insert result)))
-	(setq end (if (listp result) (org-table-end) (point)))
+	(when (listp result) (goto-char (org-table-end)))
+	(setq end (point-marker))
 	;; possibly wrap result
 	;; possibly wrap result
 	(flet ((wrap (start finish)
 	(flet ((wrap (start finish)
 		     (goto-char beg) (insert start)
 		     (goto-char beg) (insert start)
-		     (goto-char
-		      (+ (if (and result (listp result)) 0 (length start)) end))
-		     (insert finish) (setq end (point))))
+		     (goto-char end) (insert finish)
+		     (setq end (point-marker))))
 	  (cond
 	  (cond
 	   ((member "html" result-params)
 	   ((member "html" result-params)
 	    (wrap "#+BEGIN_HTML\n" "#+END_HTML"))
 	    (wrap "#+BEGIN_HTML\n" "#+END_HTML"))
@@ -1492,7 +1494,8 @@ code ---- the results are extracted in the syntax of the source
 	      (org-babel-examplize-region beg end results-switches))
 	      (org-babel-examplize-region beg end results-switches))
 	    (wrap "#+BEGIN_RESULT\n" "#+END_RESULT"))
 	    (wrap "#+BEGIN_RESULT\n" "#+END_RESULT"))
 	   ((and (stringp result) (not (member "file" result-params)))
 	   ((and (stringp result) (not (member "file" result-params)))
-	    (org-babel-examplize-region beg end results-switches))))
+	    (org-babel-examplize-region beg end results-switches)
+	    (setq end (point)))))
 	;; possibly indent the results to match the #+results line
 	;; possibly indent the results to match the #+results line
 	(when (and indent (> indent 0)
 	(when (and indent (> indent 0)
 		   ;; in this case `table-align' does the work for us
 		   ;; in this case `table-align' does the work for us
@@ -1549,9 +1552,7 @@ file's directory then expand relative links."
   (interactive "*r")
   (interactive "*r")
   (let ((size (count-lines beg end)))
   (let ((size (count-lines beg end)))
     (save-excursion
     (save-excursion
-      (cond ((= size 0)
-	     (error (concat "This should not be impossible:"
-                            "a newline was appended to result if missing")))
+      (cond ((= size 0))	      ; do nothing for an empty result
 	    ((< size org-babel-min-lines-for-block-output)
 	    ((< size org-babel-min-lines-for-block-output)
 	     (goto-char beg)
 	     (goto-char beg)
 	     (dotimes (n size)
 	     (dotimes (n size)
@@ -1561,7 +1562,7 @@ file's directory then expand relative links."
 	     (insert (if results-switches
 	     (insert (if results-switches
                          (format "#+begin_example%s\n" results-switches)
                          (format "#+begin_example%s\n" results-switches)
                        "#+begin_example\n"))
                        "#+begin_example\n"))
-	     (forward-char (- end beg))
+	     (if (markerp end) (goto-char end) (forward-char (- end beg)))
 	     (insert "#+end_example\n"))))))
 	     (insert "#+end_example\n"))))))
 
 
 (defun org-babel-update-block-body (new-body)
 (defun org-babel-update-block-body (new-body)

+ 192 - 114
lisp/org-agenda.el

@@ -242,8 +242,12 @@ you can \"misuse\" it to also add other text to the header.  However,
 		  (const org-agenda-prefix-format :value "  %-12:c%?-12t% s")
 		  (const org-agenda-prefix-format :value "  %-12:c%?-12t% s")
 		  (string))
 		  (string))
 	    (list :tag "Number of days in agenda"
 	    (list :tag "Number of days in agenda"
-		  (const org-agenda-ndays)
-		  (integer :value 1))
+		  (const org-agenda-span)
+		  (choice (const :tag "Day" 'day)
+			  (const :tag "Week" 'week)
+			  (const :tag "Month" 'month)
+			  (const :tag "Year" 'year)
+			  (integer :tag "Custom")))
 	    (list :tag "Fixed starting date"
 	    (list :tag "Fixed starting date"
 		  (const org-agenda-start-day)
 		  (const org-agenda-start-day)
 		  (string :value "2007-11-01"))
 		  (string :value "2007-11-01"))
@@ -562,6 +566,33 @@ See also the variable `org-agenda-tags-todo-honor-ignore-options'."
   :group 'org-agenda-todo-list
   :group 'org-agenda-todo-list
   :type 'boolean)
   :type 'boolean)
 
 
+(defcustom org-agenda-todo-ignore-timestamp nil
+  "Non-nil means don't show entries with a timestamp.
+This applies when creating the global todo list.
+Valid values are:
+
+past     Don't show entries for today or in the past.
+
+future   Don't show entries with a timestamp in the future.
+         The idea behind this is that if it has a future
+         timestamp, you don't want to think about it until the
+         date.
+
+all      Don't show any entries with a timestamp in the global todo list.
+         The idea behind this is that by setting a timestamp, you
+         have already \"taken care\" of this item.
+
+See also `org-agenda-todo-ignore-with-date'.
+See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
+to make his option also apply to the tags-todo list."
+  :group 'org-agenda-skip
+  :group 'org-agenda-todo-list
+  :type '(choice
+	  (const :tag "Ignore future timestamp todos" future)
+	  (const :tag "Ignore past or present timestamp todos" past)
+	  (const :tag "Ignore all timestamp todos" all)
+	  (const :tag "Show timestamp todos" nil)))
+
 (defcustom org-agenda-todo-ignore-scheduled nil
 (defcustom org-agenda-todo-ignore-scheduled nil
   "Non-nil means, ignore some scheduled TODO items when making TODO list.
   "Non-nil means, ignore some scheduled TODO items when making TODO list.
 This applies when creating the global todo list.
 This applies when creating the global todo list.
@@ -632,7 +663,8 @@ to make his option also apply to the tags-todo list."
   "Non-nil means honor todo-list ...ignore options also in tags-todo search.
   "Non-nil means honor todo-list ...ignore options also in tags-todo search.
 The variables
 The variables
    `org-agenda-todo-ignore-with-date',
    `org-agenda-todo-ignore-with-date',
-   `org-agenda-todo-ignore-scheduled'
+   `org-agenda-todo-ignore-timestamp',
+   `org-agenda-todo-ignore-scheduled',
    `org-agenda-todo-ignore-deadlines'
    `org-agenda-todo-ignore-deadlines'
 make the global TODO list skip entries that have time stamps of certain
 make the global TODO list skip entries that have time stamps of certain
 kinds.  If this option is set, the same options will also apply for the
 kinds.  If this option is set, the same options will also apply for the
@@ -860,12 +892,25 @@ option will be ignored."
   :group 'org-agenda-windows
   :group 'org-agenda-windows
   :type 'boolean)
   :type 'boolean)
 
 
-(defcustom org-agenda-ndays 7
-  "Number of days to include in overview display.
+(defcustom org-agenda-ndays nil
+   "Number of days to include in overview display.
 Should be 1 or 7.
 Should be 1 or 7.
+Obsolete, see `org-agenda-span'."
+   :group 'org-agenda-daily/weekly
+   :type 'integer)
+
+(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1")
+
+(defcustom org-agenda-span 'week
+  "Number of days to include in overview display.
+Can be day, week, month, year, or any number of days.
 Custom commands can set this variable in the options section."
 Custom commands can set this variable in the options section."
   :group 'org-agenda-daily/weekly
   :group 'org-agenda-daily/weekly
-  :type 'integer)
+  :type '(choice (const :tag "Day" day)
+		 (const :tag "Week" week)
+		 (const :tag "Month" month)
+		 (const :tag "Year" year)
+		 (integer :tag "Custom")))
 
 
 (defcustom org-agenda-start-on-weekday 1
 (defcustom org-agenda-start-on-weekday 1
   "Non-nil means start the overview always on the specified weekday.
   "Non-nil means start the overview always on the specified weekday.
@@ -1797,19 +1842,19 @@ The following commands are available:
     ("View"
     ("View"
      ["Day View" org-agenda-day-view
      ["Day View" org-agenda-day-view
       :active (org-agenda-check-type nil 'agenda)
       :active (org-agenda-check-type nil 'agenda)
-      :style radio :selected (equal org-agenda-ndays 1)
+      :style radio :selected (eq org-agenda-current-span 'day)
       :keys "v d  (or just d)"]
       :keys "v d  (or just d)"]
      ["Week View" org-agenda-week-view
      ["Week View" org-agenda-week-view
       :active (org-agenda-check-type nil 'agenda)
       :active (org-agenda-check-type nil 'agenda)
-      :style radio :selected (equal org-agenda-ndays 7)
+      :style radio :selected (eq org-agenda-current-span 'week)
       :keys "v w  (or just w)"]
       :keys "v w  (or just w)"]
      ["Month View" org-agenda-month-view
      ["Month View" org-agenda-month-view
       :active (org-agenda-check-type nil 'agenda)
       :active (org-agenda-check-type nil 'agenda)
-      :style radio :selected (member org-agenda-ndays '(28 29 30 31))
+      :style radio :selected (eq org-agenda-current-span 'month)
       :keys "v m"]
       :keys "v m"]
      ["Year View" org-agenda-year-view
      ["Year View" org-agenda-year-view
       :active (org-agenda-check-type nil 'agenda)
       :active (org-agenda-check-type nil 'agenda)
-      :style radio :selected (member org-agenda-ndays '(365 366))
+      :style radio :selected (eq org-agenda-current-span 'year)
       :keys "v y"]
       :keys "v y"]
      "--"
      "--"
      ["Include Diary" org-agenda-toggle-diary
      ["Include Diary" org-agenda-toggle-diary
@@ -3295,7 +3340,8 @@ When EMPTY is non-nil, also include days without any entries."
 (defvar org-agenda-last-arguments nil
 (defvar org-agenda-last-arguments nil
   "The arguments of the previous call to `org-agenda'.")
   "The arguments of the previous call to `org-agenda'.")
 (defvar org-starting-day nil) ; local variable in the agenda buffer
 (defvar org-starting-day nil) ; local variable in the agenda buffer
-(defvar org-agenda-span nil) ; local variable in the agenda buffer
+(defvar org-agenda-current-span nil
+  "The current span used in the agenda view.") ; local variable in the agenda buffer
 (defvar org-include-all-loc nil) ; local variable
 (defvar org-include-all-loc nil) ; local variable
 
 
 (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
 (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
@@ -3332,7 +3378,7 @@ somewhat less efficient) way of determining what is included in
 the daily/weekly agenda, see `org-agenda-skip-function'.")
 the daily/weekly agenda, see `org-agenda-skip-function'.")
 
 
 ;;;###autoload
 ;;;###autoload
-(defun org-agenda-list (&optional include-all start-day ndays)
+(defun org-agenda-list (&optional include-all start-day span)
   "Produce a daily/weekly view from all files in variable `org-agenda-files'.
   "Produce a daily/weekly view from all files in variable `org-agenda-files'.
 The view will be for the current day or week, but from the overview buffer
 The view will be for the current day or week, but from the overview buffer
 you will be able to go to other days/weeks.
 you will be able to go to other days/weeks.
@@ -3343,35 +3389,36 @@ This feature is considered obsolete, please use the TODO list or a block
 agenda instead.
 agenda instead.
 
 
 With a numeric prefix argument in an interactive call, the agenda will
 With a numeric prefix argument in an interactive call, the agenda will
-span INCLUDE-ALL days.  Lisp programs should instead specify NDAYS to change
-the number of days.  NDAYS defaults to `org-agenda-ndays'.
+span INCLUDE-ALL days.  Lisp programs should instead specify SPAN to change
+the number of days.  SPAN defaults to `org-agenda-span'.
 
 
 START-DAY defaults to TODAY, or to the most recent match for the weekday
 START-DAY defaults to TODAY, or to the most recent match for the weekday
 given in `org-agenda-start-on-weekday'."
 given in `org-agenda-start-on-weekday'."
   (interactive "P")
   (interactive "P")
   (if (and (integerp include-all) (> include-all 0))
   (if (and (integerp include-all) (> include-all 0))
-      (setq ndays include-all include-all nil))
-  (setq ndays (or ndays org-agenda-ndays)
-	start-day (or start-day org-agenda-start-day))
+      (setq span include-all include-all nil))
+  (setq start-day (or start-day org-agenda-start-day))
   (if org-agenda-overriding-arguments
   (if org-agenda-overriding-arguments
       (setq include-all (car org-agenda-overriding-arguments)
       (setq include-all (car org-agenda-overriding-arguments)
 	    start-day (nth 1 org-agenda-overriding-arguments)
 	    start-day (nth 1 org-agenda-overriding-arguments)
-	    ndays (nth 2 org-agenda-overriding-arguments)))
+	    span (nth 2 org-agenda-overriding-arguments)))
   (if (stringp start-day)
   (if (stringp start-day)
       ;; Convert to an absolute day number
       ;; Convert to an absolute day number
       (setq start-day (time-to-days (org-read-date nil t start-day))))
       (setq start-day (time-to-days (org-read-date nil t start-day))))
-  (setq org-agenda-last-arguments (list include-all start-day ndays))
+  (setq org-agenda-last-arguments (list include-all start-day span))
   (org-compile-prefix-format 'agenda)
   (org-compile-prefix-format 'agenda)
   (org-set-sorting-strategy 'agenda)
   (org-set-sorting-strategy 'agenda)
-  (let* ((org-agenda-start-on-weekday
-	  (if (or (equal ndays 7) (and (null ndays) (equal 7 org-agenda-ndays)))
-	      org-agenda-start-on-weekday nil))
+  (let* ((span (org-agenda-ndays-to-span (or span org-agenda-ndays org-agenda-span)))
+	 (today (org-agenda-today))
+	 (sd (or start-day today))
+	 (ndays (org-agenda-span-to-ndays span sd))
+	 (org-agenda-start-on-weekday
+	  (if (eq ndays 7)
+	      org-agenda-start-on-weekday))
 	 (thefiles (org-agenda-files nil 'ifmode))
 	 (thefiles (org-agenda-files nil 'ifmode))
 	 (files thefiles)
 	 (files thefiles)
-	 (today (org-today))
-	 (sd (or start-day today))
 	 (start (if (or (null org-agenda-start-on-weekday)
 	 (start (if (or (null org-agenda-start-on-weekday)
-			(< org-agenda-ndays 7))
+			(< ndays 7))
 		    sd
 		    sd
 		  (let* ((nt (calendar-day-of-week
 		  (let* ((nt (calendar-day-of-week
 			      (calendar-gregorian-from-absolute sd)))
 			      (calendar-gregorian-from-absolute sd)))
@@ -3381,24 +3428,19 @@ given in `org-agenda-start-on-weekday'."
 	 (day-numbers (list start))
 	 (day-numbers (list start))
 	 (day-cnt 0)
 	 (day-cnt 0)
 	 (inhibit-redisplay (not debug-on-error))
 	 (inhibit-redisplay (not debug-on-error))
-	 s e rtn rtnall file date d start-pos end-pos todayp nd
+	 s e rtn rtnall file date d start-pos end-pos todayp
 	 clocktable-start clocktable-end filter)
 	 clocktable-start clocktable-end filter)
     (setq org-agenda-redo-command
     (setq org-agenda-redo-command
-	  (list 'org-agenda-list (list 'quote include-all) start-day ndays))
-    ;; Make the list of days
-    (setq ndays (or ndays org-agenda-ndays)
-	  nd ndays)
-    (while (> ndays 1)
-      (push (1+ (car day-numbers)) day-numbers)
-      (setq ndays (1- ndays)))
+	  (list 'org-agenda-list (list 'quote include-all) start-day (list 'quote span)))
+    (dotimes (n (1- ndays))
+      (push (1+ (car day-numbers)) day-numbers))
     (setq day-numbers (nreverse day-numbers))
     (setq day-numbers (nreverse day-numbers))
     (setq clocktable-start (car day-numbers)
     (setq clocktable-start (car day-numbers)
 	  clocktable-end (1+ (or (org-last day-numbers) 0)))
 	  clocktable-end (1+ (or (org-last day-numbers) 0)))
     (org-prepare-agenda "Day/Week")
     (org-prepare-agenda "Day/Week")
     (org-set-local 'org-starting-day (car day-numbers))
     (org-set-local 'org-starting-day (car day-numbers))
     (org-set-local 'org-include-all-loc include-all)
     (org-set-local 'org-include-all-loc include-all)
-    (org-set-local 'org-agenda-span
-		   (org-agenda-ndays-to-span nd))
+    (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span))
     (when (and (or include-all org-agenda-include-all-todo)
     (when (and (or include-all org-agenda-include-all-todo)
 	       (member today day-numbers))
 	       (member today day-numbers))
       (setq files thefiles
       (setq files thefiles
@@ -3426,7 +3468,7 @@ given in `org-agenda-start-on-weekday'."
 	(if org-agenda-overriding-header
 	(if org-agenda-overriding-header
 	    (insert (org-add-props (copy-sequence org-agenda-overriding-header)
 	    (insert (org-add-props (copy-sequence org-agenda-overriding-header)
 			nil 'face 'org-agenda-structure) "\n")
 			nil 'face 'org-agenda-structure) "\n")
-	  (insert (capitalize (symbol-name (org-agenda-ndays-to-span nd)))
+	  (insert (org-agenda-span-name span)
 		  "-agenda"
 		  "-agenda"
 		  (if (< (- d2 d1) 350)
 		  (if (< (- d2 d1) 350)
 		      (if (= w1 w2)
 		      (if (= w1 w2)
@@ -3491,7 +3533,7 @@ given in `org-agenda-start-on-weekday'."
 	    (if rtnall (insert
 	    (if rtnall (insert
 			(org-finalize-agenda-entries
 			(org-finalize-agenda-entries
 			 (org-agenda-add-time-grid-maybe
 			 (org-agenda-add-time-grid-maybe
-			  rtnall nd todayp))
+			  rtnall ndays todayp))
 			"\n"))
 			"\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))))
 	    (put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
@@ -3532,7 +3574,31 @@ given in `org-agenda-start-on-weekday'."
     (message "")))
     (message "")))
 
 
 (defun org-agenda-ndays-to-span (n)
 (defun org-agenda-ndays-to-span (n)
-  (cond ((< n 7) 'day) ((= n 7) 'week) ((< n 32) 'month) (t 'year)))
+  "Return a span symbol for a span of N days, or N if none matches."
+  (cond ((symbolp n) n)
+	((= n 1) 'day)
+	((= n 7) 'week)
+	(t n)))
+
+(defun org-agenda-span-to-ndays (span start-day)
+  "Return ndays from SPAN starting at START-DAY."
+  (cond ((numberp span) span)
+	((eq span 'day) 1)
+	((eq span 'week) 7)
+	((eq span 'month)
+	 (let ((date (calendar-gregorian-from-absolute start-day)))
+	   (calendar-last-day-of-month (car date) (caddr date))))
+	((eq span 'year)
+	 (let ((date (calendar-gregorian-from-absolute start-day)))
+	   (if (calendar-leap-year-p (caddr date)) 366 365)))))
+
+(defun org-agenda-span-name (span)
+  "Return a SPAN name."
+  (if (null span)
+      ""
+    (if (symbolp span)
+	(capitalize (symbol-name span))
+      (format "%d days" span))))
 
 
 ;;; Agenda word search
 ;;; Agenda word search
 
 
@@ -4435,7 +4501,8 @@ the documentation of `org-diary'."
   "Do we have a reason to ignore this TODO entry because it has a time stamp?"
   "Do we have a reason to ignore this TODO entry because it has a time stamp?"
   (when (or org-agenda-todo-ignore-with-date
   (when (or org-agenda-todo-ignore-with-date
 	    org-agenda-todo-ignore-scheduled
 	    org-agenda-todo-ignore-scheduled
-	    org-agenda-todo-ignore-deadlines)
+	    org-agenda-todo-ignore-deadlines
+	    org-agenda-todo-ignore-timestamp)
     (setq end (or end (save-excursion (outline-next-heading) (point))))
     (setq end (or end (save-excursion (outline-next-heading) (point))))
     (save-excursion
     (save-excursion
       (or (and org-agenda-todo-ignore-with-date
       (or (and org-agenda-todo-ignore-with-date
@@ -4458,7 +4525,29 @@ the documentation of `org-diary'."
 		 (> (org-days-to-time (match-string 1)) 0))
 		 (> (org-days-to-time (match-string 1)) 0))
 		((eq org-agenda-todo-ignore-deadlines 'past)
 		((eq org-agenda-todo-ignore-deadlines 'past)
 		 (<= (org-days-to-time (match-string 1)) 0))
 		 (<= (org-days-to-time (match-string 1)) 0))
-		(t (org-deadline-close (match-string 1)))))))))
+		(t (org-deadline-close (match-string 1)))))
+	  (and org-agenda-todo-ignore-timestamp
+	       (let ((buffer (current-buffer))
+		     (regexp
+		      (concat
+		       org-scheduled-time-regexp "\\|" org-deadline-time-regexp))
+		     (start (point)))
+		 ;; Copy current buffer into a temporary one
+		 (with-temp-buffer
+		   (insert-buffer-substring buffer start end)
+		   (goto-char (point-min))
+		   ;; Delete SCHEDULED and DEADLINE items
+		   (while (re-search-forward regexp end t)
+		     (delete-region (match-beginning 0) (match-end 0)))
+		   (goto-char (point-min))
+		   ;; No search for timestamp left
+		   (when (re-search-forward org-ts-regexp nil t)
+		     (cond
+		      ((eq org-agenda-todo-ignore-timestamp 'future)
+		       (> (org-days-to-time (match-string 1)) 0))
+		      ((eq org-agenda-todo-ignore-timestamp 'past)
+		       (<= (org-days-to-time (match-string 1)) 0))
+		      (t))))))))))
 
 
 (defconst org-agenda-no-heading-message
 (defconst org-agenda-no-heading-message
   "No heading for this item in buffer or region.")
   "No heading for this item in buffer or region.")
@@ -5044,7 +5133,9 @@ Any match of REMOVE-RE will be removed from TXT."
 	       org-agenda-show-inherited-tags
 	       org-agenda-show-inherited-tags
 	       org-agenda-hide-tags-regexp))
 	       org-agenda-hide-tags-regexp))
     (let* ((category (or category
     (let* ((category (or category
-			 org-category
+			 (if (stringp org-category)
+			     org-category
+			   (and org-category (symbol-name org-category)))
 			 (if buffer-file-name
 			 (if buffer-file-name
 			     (file-name-sans-extension
 			     (file-name-sans-extension
 			      (file-name-nondirectory buffer-file-name))
 			      (file-name-nondirectory buffer-file-name))
@@ -5947,11 +6038,9 @@ Negative selection means regexp must not match for selection of an entry."
     (cond
     (cond
      (tdpos (goto-char tdpos))
      (tdpos (goto-char tdpos))
      ((eq org-agenda-type 'agenda)
      ((eq org-agenda-type 'agenda)
-      (let* ((sd (org-agenda-today))
-	     (comp (org-agenda-compute-time-span sd org-agenda-span))
+      (let* ((sd (org-agenda-compute-starting-span (org-agenda-today) (or org-agenda-ndays org-agenda-span)))
 	     (org-agenda-overriding-arguments org-agenda-last-arguments))
 	     (org-agenda-overriding-arguments org-agenda-last-arguments))
-	(setf (nth 1 org-agenda-overriding-arguments) (car comp))
-	(setf (nth 2 org-agenda-overriding-arguments) (cdr comp))
+	(setf (nth 1 org-agenda-overriding-arguments) sd)
 	(org-agenda-redo)
 	(org-agenda-redo)
 	(org-agenda-find-same-or-today-or-agenda)))
 	(org-agenda-find-same-or-today-or-agenda)))
      (t (error "Cannot find today")))))
      (t (error "Cannot find today")))))
@@ -5968,28 +6057,28 @@ Negative selection means regexp must not match for selection of an entry."
 With prefix ARG, go forward that many times the current span."
 With prefix ARG, go forward that many times the current span."
   (interactive "p")
   (interactive "p")
   (org-agenda-check-type t 'agenda)
   (org-agenda-check-type t 'agenda)
-  (let* ((span org-agenda-span)
+  (let* ((span org-agenda-current-span)
 	 (sd org-starting-day)
 	 (sd org-starting-day)
 	 (greg (calendar-gregorian-from-absolute sd))
 	 (greg (calendar-gregorian-from-absolute sd))
 	 (cnt (org-get-at-bol 'org-day-cnt))
 	 (cnt (org-get-at-bol 'org-day-cnt))
-	 greg2 nd)
+	 greg2)
     (cond
     (cond
      ((eq span 'day)
      ((eq span 'day)
-      (setq sd (+ arg sd) nd 1))
+      (setq sd (+ arg sd)))
      ((eq span 'week)
      ((eq span 'week)
-      (setq sd (+ (* 7 arg) sd) nd 7))
+      (setq sd (+ (* 7 arg) sd)))
      ((eq span 'month)
      ((eq span 'month)
       (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
       (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
 	    sd (calendar-absolute-from-gregorian greg2))
 	    sd (calendar-absolute-from-gregorian greg2))
-      (setcar greg2 (1+ (car greg2)))
-      (setq nd (- (calendar-absolute-from-gregorian greg2) sd)))
+      (setcar greg2 (1+ (car greg2))))
      ((eq span 'year)
      ((eq span 'year)
       (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg)))
       (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg)))
 	    sd (calendar-absolute-from-gregorian greg2))
 	    sd (calendar-absolute-from-gregorian greg2))
-      (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2)))
-      (setq nd (- (calendar-absolute-from-gregorian greg2) sd))))
+      (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))))
+     (t
+      (setq sd (+ (* span arg) sd))))
     (let ((org-agenda-overriding-arguments
     (let ((org-agenda-overriding-arguments
-	   (list (car org-agenda-last-arguments) sd nd t)))
+	   (list (car org-agenda-last-arguments) sd span t)))
       (org-agenda-redo)
       (org-agenda-redo)
       (org-agenda-find-same-or-today-or-agenda cnt))))
       (org-agenda-find-same-or-today-or-agenda cnt))))
 
 
@@ -6032,7 +6121,6 @@ With prefix ARG, go backward that many times the current span."
   "Switch to daily view for agenda.
   "Switch to daily view for agenda.
 With argument DAY-OF-YEAR, switch to that day of the year."
 With argument DAY-OF-YEAR, switch to that day of the year."
   (interactive "P")
   (interactive "P")
-  (setq org-agenda-ndays 1)
   (org-agenda-change-time-span 'day day-of-year))
   (org-agenda-change-time-span 'day day-of-year))
 (defun org-agenda-week-view (&optional iso-week)
 (defun org-agenda-week-view (&optional iso-week)
   "Switch to daily view for agenda.
   "Switch to daily view for agenda.
@@ -6042,7 +6130,6 @@ week.  Any digits before this encode a year.  So 200712 means
 week 12 of year 2007.  Years in the range 1938-2037 can also be
 week 12 of year 2007.  Years in the range 1938-2037 can also be
 written as 2-digit years."
 written as 2-digit years."
   (interactive "P")
   (interactive "P")
-  (setq org-agenda-ndays 7)
   (org-agenda-change-time-span 'week iso-week))
   (org-agenda-change-time-span 'week iso-week))
 (defun org-agenda-month-view (&optional month)
 (defun org-agenda-month-view (&optional month)
   "Switch to monthly view for agenda.
   "Switch to monthly view for agenda.
@@ -6067,70 +6154,61 @@ written as 2-digit years."
   "Change the agenda view to SPAN.
   "Change the agenda view to SPAN.
 SPAN may be `day', `week', `month', `year'."
 SPAN may be `day', `week', `month', `year'."
   (org-agenda-check-type t 'agenda)
   (org-agenda-check-type t 'agenda)
-  (if (and (not n) (equal org-agenda-span span))
+  (if (and (not n) (equal org-agenda-current-span span))
       (error "Viewing span is already \"%s\"" span))
       (error "Viewing span is already \"%s\"" span))
   (let* ((sd (or (org-get-at-bol 'day)
   (let* ((sd (or (org-get-at-bol 'day)
 		org-starting-day))
 		org-starting-day))
-	 (computed (org-agenda-compute-time-span sd span n))
+	 (sd (org-agenda-compute-starting-span sd span n))
 	 (org-agenda-overriding-arguments
 	 (org-agenda-overriding-arguments
-	  (list (car org-agenda-last-arguments)
-		(car computed) (cdr computed) t)))
+	  (list (car org-agenda-last-arguments) sd span t)))
     (org-agenda-redo)
     (org-agenda-redo)
     (org-agenda-find-same-or-today-or-agenda))
     (org-agenda-find-same-or-today-or-agenda))
   (org-agenda-set-mode-name)
   (org-agenda-set-mode-name)
   (message "Switched to %s view" span))
   (message "Switched to %s view" span))
 
 
-(defun org-agenda-compute-time-span (sd span &optional n)
-  "Compute starting date and number of days for agenda.
+(defun org-agenda-compute-starting-span (sd span &optional n)
+  "Compute starting date for agenda.
 SPAN may be `day', `week', `month', `year'.  The return value
 SPAN may be `day', `week', `month', `year'.  The return value
 is a cons cell with the starting date and the number of days,
 is a cons cell with the starting date and the number of days,
 so that the date SD will be in that range."
 so that the date SD will be in that range."
   (let* ((greg (calendar-gregorian-from-absolute sd))
   (let* ((greg (calendar-gregorian-from-absolute sd))
 	 (dg (nth 1 greg))
 	 (dg (nth 1 greg))
 	 (mg (car greg))
 	 (mg (car greg))
-	 (yg (nth 2 greg))
-	 nd w1 y1 m1 thisweek)
+	 (yg (nth 2 greg)))
     (cond
     (cond
      ((eq span 'day)
      ((eq span 'day)
       (when n
       (when n
 	(setq sd (+ (calendar-absolute-from-gregorian
 	(setq sd (+ (calendar-absolute-from-gregorian
 		     (list mg 1 yg))
 		     (list mg 1 yg))
-		    n -1)))
-      (setq nd 1))
+		    n -1))))
      ((eq span 'week)
      ((eq span 'week)
       (let* ((nt (calendar-day-of-week
       (let* ((nt (calendar-day-of-week
 		  (calendar-gregorian-from-absolute sd)))
 		  (calendar-gregorian-from-absolute sd)))
 	     (d (if org-agenda-start-on-weekday
 	     (d (if org-agenda-start-on-weekday
 		    (- nt org-agenda-start-on-weekday)
 		    (- nt org-agenda-start-on-weekday)
-		  0)))
+		  0))
+	     y1)
 	(setq sd (- sd (+ (if (< d 0) 7 0) d)))
 	(setq sd (- sd (+ (if (< d 0) 7 0) d)))
 	(when n
 	(when n
 	  (require 'cal-iso)
 	  (require 'cal-iso)
-	  (setq thisweek (car (calendar-iso-from-absolute sd)))
 	  (when (> n 99)
 	  (when (> n 99)
 	    (setq y1 (org-small-year-to-year (/ n 100))
 	    (setq y1 (org-small-year-to-year (/ n 100))
 		  n (mod n 100)))
 		  n (mod n 100)))
 	  (setq sd
 	  (setq sd
 		(calendar-absolute-from-iso
 		(calendar-absolute-from-iso
 		 (list n 1
 		 (list n 1
-		       (or y1 (nth 2 (calendar-iso-from-absolute sd)))))))
-	(setq nd 7)))
+		       (or y1 (nth 2 (calendar-iso-from-absolute sd)))))))))
      ((eq span 'month)
      ((eq span 'month)
-      (when (and n (> n 99))
-	(setq y1 (org-small-year-to-year (/ n 100))
-	      n (mod n 100)))
-      (setq sd (calendar-absolute-from-gregorian
-		(list (or n mg) 1 (or y1 yg)))
-	    nd (- (calendar-absolute-from-gregorian
-		   (list (1+ (or n mg)) 1 (or y1 yg)))
-		  sd)))
+      (let (y1)
+	(when (and n (> n 99))
+	  (setq y1 (org-small-year-to-year (/ n 100))
+		n (mod n 100)))
+	(setq sd (calendar-absolute-from-gregorian
+		  (list (or n mg) 1 (or y1 yg))))))
      ((eq span 'year)
      ((eq span 'year)
       (setq sd (calendar-absolute-from-gregorian
       (setq sd (calendar-absolute-from-gregorian
-		(list 1 1 (or n yg)))
-	    nd (- (calendar-absolute-from-gregorian
-		   (list 1 1 (1+ (or n yg))))
-		  sd))))
-    (cons sd nd)))
+		(list 1 1 (or n yg))))))
+    sd))
 
 
 (defun org-agenda-next-date-line (&optional arg)
 (defun org-agenda-next-date-line (&optional arg)
   "Jump to the next line indicating a date in agenda buffer."
   "Jump to the next line indicating a date in agenda buffer."
@@ -6261,7 +6339,7 @@ When called with a prefix argument, include all archive files as well."
 	   (if org-agenda-include-diary "on" "off")))
 	   (if org-agenda-include-diary "on" "off")))
 
 
 (defun org-agenda-toggle-deadlines ()
 (defun org-agenda-toggle-deadlines ()
-  "Toggle diary inclusion in an agenda buffer."
+  "Toggle inclusion of entries with a deadline in an agenda buffer."
   (interactive)
   (interactive)
   (org-agenda-check-type t 'agenda)
   (org-agenda-check-type t 'agenda)
   (setq org-agenda-include-deadlines (not org-agenda-include-deadlines))
   (setq org-agenda-include-deadlines (not org-agenda-include-deadlines))
@@ -6283,36 +6361,36 @@ When called with a prefix argument, include all archive files as well."
 (defun org-agenda-set-mode-name ()
 (defun org-agenda-set-mode-name ()
   "Set the mode name to indicate all the small mode settings."
   "Set the mode name to indicate all the small mode settings."
   (setq mode-name
   (setq mode-name
-	(concat "Org-Agenda"
-		(if (get 'org-agenda-files 'org-restrict) " []" "")
-		(if (equal org-agenda-ndays 1) " Day"    "")
-		(if (equal org-agenda-ndays 7) " Week"   "")
-		(if org-agenda-follow-mode     " Follow" "")
-		(if org-agenda-entry-text-mode " ETxt"   "")
-		(if org-agenda-include-diary   " Diary"  "")
-		(if org-agenda-include-deadlines " Ddl"  "")
-		(if org-agenda-use-time-grid   " Grid"   "")
-		(if (and (boundp 'org-habit-show-habits)
-			 org-habit-show-habits) " Habit"   "")
-		(if (consp org-agenda-show-log) " LogAll"
-		  (if org-agenda-show-log " Log" ""))
-		(if (or org-agenda-filter (get 'org-agenda-filter
-					       :preset-filter))
-		    (concat " {" (mapconcat
-				  'identity
-				  (append (get 'org-agenda-filter
-					       :preset-filter)
-					  org-agenda-filter) "") "}")
-		  "")
-		(if org-agenda-archives-mode
-		    (if (eq org-agenda-archives-mode t)
-			" Archives"
-		      (format " :%s:" org-archive-tag))
-		  "")
-		(if org-agenda-clockreport-mode
-		    (if (eq org-agenda-clockreport-mode 'with-filter)
-			" Clock{}" " Clock")
-		  "")))
+	(list "Org-Agenda"
+	      (if (get 'org-agenda-files 'org-restrict) " []" "")
+	      " "
+	      '(:eval (org-agenda-span-name org-agenda-current-span))
+	      (if org-agenda-follow-mode     " Follow" "")
+	      (if org-agenda-entry-text-mode " ETxt"   "")
+	      (if org-agenda-include-diary   " Diary"  "")
+	      (if org-agenda-include-deadlines " Ddl"  "")
+	      (if org-agenda-use-time-grid   " Grid"   "")
+	      (if (and (boundp 'org-habit-show-habits)
+		       org-habit-show-habits) " Habit"   "")
+	      (if (consp org-agenda-show-log) " LogAll"
+		(if org-agenda-show-log " Log" ""))
+	      (if (or org-agenda-filter (get 'org-agenda-filter
+					     :preset-filter))
+		  (concat " {" (mapconcat
+				'identity
+				(append (get 'org-agenda-filter
+					     :preset-filter)
+					org-agenda-filter) "") "}")
+		"")
+	      (if org-agenda-archives-mode
+		  (if (eq org-agenda-archives-mode t)
+		      " Archives"
+		    (format " :%s:" org-archive-tag))
+		"")
+	      (if org-agenda-clockreport-mode
+		  (if (eq org-agenda-clockreport-mode 'with-filter)
+		      " Clock{}" " Clock")
+		"")))
   (force-mode-line-update))
   (force-mode-line-update))
 
 
 (defun org-agenda-post-command-hook ()
 (defun org-agenda-post-command-hook ()

+ 187 - 55
lisp/org-clock.el

@@ -1654,6 +1654,62 @@ buffer and update it."
 	   (>= (match-end 0) pos)
 	   (>= (match-end 0) pos)
 	   start))))
 	   start))))
 
 
+(defun org-day-of-week (day month year)
+  "Returns the day of the week as an integer."
+  (nth 6
+       (decode-time
+	(date-to-time
+	 (format "%d-%02d-%02dT00:00:00" year month day)))))
+
+(defun org-quarter-to-date (quarter year)
+  "Get the date (week day year) of the first day of a given quarter."
+  (let (startday)
+    (cond
+     ((= quarter 1)
+      (setq startday (org-day-of-week 1 1 year))
+      (cond
+       ((= startday 0)
+	(list 52 7 (- year 1)))
+       ((= startday 6)
+	(list 52 6 (- year 1)))
+       ((<= startday 4)
+	(list 1 startday year))
+       ((> startday 4)
+	(list 53 startday (- year 1)))
+       )
+      )
+     ((= quarter 2)
+      (setq startday (org-day-of-week 1 4 year))
+      (cond
+       ((= startday 0)
+	(list 13 startday year))
+       ((< startday 4)
+	(list 14 startday year))
+       ((>= startday 4)
+	(list 13 startday year))
+       )
+      )
+     ((= quarter 3)
+      (setq startday (org-day-of-week 1 7 year))
+      (cond
+       ((= startday 0)
+	(list 26 startday year))
+       ((< startday 4)
+	(list 27 startday year))
+       ((>= startday 4)
+	(list 26 startday year))
+       )
+      )
+     ((= quarter 4)
+      (setq startday (org-day-of-week 1 10 year))
+      (cond
+       ((= startday 0)
+	(list 39 startday year))
+       ((<= startday 4)
+	(list 40 startday year))
+       ((> startday 4)
+	(list 39 startday year)))))))
+
 (defun org-clock-special-range (key &optional time as-strings)
 (defun org-clock-special-range (key &optional time as-strings)
   "Return two times bordering a special time range.
   "Return two times bordering a special time range.
 Key is a symbol specifying the range and can be one of `today', `yesterday',
 Key is a symbol specifying the range and can be one of `today', `yesterday',
@@ -1670,7 +1726,12 @@ the returned times will be formatted strings."
 	 (dow (nth 6 tm))
 	 (dow (nth 6 tm))
 	 (skey (symbol-name key))
 	 (skey (symbol-name key))
 	 (shift 0)
 	 (shift 0)
-	 s1 m1 h1 d1 month1 y1 diff ts te fm txt w date)
+         (q (cond ((>= (nth 4 tm) 10) 4)
+                  ((>= (nth 4 tm) 7) 3)
+                  ((>= (nth 4 tm) 4) 2)
+                  ((>= (nth 4 tm) 1) 1)))
+	 s1 m1 h1 d1 month1 y1 diff ts te fm txt w date
+	 interval tmp shiftedy shiftedm shiftedq)
     (cond
     (cond
      ((string-match "^[0-9]+$" skey)
      ((string-match "^[0-9]+$" skey)
       (setq y (string-to-number skey) m 1 d 1 key 'year))
       (setq y (string-to-number skey) m 1 d 1 key 'year))
@@ -1687,6 +1748,15 @@ the returned times will be formatted strings."
       (setq d (nth 1 date) month (car date) y (nth 2 date)
       (setq d (nth 1 date) month (car date) y (nth 2 date)
 	    dow 1
 	    dow 1
 	    key 'week))
 	    key 'week))
+      ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey)
+       (require 'cal-iso)
+       (setq y (string-to-number (match-string 1 skey)))
+       (setq q (string-to-number (match-string 2 skey)))
+       (setq date (calendar-gregorian-from-absolute
+                   (calendar-absolute-from-iso (org-quarter-to-date q y))))
+       (setq d (nth 1 date) month (car date) y (nth 2 date)
+            dow 1
+            key 'quarter))
      ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey)
      ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey)
       (setq y (string-to-number (match-string 1 skey))
       (setq y (string-to-number (match-string 1 skey))
 	    month (string-to-number (match-string 2 skey))
 	    month (string-to-number (match-string 2 skey))
@@ -1694,12 +1764,17 @@ the returned times will be formatted strings."
 	    key 'day))
 	    key 'day))
      ((string-match "\\([-+][0-9]+\\)$" skey)
      ((string-match "\\([-+][0-9]+\\)$" skey)
       (setq shift (string-to-number (match-string 1 skey))
       (setq shift (string-to-number (match-string 1 skey))
-	    key (intern (substring skey 0 (match-beginning 1))))))
+            key (intern (substring skey 0 (match-beginning 1))))
+       (if(and (memq key '(quarter thisq)) (> shift 0))
+         (error "Looking forward with quarters isn't implemented.")
+        ())))
+
     (when (= shift 0)
     (when (= shift 0)
-      (cond ((eq key 'yesterday) (setq key 'today shift -1))
-	    ((eq key 'lastweek)  (setq key 'week  shift -1))
-	    ((eq key 'lastmonth) (setq key 'month shift -1))
-	    ((eq key 'lastyear)  (setq key 'year  shift -1))))
+       (cond ((eq key 'yesterday) (setq key 'today   shift -1))
+            ((eq key 'lastweek)  (setq key 'week    shift -1))
+            ((eq key 'lastmonth) (setq key 'month   shift -1))
+            ((eq key 'lastyear)  (setq key 'year    shift -1))
+            ((eq key 'lastq)     (setq key 'quarter shift -1))))
     (cond
     (cond
      ((memq key '(day today))
      ((memq key '(day today))
       (setq d (+ d shift) h 0 m 0 h1 24 m1 0))
       (setq d (+ d shift) h 0 m 0 h1 24 m1 0))
@@ -1708,6 +1783,28 @@ the returned times will be formatted strings."
 	    m 0 h 0 d (- d diff) d1 (+ 7 d)))
 	    m 0 h 0 d (- d diff) d1 (+ 7 d)))
      ((memq key '(month thismonth))
      ((memq key '(month thismonth))
       (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0))
       (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0))
+     ((memq key '(quarter thisq))
+      ; compute if this shift remains in this year
+      ; if not, compute how many years and quarters we have to shift (via floor*)
+      ; and compute the shifted years, months and quarters
+      (cond
+       ((< (+ (- q 1) shift) 0) ; shift not in this year
+       (setq interval (* -1 (+ (- q 1) shift)))
+       ; set tmp to ((years to shift) (quarters to shift))
+       (setq tmp (org-floor* interval 4))
+       ; due to the use of floor, 0 quarters actually means 4
+       (if (= 0 (nth 1 tmp))
+           (setq shiftedy (- y (nth 0 tmp))
+                 shiftedm 1
+                 shiftedq 1)
+         (setq shiftedy (- y (+ 1 (nth 0 tmp)))
+               shiftedm (- 13 (* 3 (nth 1 tmp)))
+               shiftedq (- 5 (nth 1 tmp))))
+       (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy))
+       ((> (+ q shift) 0) ; shift is whitin this year
+       (setq shiftedq (+ q shift))
+       (setq shiftedy y)
+       (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
      ((memq key '(year thisyear))
      ((memq key '(year thisyear))
       (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
       (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
      (t (error "No such time block %s" key)))
      (t (error "No such time block %s" key)))
@@ -1723,11 +1820,21 @@ the returned times will be formatted strings."
      ((memq key '(month thismonth))
      ((memq key '(month thismonth))
       (setq txt (format-time-string "%B %Y" ts)))
       (setq txt (format-time-string "%B %Y" ts)))
      ((memq key '(year thisyear))
      ((memq key '(year thisyear))
-      (setq txt (format-time-string "the year %Y" ts))))
+      (setq txt (format-time-string "the year %Y" ts)))
+     ((memq key '(quarter thisq))
+      (setq txt (concatenate 'string (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))))
+     )
     (if as-strings
     (if as-strings
 	(list (format-time-string fm ts) (format-time-string fm te) txt)
 	(list (format-time-string fm ts) (format-time-string fm te) txt)
       (list ts te txt))))
       (list ts te txt))))
 
 
+(defun org-count-quarter (n)
+  (cond
+   ((= n 1) "1st")
+   ((= n 2) "2nd")
+   ((= n 3) "3rd")
+   ((= n 4) "4th")))
+
 (defun org-clocktable-shift (dir n)
 (defun org-clocktable-shift (dir n)
   "Try to shift the :block date of the clocktable at point.
   "Try to shift the :block date of the clocktable at point.
 Point must be in the #+BEGIN: line of a clocktable, or this function
 Point must be in the #+BEGIN: line of a clocktable, or this function
@@ -1750,45 +1857,63 @@ the currently selected interval size."
 	 ((equal s "yesterday") (setq s "today-1"))
 	 ((equal s "yesterday") (setq s "today-1"))
 	 ((equal s "lastweek") (setq s "thisweek-1"))
 	 ((equal s "lastweek") (setq s "thisweek-1"))
 	 ((equal s "lastmonth") (setq s "thismonth-1"))
 	 ((equal s "lastmonth") (setq s "thismonth-1"))
-	 ((equal s "lastyear") (setq s "thisyear-1")))
-	(cond
-	 ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\)\\([-+][0-9]+\\)?$" s)
-	  (setq block (match-string 1 s)
-		shift (if (match-end 2)
-			  (string-to-number (match-string 2 s))
-			0))
-	  (setq shift (+ shift n))
-	  (setq ins (if (= shift 0) block (format "%s%+d" block shift))))
-	 ((string-match "\\([0-9]+\\)\\(-\\([wW]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
-	  ;;               1        1  2   3       3  4                4  5   6                6  5   2
-	  (setq y (string-to-number (match-string 1 s))
-		wp (and (match-end 3) (match-string 3 s))
-		mw (and (match-end 4) (string-to-number (match-string 4 s)))
-		d (and (match-end 6) (string-to-number (match-string 6 s))))
-	  (cond
-	   (d (setq ins (format-time-string
-			 "%Y-%m-%d"
-			 (encode-time 0 0 0 (+ d n) m y))))
-	   ((and wp mw (> (length wp) 0))
-	    (require 'cal-iso)
-	    (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (list (+ mw n) 1 y))))
-	    (setq ins (format-time-string
-		       "%G-W%V"
-		       (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
-	   (mw
-	    (setq ins (format-time-string
-		       "%Y-%m"
-		       (encode-time 0 0 0 1 (+ mw n) y))))
-	   (y
-	    (setq ins (number-to-string (+ y n))))))
-	 (t (error "Cannot shift clocktable block")))
-	(when ins
-	  (goto-char b)
-	  (insert ins)
-	  (delete-region (point) (+ (point) (- e b)))
-	  (beginning-of-line 1)
-	  (org-update-dblock)
-	  t)))))
+	 ((equal s "lastyear") (setq s "thisyear-1"))
+	 ((equal s "lastq") (setq s "thisq-1")))
+
+       (cond
+        ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s)
+         (setq block (match-string 1 s)
+               shift (if (match-end 2)
+                         (string-to-number (match-string 2 s))
+                       0))
+         (setq shift (+ shift n))
+         (setq ins (if (= shift 0) block (format "%s%+d" block shift))))
+	((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
+        ;;               1        1  2   3       3  4                  4  5   6                6  5   2
+         (setq y (string-to-number (match-string 1 s))
+               wp (and (match-end 3) (match-string 3 s))
+               mw (and (match-end 4) (string-to-number (match-string 4 s)))
+	       d (and (match-end 6) (string-to-number (match-string 6 s))))
+	 (cond
+	  (d (setq ins (format-time-string
+                        "%Y-%m-%d"
+                        (encode-time 0 0 0 (+ d n) m y))))
+          ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
+           (require 'cal-iso)
+           (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (list (+ mw n) 1 y))))
+           (setq ins (format-time-string
+                      "%G-W%V"
+                      (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
+	  ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
+           (require 'cal-iso)
+	   ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year
+           (if (> (+ mw n) 4)
+               (setq mw 0
+                     y (+ 1 y))
+	     ())
+	   ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year
+           (if (= (+ mw n) 0)
+               (setq mw 5
+                     y (- y 1))
+             ())
+           (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y))))
+           (setq ins (format-time-string
+                      (concatenate 'string (number-to-string y) "-Q" (number-to-string (+ mw n)))
+                      (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
+          (mw
+           (setq ins (format-time-string
+                      "%Y-%m"
+		      (encode-time 0 0 0 1 (+ mw n) y))))
+	  (y
+	   (setq ins (number-to-string (+ y n))))))
+	(t (error "Cannot shift clocktable block")))
+       (when ins
+	 (goto-char b)
+	 (insert ins)
+	 (delete-region (point) (+ (point) (- e b)))
+	 (beginning-of-line 1)
+	 (org-update-dblock)
+	 t)))))
 
 
 (defun org-dblock-write:clocktable (params)
 (defun org-dblock-write:clocktable (params)
   "Write the standard clocktable."
   "Write the standard clocktable."
@@ -1905,7 +2030,7 @@ from the dynamic block defintion."
 	 (indent (plist-get params :indent))
 	 (indent (plist-get params :indent))
 	 range-text total-time tbl level hlc formula pcol
 	 range-text total-time tbl level hlc formula pcol
 	 file-time entries entry headline
 	 file-time entries entry headline
-	 recalc content narrow-cut-p)
+	 recalc content narrow-cut-p tcol)
 
 
     ;; Implement abbreviations
     ;; Implement abbreviations
     (when (plist-get params :compact)
     (when (plist-get params :compact)
@@ -2038,18 +2163,25 @@ from the dynamic block defintion."
       (if (setq formula (plist-get params :formula))
       (if (setq formula (plist-get params :formula))
 	  (cond
 	  (cond
 	   ((eq formula '%)
 	   ((eq formula '%)
-	    (setq pcol (+ 3
+	    ;; compute the column where the % numbers need to go
+	    (setq pcol (+ 2
+			  (if multifile 1 0)
+			  (if level-p 1 0)
+			  (if timestamp 1 0)
+			  (min maxlevel (or ntcol 100))))
+	    ;; compute the column where the total time is
+	    (setq tcol (+ 2
 			  (if multifile 1 0)
 			  (if multifile 1 0)
-			  (min maxlevel (or ntcol 100))
+			  (if level-p 1 0)
 			  (if timestamp 1 0)))
 			  (if timestamp 1 0)))
 	    (insert
 	    (insert
 	     (format
 	     (format
 	      "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f"
 	      "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f"
-	      pcol
-	      (+ 2 (if narrow 1 0))
-	      (+ 3 (if multifile 1 0))
-	      (+ (if multifile 1 0) 3)
-	      (1- pcol)))
+	      pcol            ; the column where the % numbers should go
+	      (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time
+	      tcol            ; column of the total time
+	      tcol (1- pcol)  ; range of columns where times can be found
+	      ))
 	    (setq recalc t))
 	    (setq recalc t))
 	   ((stringp formula)
 	   ((stringp formula)
 	    (insert "\n#+TBLFM: " formula)
 	    (insert "\n#+TBLFM: " formula)
@@ -2071,7 +2203,7 @@ from the dynamic block defintion."
       (when recalc
       (when recalc
 	(if (eq formula '%)
 	(if (eq formula '%)
 	    (save-excursion
 	    (save-excursion
-	      (if narrow (beginning-of-line 2))
+	      (if (and narrow (not narrow-cut-p)) (beginning-of-line 2))
 	      (org-table-goto-column pcol nil 'force)
 	      (org-table-goto-column pcol nil 'force)
 	      (insert "%")))
 	      (insert "%")))
 	(org-table-recalculate 'all))
 	(org-table-recalculate 'all))

+ 6 - 0
lisp/org-compat.el

@@ -418,6 +418,12 @@ LIMIT."
 	      (looking-at (concat "\\(?:"  regexp "\\)\\'")))))
 	      (looking-at (concat "\\(?:"  regexp "\\)\\'")))))
       (not (null pos)))))
       (not (null pos)))))
 
 
+(defun org-floor* (x &optional y)
+  "Return a list of the floor of X and the fractional part of X.
+With two arguments, return floor and remainder of their quotient."
+  (let ((q (floor x y)))
+    (list q (- x (if y (* y q) q)))))
+
 (provide 'org-compat)
 (provide 'org-compat)
 
 
 ;; arch-tag: a0a0579f-e68c-4bdf-9e55-93768b846bbe
 ;; arch-tag: a0a0579f-e68c-4bdf-9e55-93768b846bbe

+ 18 - 0
lisp/org-complete.el

@@ -35,6 +35,16 @@
 (require 'org-macs)
 (require 'org-macs)
 (require 'pcomplete)
 (require 'pcomplete)
 
 
+(declare-function org-split-string "org" (string &optional separators))
+(declare-function org-get-current-options "org-exp" ())
+(declare-function org-make-org-heading-search-string "org"
+		  (&optional string heading))
+(declare-function org-get-buffer-tags "org" ())
+(declare-function org-get-tags "org" ())
+(declare-function org-buffer-property-keys "org"
+		  (&optional include-specials include-defaults include-columns))
+(declare-function org-entry-properties "org" (&optional pom which specific))
+
 ;;;; Customization variables
 ;;;; Customization variables
 
 
 (defgroup org-complete nil
 (defgroup org-complete nil
@@ -119,6 +129,7 @@ When completing for #+STARTUP, for example, this function returns
 		 (car (org-thing-at-point)))
 		 (car (org-thing-at-point)))
 		pcomplete-default-completion-function))))
 		pcomplete-default-completion-function))))
 
 
+(defvar org-additional-option-like-keywords)
 (defun pcomplete/org-mode/file-option ()
 (defun pcomplete/org-mode/file-option ()
   "Complete against all valid file options."
   "Complete against all valid file options."
   (require 'org-exp)
   (require 'org-exp)
@@ -138,6 +149,7 @@ When completing for #+STARTUP, for example, this function returns
 		    org-additional-option-like-keywords)))))
 		    org-additional-option-like-keywords)))))
    (substring pcomplete-stub 2)))
    (substring pcomplete-stub 2)))
   
   
+(defvar org-startup-options)
 (defun pcomplete/org-mode/file-option/startup ()
 (defun pcomplete/org-mode/file-option/startup ()
   "Complete arguments for the #+STARTUP file option."
   "Complete arguments for the #+STARTUP file option."
   (while (pcomplete-here
   (while (pcomplete-here
@@ -158,12 +170,15 @@ When completing for #+STARTUP, for example, this function returns
      (lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars)))))
      (lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars)))))
     (pcomplete-here vars)))
     (pcomplete-here vars)))
 
 
+(defvar org-link-abbrev-alist-local)
+(defvar org-link-abbrev-alist)
 (defun pcomplete/org-mode/link ()
 (defun pcomplete/org-mode/link ()
   "Complete against defined #+LINK patterns."
   "Complete against defined #+LINK patterns."
   (pcomplete-here
   (pcomplete-here
    (pcomplete-uniqify-list (append (mapcar 'car org-link-abbrev-alist-local)
    (pcomplete-uniqify-list (append (mapcar 'car org-link-abbrev-alist-local)
 				   (mapcar 'car org-link-abbrev-alist)))))
 				   (mapcar 'car org-link-abbrev-alist)))))
 
 
+(defvar org-entities)
 (defun pcomplete/org-mode/tex ()
 (defun pcomplete/org-mode/tex ()
   "Complete against TeX-style HTML entity names."
   "Complete against TeX-style HTML entity names."
   (require 'org-entities)
   (require 'org-entities)
@@ -171,10 +186,12 @@ When completing for #+STARTUP, for example, this function returns
 	  (pcomplete-uniqify-list (remove nil (mapcar 'car-safe org-entities)))
 	  (pcomplete-uniqify-list (remove nil (mapcar 'car-safe org-entities)))
 	  (substring pcomplete-stub 1))))
 	  (substring pcomplete-stub 1))))
 
 
+(defvar org-todo-keywords-1)
 (defun pcomplete/org-mode/todo ()
 (defun pcomplete/org-mode/todo ()
   "Complete against known TODO keywords."
   "Complete against known TODO keywords."
   (pcomplete-here (pcomplete-uniqify-list org-todo-keywords-1)))
   (pcomplete-here (pcomplete-uniqify-list org-todo-keywords-1)))
 
 
+(defvar org-todo-line-regexp)
 (defun pcomplete/org-mode/searchhead ()
 (defun pcomplete/org-mode/searchhead ()
   "Complete against all headings.
   "Complete against all headings.
 This needs more work, to handle headings with lots of spaces in them."
 This needs more work, to handle headings with lots of spaces in them."
@@ -190,6 +207,7 @@ This needs more work, to handle headings with lots of spaces in them."
 	(pcomplete-uniqify-list tbl)))
 	(pcomplete-uniqify-list tbl)))
     (substring pcomplete-stub 1))))
     (substring pcomplete-stub 1))))
 
 
+(defvar org-tag-alist)
 (defun pcomplete/org-mode/tag ()
 (defun pcomplete/org-mode/tag ()
   "Complete a tag name.  Omit tags already set."
   "Complete a tag name.  Omit tags already set."
   (while (pcomplete-here
   (while (pcomplete-here

+ 1 - 1
lisp/org-latex.el

@@ -2383,7 +2383,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
 			   "\n"
 			   "\n"
 			   (match-string 1 res))
 			   (match-string 1 res))
 		   t t res)))
 		   t t res)))
-      (insert res "\n"))))
+      (insert res))))
 
 
 (defconst org-latex-entities
 (defconst org-latex-entities
  '("\\!"
  '("\\!"

+ 5 - 1
lisp/org-list.el

@@ -518,7 +518,11 @@ List ending is determined by the indentation of text. See
 	      (setq ind-ref ind)
 	      (setq ind-ref ind)
 	      (forward-line 1))
 	      (forward-line 1))
 	     ((<= ind ind-ref)
 	     ((<= ind ind-ref)
-	      (throw 'exit (point-at-bol)))
+	      (throw 'exit (progn
+			     ;; Again, ensure bottom is just after a
+			     ;; non-blank line.
+			     (skip-chars-backward " \r\t\n")
+			     (min (point-max) (1+ (point-at-eol))))))
 	     ((looking-at "#\\+begin_")
 	     ((looking-at "#\\+begin_")
 	      (re-search-forward "[ \t]*#\\+end_")
 	      (re-search-forward "[ \t]*#\\+end_")
 	      (forward-line 1))
 	      (forward-line 1))

+ 2 - 2
lisp/org-mouse.el

@@ -1100,10 +1100,10 @@ This means, between the beginning of line and the point."
 	 "--"
 	 "--"
 	 ["Day View" org-agenda-day-view
 	 ["Day View" org-agenda-day-view
 	  :active (org-agenda-check-type nil 'agenda)
 	  :active (org-agenda-check-type nil 'agenda)
-	  :style radio :selected (equal org-agenda-ndays 1)]
+	  :style radio :selected (eq org-agenda-current-span 'day)]
 	 ["Week View" org-agenda-week-view
 	 ["Week View" org-agenda-week-view
 	  :active (org-agenda-check-type nil 'agenda)
 	  :active (org-agenda-check-type nil 'agenda)
-	  :style radio :selected (equal org-agenda-ndays 7)]
+	  :style radio :selected (eq org-agenda-current-span 'week)]
 	 "--"
 	 "--"
 	 ["Show Logbook entries" org-agenda-log-mode
 	 ["Show Logbook entries" org-agenda-log-mode
 	  :style toggle :selected org-agenda-show-log
 	  :style toggle :selected org-agenda-show-log

+ 4 - 5
lisp/org.el

@@ -72,11 +72,10 @@
 
 
 (eval-when-compile
 (eval-when-compile
   (require 'cl)
   (require 'cl)
-  (require 'gnus-sum)
-)
+  (require 'gnus-sum))
 
 
 (require 'calendar)
 (require 'calendar)
-(require 'pcomplete)
+
 ;; Emacs 22 calendar compatibility:  Make sure the new variables are available
 ;; Emacs 22 calendar compatibility:  Make sure the new variables are available
 (when (fboundp 'defvaralias)
 (when (fboundp 'defvaralias)
   (unless (boundp 'calendar-view-holidays-initially-flag)
   (unless (boundp 'calendar-view-holidays-initially-flag)
@@ -2732,10 +2731,10 @@ To disable these tags on a per-file basis, insert anywhere in the file:
 (defcustom org-complete-tags-always-offer-all-agenda-tags nil
 (defcustom org-complete-tags-always-offer-all-agenda-tags nil
   "If non-nil, always offer completion for all tags of all agenda files.
   "If non-nil, always offer completion for all tags of all agenda files.
 Instead of customizing this variable directly, you might want to
 Instead of customizing this variable directly, you might want to
-set it locally for remember buffers, because there no list of
+set it locally for capture buffers, because there no list of
 tags in that file can be created dynamically (there are none).
 tags in that file can be created dynamically (there are none).
 
 
-  (add-hook 'org-remember-mode-hook
+  (add-hook 'org-capture-mode-hook
             (lambda ()
             (lambda ()
               (set (make-local-variable
               (set (make-local-variable
                     'org-complete-tags-always-offer-all-agenda-tags)
                     'org-complete-tags-always-offer-all-agenda-tags)

+ 8 - 0
testing/lisp/test-org.el

@@ -84,6 +84,14 @@
     "àâçèéêîôùû"
     "àâçèéêîôùû"
     (org-link-unescape "%E0%E2%E7%E8%E9%EA%EE%F4%F9%FB"))))
     (org-link-unescape "%E0%E2%E7%E8%E9%EA%EE%F4%F9%FB"))))
 
 
+(ert-deftest test-org/org-link-escape-url-with-escaped-char ()
+  "Escape and unscape a URL that includes an escaped char.
+http://article.gmane.org/gmane.emacs.orgmode/21459/"
+  (should
+   (string=
+    "http://some.host.com/form?&id=blah%2Bblah25"
+    (org-link-unescape (org-link-escape "http://some.host.com/form?&id=blah%2Bblah25")))))
+
 (provide 'test-org)
 (provide 'test-org)
 
 
 ;;; test-org.el ends here
 ;;; test-org.el ends here