summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCarsten Dominik <carsten.dominik@gmail.com>2010-12-03 22:03:06 +0100
committerCarsten Dominik <carsten.dominik@gmail.com>2010-12-03 22:03:06 +0100
commit316e7e5fbc70f209826d030bde7238a0662acbb4 (patch)
tree6aa64e870d20798366ed68c2774b084cd58b52a4
parentd9cc075cb966998f5096e42b4b4da57020fcd4cf (diff)
parent4081200ab0a0efc40991dd0bd6f4eed63c8818b4 (diff)
downloadorg-mode-316e7e5fbc70f209826d030bde7238a0662acbb4.tar.gz
Merge branch 'master' of git+ssh://repo.or.cz/srv/git/org-mode
Conflicts: lisp/org-agenda.el
-rw-r--r--doc/org.texi30
-rw-r--r--doc/orgguide.texi6
-rw-r--r--lisp/ob-R.el22
-rw-r--r--lisp/ob-clojure.el5
-rw-r--r--lisp/ob-eval.el1
-rw-r--r--lisp/ob-python.el43
-rw-r--r--lisp/ob-sql.el32
-rw-r--r--lisp/ob-sqlite.el1
-rw-r--r--lisp/ob.el27
-rw-r--r--lisp/org-agenda.el306
-rw-r--r--lisp/org-clock.el242
-rw-r--r--lisp/org-compat.el6
-rw-r--r--lisp/org-complete.el18
-rw-r--r--lisp/org-latex.el2
-rw-r--r--lisp/org-list.el6
-rw-r--r--lisp/org-mouse.el4
-rw-r--r--lisp/org.el9
-rw-r--r--testing/lisp/test-org.el8
18 files changed, 529 insertions, 239 deletions
diff --git a/doc/org.texi b/doc/org.texi
index 17d6e65..159191f 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -5820,6 +5820,7 @@ be selected:
2007-12-31 @r{New year eve 2007}
2007-12 @r{December 2007}
2007-W50 @r{ISO-week 50 in 2007}
+ 2007-Q2 @r{2nd quarter in 2007}
2007 @r{the year 2007}
today, yesterday, today-@var{N} @r{a relative day}
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
@cindex org-agenda, command
@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
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
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
-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
+@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
change the dates of deadlines and appointments from the agenda buffer.
The commands available in the Agenda buffer are listed in @ref{Agenda
@@ -7120,13 +7127,15 @@ it more compact:
@item
@vindex org-agenda-todo-ignore-scheduled
@vindex org-agenda-todo-ignore-deadlines
+@vindex org-agenda-todo-ignore-timestamp
@vindex org-agenda-todo-ignore-with-date
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}.
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
@vindex org-agenda-todo-list-sublevels
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.
@c
@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.
-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
@orgcmd{b,org-agenda-earlier}
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.}
@example
emacs -eval '(org-batch-store-agenda-views \
- org-agenda-ndays 30 \
+ org-agenda-span month \
org-agenda-start-day "2007-11-01" \
org-agenda-include-diary nil \
org-agenda-files (quote ("~/org/project.org")))' \
@@ -14030,7 +14038,7 @@ You may also modify parameters on the fly like this:
@example
emacs -batch -l ~/.emacs \
-eval '(org-batch-agenda "a" \
- org-agenda-ndays 30 \
+ org-agenda-span month \
org-agenda-include-diary nil \
org-agenda-files (quote ("~/org/project.org")))' \
| lpr
diff --git a/doc/orgguide.texi b/doc/orgguide.texi
index b67f7f1..690111b 100644
--- a/doc/orgguide.texi
+++ b/doc/orgguide.texi
@@ -1931,9 +1931,9 @@ Delete other windows.
Switch to day/week view.
@c
@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
@item .
Go to today.
diff --git a/lisp/ob-R.el b/lisp/ob-R.el
index 2be7992..8547234 100644
--- a/lisp/ob-R.el
+++ b/lisp/ob-R.el
@@ -276,16 +276,18 @@ last statement in BODY, as elisp."
(butlast
(delq nil
(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)
"R-specific processing of return value.
diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el
index fad7544..0b55ff1 100644
--- a/lisp/ob-clojure.el
+++ b/lisp/ob-clojure.el
@@ -28,7 +28,7 @@
;;; Requirements:
-;;; A working clojure install. This also implies a working java executable
+;;; - clojure (at least 1.2.0)
;;; - clojure-mode
;;; - slime
;;; - swank-clojure
@@ -49,6 +49,7 @@
(defun org-babel-expand-body:clojure (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (result-params (cdr (assoc :result-params params)))
(print-level nil) (print-length nil)
(body (org-babel-trim
(if (> (length vars) 0)
@@ -62,7 +63,7 @@
(if (or (member "code" result-params)
(member "pp" result-params))
(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)"
"(str org-mode-print-catcher)))")
(if (member "code" result-params) "code" "simple") body)
diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el
index 8832d91..340cb8b 100644
--- a/lisp/ob-eval.el
+++ b/lisp/ob-eval.el
@@ -28,7 +28,6 @@
;; shell commands.
;;; Code:
-(require 'ob)
(eval-when-compile (require 'cl))
(defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
diff --git a/lisp/ob-python.el b/lisp/ob-python.el
index 21b8ff1..fb91b5f 100644
--- a/lisp/ob-python.el
+++ b/lisp/ob-python.el
@@ -56,11 +56,15 @@ This function is called by `org-babel-execute-src-block'."
(cdr (assoc :session params))))
(result-params (cdr (assoc :result-params 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
(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
- session full-body result-type result-params)))
+ session full-body result-type result-params preamble)))
(or (cdr (assoc :file params))
(org-babel-reassemble-table
result
@@ -178,35 +182,38 @@ def main():
open('%s', 'w').write( pprint.pformat(main()) )")
(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."
(if session
(org-babel-python-evaluate-session
session body result-type result-params)
(org-babel-python-evaluate-external-process
- body result-type result-params)))
+ body result-type result-params preamble)))
(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.
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(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-")))
(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)
(if (or (member "code" result-params)
(member "pp" result-params))
@@ -226,7 +233,7 @@ last statement in BODY, as elisp."
(lambda (statement) (insert statement) (comint-send-input))
(if pp
(list
- "import pp"
+ "import pprint"
(format "open('%s', 'w').write(pprint.pformat(_))"
(org-babel-process-file-name tmp-file 'noquote)))
(list (format "open('%s', 'w').write(str(_))"
diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el
index 78e8a3b..6bb9a96 100644
--- a/lisp/ob-sql.el
+++ b/lisp/ob-sql.el
@@ -47,9 +47,15 @@
(eval-when-compile (require 'cl))
(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 '())
+(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)
"Execute a block of Sql code with Babel.
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 "")))
(t (error "no support for the %s sql engine" engine)))))
(with-temp-file in-file
- (insert (org-babel-expand-body:generic body params)))
+ (insert (org-babel-expand-body:sql body params)))
(message command)
(shell-command command)
(with-temp-buffer
- (org-table-import out-file nil)
+ (org-table-import out-file '(16))
(org-babel-reassemble-table
(org-table-to-lisp)
(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))
(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)
"Raise an error because Sql sessions aren't implemented."
diff --git a/lisp/ob-sqlite.el b/lisp/ob-sqlite.el
index dd4ea87..498e11e 100644
--- a/lisp/ob-sqlite.el
+++ b/lisp/ob-sqlite.el
@@ -53,7 +53,6 @@
"Execute a block of Sqlite code with Babel.
This function is called by `org-babel-execute-src-block'."
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (vars (org-babel-get-header params :var))
(db (cdr (assoc :db params)))
(separator (cdr (assoc :separator params)))
(nullvalue (cdr (assoc :nullvalue params)))
diff --git a/lisp/ob.el b/lisp/ob.el
index 2feb1ae..dd285db 100644
--- a/lisp/ob.el
+++ b/lisp/ob.el
@@ -32,6 +32,7 @@
(eval-when-compile
(require 'org-list)
(require 'cl))
+(require 'ob-eval)
(require 'org-macs)
(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-bottom-point "org-list" ())
-(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
(defgroup org-babel nil
"Code block evaluation and management in `org-mode' documents."
:tag "Babel"
@@ -218,8 +218,10 @@ of potentially harmful code."
(if (or (equal eval "never") (equal eval "no")
(and query
(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"
(if (or (equal eval "never") (equal eval "no"))
"Disabled" "Aborted")))
@@ -1440,7 +1442,7 @@ code ---- the results are extracted in the syntax of the source
((member "replace" result-params)
(delete-region (point) (org-babel-result-end)))
((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
(setq 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)
(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
(flet ((wrap (start finish)
(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
((member "html" result-params)
(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))
(wrap "#+BEGIN_RESULT\n" "#+END_RESULT"))
((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
(when (and indent (> indent 0)
;; in this case `table-align' does the work for us
@@ -1549,9 +1552,7 @@ file's directory then expand relative links."
(interactive "*r")
(let ((size (count-lines beg end)))
(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)
(goto-char beg)
(dotimes (n size)
@@ -1561,7 +1562,7 @@ file's directory then expand relative links."
(insert (if results-switches
(format "#+begin_example%s\n" results-switches)
"#+begin_example\n"))
- (forward-char (- end beg))
+ (if (markerp end) (goto-char end) (forward-char (- end beg)))
(insert "#+end_example\n"))))))
(defun org-babel-update-block-body (new-body)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index eef9671..d20bf69 100644
--- a/lisp/org-agenda.el
+++ b/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")
(string))
(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"
(const org-agenda-start-day)
(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
: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
"Non-nil means, ignore some scheduled TODO items when making 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.
The variables
`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'
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
@@ -860,12 +892,25 @@ option will be ignored."
:group 'org-agenda-windows
: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.
+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."
: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
"Non-nil means start the overview always on the specified weekday.
@@ -1797,19 +1842,19 @@ The following commands are available:
("View"
["Day View" org-agenda-day-view
: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)"]
["Week View" org-agenda-week-view
: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)"]
["Month View" org-agenda-month-view
: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"]
["Year View" org-agenda-year-view
: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"]
"--"
["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
"The arguments of the previous call to `org-agenda'.")
(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-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'.")
;;;###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'.
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.
@@ -3343,35 +3389,36 @@ This feature is considered obsolete, please use the TODO list or a block
agenda instead.
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
given in `org-agenda-start-on-weekday'."
(interactive "P")
(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
(setq include-all (car 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)
;; Convert to an absolute day number
(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-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))
(files thefiles)
- (today (org-today))
- (sd (or start-day today))
(start (if (or (null org-agenda-start-on-weekday)
- (< org-agenda-ndays 7))
+ (< ndays 7))
sd
(let* ((nt (calendar-day-of-week
(calendar-gregorian-from-absolute sd)))
@@ -3381,24 +3428,19 @@ given in `org-agenda-start-on-weekday'."
(day-numbers (list start))
(day-cnt 0)
(inhibit-redisplay (not debug-on-error))
- s e rtn rtnall file date d start-pos end-pos todayp nd
+ s e rtn rtnall file date d start-pos end-pos todayp
clocktable-start clocktable-end filter)
(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 clocktable-start (car day-numbers)
clocktable-end (1+ (or (org-last day-numbers) 0)))
(org-prepare-agenda "Day/Week")
(org-set-local 'org-starting-day (car day-numbers))
(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)
(member today day-numbers))
(setq files thefiles
@@ -3426,7 +3468,7 @@ given in `org-agenda-start-on-weekday'."
(if org-agenda-overriding-header
(insert (org-add-props (copy-sequence org-agenda-overriding-header)
nil 'face 'org-agenda-structure) "\n")
- (insert (capitalize (symbol-name (org-agenda-ndays-to-span nd)))
+ (insert (org-agenda-span-name span)
"-agenda"
(if (< (- d2 d1) 350)
(if (= w1 w2)
@@ -3491,7 +3533,7 @@ given in `org-agenda-start-on-weekday'."
(if rtnall (insert
(org-finalize-agenda-entries
(org-agenda-add-time-grid-maybe
- rtnall nd todayp))
+ rtnall ndays todayp))
"\n"))
(put-text-property s (1- (point)) 'day d)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
@@ -3532,7 +3574,31 @@ given in `org-agenda-start-on-weekday'."
(message "")))
(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
@@ -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?"
(when (or org-agenda-todo-ignore-with-date
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))))
(save-excursion
(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))
((eq org-agenda-todo-ignore-deadlines 'past)
(<= (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
"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-hide-tags-regexp))
(let* ((category (or category
- org-category
+ (if (stringp org-category)
+ org-category
+ (and org-category (symbol-name org-category)))
(if buffer-file-name
(file-name-sans-extension
(file-name-nondirectory buffer-file-name))
@@ -5947,11 +6038,9 @@ Negative selection means regexp must not match for selection of an entry."
(cond
(tdpos (goto-char tdpos))
((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))
- (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-find-same-or-today-or-agenda)))
(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."
(interactive "p")
(org-agenda-check-type t 'agenda)
- (let* ((span org-agenda-span)
+ (let* ((span org-agenda-current-span)
(sd org-starting-day)
(greg (calendar-gregorian-from-absolute sd))
(cnt (org-get-at-bol 'org-day-cnt))
- greg2 nd)
+ greg2)
(cond
((eq span 'day)
- (setq sd (+ arg sd) nd 1))
+ (setq sd (+ arg sd)))
((eq span 'week)
- (setq sd (+ (* 7 arg) sd) nd 7))
+ (setq sd (+ (* 7 arg) sd)))
((eq span 'month)
(setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
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)
(setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg)))
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
- (list (car org-agenda-last-arguments) sd nd t)))
+ (list (car org-agenda-last-arguments) sd span t)))
(org-agenda-redo)
(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.
With argument DAY-OF-YEAR, switch to that day of the year."
(interactive "P")
- (setq org-agenda-ndays 1)
(org-agenda-change-time-span 'day day-of-year))
(defun org-agenda-week-view (&optional iso-week)
"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
written as 2-digit years."
(interactive "P")
- (setq org-agenda-ndays 7)
(org-agenda-change-time-span 'week iso-week))
(defun org-agenda-month-view (&optional month)
"Switch to monthly view for agenda.
@@ -6067,70 +6154,61 @@ written as 2-digit years."
"Change the agenda view to SPAN.
SPAN may be `day', `week', `month', `year'."
(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))
(let* ((sd (or (org-get-at-bol '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
- (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-find-same-or-today-or-agenda))
(org-agenda-set-mode-name)
(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
is a cons cell with the starting date and the number of days,
so that the date SD will be in that range."
(let* ((greg (calendar-gregorian-from-absolute sd))
(dg (nth 1 greg))
(mg (car greg))
- (yg (nth 2 greg))
- nd w1 y1 m1 thisweek)
+ (yg (nth 2 greg)))
(cond
((eq span 'day)
(when n
(setq sd (+ (calendar-absolute-from-gregorian
(list mg 1 yg))
- n -1)))
- (setq nd 1))
+ n -1))))
((eq span 'week)
(let* ((nt (calendar-day-of-week
(calendar-gregorian-from-absolute sd)))
(d (if org-agenda-start-on-weekday
(- nt org-agenda-start-on-weekday)
- 0)))
+ 0))
+ y1)
(setq sd (- sd (+ (if (< d 0) 7 0) d)))
(when n
(require 'cal-iso)
- (setq thisweek (car (calendar-iso-from-absolute sd)))
(when (> n 99)
(setq y1 (org-small-year-to-year (/ n 100))
n (mod n 100)))
(setq sd
(calendar-absolute-from-iso
(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)
- (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)
(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)
"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")))
(defun org-agenda-toggle-deadlines ()
- "Toggle diary inclusion in an agenda buffer."
+ "Toggle inclusion of entries with a deadline in an agenda buffer."
(interactive)
(org-agenda-check-type t 'agenda)
(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 ()
"Set the mode name to indicate all the small mode settings."
(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))
(defun org-agenda-post-command-hook ()
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index e798027..ea33821 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -1654,6 +1654,62 @@ buffer and update it."
(>= (match-end 0) pos)
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)
"Return two times bordering a special time range.
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))
(skey (symbol-name key))
(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
((string-match "^[0-9]+$" skey)
(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)
dow 1
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)
(setq y (string-to-number (match-string 1 skey))
month (string-to-number (match-string 2 skey))
@@ -1694,12 +1764,17 @@ the returned times will be formatted strings."
key 'day))
((string-match "\\([-+][0-9]+\\)$" 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)
- (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
((memq key '(day today))
(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)))
((memq key '(month thismonth))
(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))
(setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
(t (error "No such time block %s" key)))
@@ -1723,11 +1820,21 @@ the returned times will be formatted strings."
((memq key '(month thismonth))
(setq txt (format-time-string "%B %Y" ts)))
((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
(list (format-time-string fm ts) (format-time-string fm 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)
"Try to shift the :block date of the clocktable at point.
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 "lastweek") (setq s "thisweek-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)
"Write the standard clocktable."
@@ -1905,7 +2030,7 @@ from the dynamic block defintion."
(indent (plist-get params :indent))
range-text total-time tbl level hlc formula pcol
file-time entries entry headline
- recalc content narrow-cut-p)
+ recalc content narrow-cut-p tcol)
;; Implement abbreviations
(when (plist-get params :compact)
@@ -2038,18 +2163,25 @@ from the dynamic block defintion."
(if (setq formula (plist-get params :formula))
(cond
((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)
- (min maxlevel (or ntcol 100))
+ (if level-p 1 0)
(if timestamp 1 0)))
(insert
(format
"\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))
((stringp formula)
(insert "\n#+TBLFM: " formula)
@@ -2071,7 +2203,7 @@ from the dynamic block defintion."
(when recalc
(if (eq formula '%)
(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)
(insert "%")))
(org-table-recalculate 'all))
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index 8062fcc..e5f2589 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -418,6 +418,12 @@ LIMIT."
(looking-at (concat "\\(?:" regexp "\\)\\'")))))
(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)
;; arch-tag: a0a0579f-e68c-4bdf-9e55-93768b846bbe
diff --git a/lisp/org-complete.el b/lisp/org-complete.el
index a9fed99..a0c331c 100644
--- a/lisp/org-complete.el
+++ b/lisp/org-complete.el
@@ -35,6 +35,16 @@
(require 'org-macs)
(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
(defgroup org-complete nil
@@ -119,6 +129,7 @@ When completing for #+STARTUP, for example, this function returns
(car (org-thing-at-point)))
pcomplete-default-completion-function))))
+(defvar org-additional-option-like-keywords)
(defun pcomplete/org-mode/file-option ()
"Complete against all valid file options."
(require 'org-exp)
@@ -138,6 +149,7 @@ When completing for #+STARTUP, for example, this function returns
org-additional-option-like-keywords)))))
(substring pcomplete-stub 2)))
+(defvar org-startup-options)
(defun pcomplete/org-mode/file-option/startup ()
"Complete arguments for the #+STARTUP file option."
(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)))))
(pcomplete-here vars)))
+(defvar org-link-abbrev-alist-local)
+(defvar org-link-abbrev-alist)
(defun pcomplete/org-mode/link ()
"Complete against defined #+LINK patterns."
(pcomplete-here
(pcomplete-uniqify-list (append (mapcar 'car org-link-abbrev-alist-local)
(mapcar 'car org-link-abbrev-alist)))))
+(defvar org-entities)
(defun pcomplete/org-mode/tex ()
"Complete against TeX-style HTML entity names."
(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)))
(substring pcomplete-stub 1))))
+(defvar org-todo-keywords-1)
(defun pcomplete/org-mode/todo ()
"Complete against known TODO keywords."
(pcomplete-here (pcomplete-uniqify-list org-todo-keywords-1)))
+(defvar org-todo-line-regexp)
(defun pcomplete/org-mode/searchhead ()
"Complete against all headings.
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)))
(substring pcomplete-stub 1))))
+(defvar org-tag-alist)
(defun pcomplete/org-mode/tag ()
"Complete a tag name. Omit tags already set."
(while (pcomplete-here
diff --git a/lisp/org-latex.el b/lisp/org-latex.el
index e58c11d..9c75012 100644
--- a/lisp/org-latex.el
+++ b/lisp/org-latex.el
@@ -2383,7 +2383,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
"\n"
(match-string 1 res))
t t res)))
- (insert res "\n"))))
+ (insert res))))
(defconst org-latex-entities
'("\\!"
diff --git a/lisp/org-list.el b/lisp/org-list.el
index 2290b4a..abbaa5f 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -518,7 +518,11 @@ List ending is determined by the indentation of text. See
(setq ind-ref ind)
(forward-line 1))
((<= 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_")
(re-search-forward "[ \t]*#\\+end_")
(forward-line 1))
diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el
index e16c977..d18a12d 100644
--- a/lisp/org-mouse.el
+++ b/lisp/org-mouse.el
@@ -1100,10 +1100,10 @@ This means, between the beginning of line and the point."
"--"
["Day View" org-agenda-day-view
: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
: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
:style toggle :selected org-agenda-show-log
diff --git a/lisp/org.el b/lisp/org.el
index 9c9c2d1..3edd8b1 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -72,11 +72,10 @@
(eval-when-compile
(require 'cl)
- (require 'gnus-sum)
-)
+ (require 'gnus-sum))
(require 'calendar)
-(require 'pcomplete)
+
;; Emacs 22 calendar compatibility: Make sure the new variables are available
(when (fboundp 'defvaralias)
(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
"If non-nil, always offer completion for all tags of all agenda files.
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).
- (add-hook 'org-remember-mode-hook
+ (add-hook 'org-capture-mode-hook
(lambda ()
(set (make-local-variable
'org-complete-tags-always-offer-all-agenda-tags)
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index f85a8ea..85a3e4a 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -84,6 +84,14 @@
"àâçèéêîôùû"
(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)
;;; test-org.el ends here