From 9c2b17bac3d3dccfa37c4ae83097faebbdd0f285 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 28 Aug 2012 12:35:05 +0200 Subject: [PATCH 01/10] org-agenda.el: Use `S' as a key for searching words in TODO-only entries * org-agenda.el (org-agenda) (org-agenda-get-restriction-and-command): Use `S' as a key for searching words in TODO-only entries. --- lisp/org-agenda.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index dc619e46e..ff4aa842b 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2396,6 +2396,7 @@ M Like `m', but select only TODO entries, no ordinary headlines. L Create a timeline for the current buffer. e Export views to associated files. s Search entries for keywords. +S Search entries for keywords, only with TODO keywords. / Multi occur across all agenda files and also files listed in `org-agenda-text-search-extra-files'. < Restrict agenda commands to buffer, subtree, or region. @@ -2526,6 +2527,7 @@ Pressing `<' twice means to restrict to the current subtree or region (customize-variable 'org-agenda-custom-commands)) ((equal keys "a") (call-interactively 'org-agenda-list)) ((equal keys "s") (call-interactively 'org-search-view)) + ((equal keys "S") (org-call-with-arg 'org-search-view (or arg '(4)))) ((equal keys "t") (call-interactively 'org-todo-list)) ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) ((equal keys "m") (call-interactively 'org-tags-view)) @@ -2601,10 +2603,10 @@ Agenda views are separated by `org-agenda-block-separator'." a Agenda for current week or day e Export agenda views t List of all TODO entries T Entries with special TODO kwd m Match a TAGS/PROP/TODO query M Like m, but only TODO entries +s Search for keywords S Like s, but only TODO entries L Timeline for current buffer # List stuck projects (!=configure) -s Search for keywords * Toggle sticky agenda views -/ Multi-occur ? Find :FLAGGED: entries - C Configure custom agenda commands +/ Multi-occur C Configure custom agenda commands +? Find :FLAGGED: entries * Toggle sticky agenda views ") (start 0)) (while (string-match @@ -2761,7 +2763,7 @@ s Search for keywords * Toggle sticky agenda views ((eq c ?>) (org-agenda-remove-restriction-lock 'noupdate) (setq restriction nil)) - ((and (equal selstring "") (memq c '(?s ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??))) + ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??))) (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) ((and (> (length selstring) 0) (eq c ?\d)) (delete-window) From 89cdbda63e292806d681f87fdba90399a0c09df2 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 28 Aug 2012 13:02:01 +0200 Subject: [PATCH 02/10] org-agenda.el: Use the current command's match to set the buffer name * org-agenda.el (org-agenda): In sticky agendas, use the current command's match to set the buffer name. This gives more information to the user and allows to distinguish various agendas triggered by the same key. (org-batch-store-agenda-views): Handle the new sticky agenda buffer name. --- lisp/org-agenda.el | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index ff4aa842b..2025fe939 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2460,11 +2460,6 @@ Pressing `<' twice means to restrict to the current subtree or region (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) keys (car ans) restriction (cdr ans))) - ;; If we have sticky agenda buffers, set a name for the buffer, - ;; depending on the invoking keys. The user may still set this - ;; as a command option, which will overwrite what we do here. - (if org-agenda-sticky - (setq org-agenda-buffer-name (format "*Org Agenda(%s)*" keys))) ;; Establish the restriction, if any (when (and (not org-agenda-overriding-restriction) restriction) (put 'org-agenda-files 'org-restrict (list bfn)) @@ -2488,6 +2483,13 @@ Pressing `<' twice means to restrict to the current subtree or region (progn (setq type (nth 2 entry) match (eval (nth 3 entry)) lprops (nth 4 entry)) + ;; If we have sticky agenda buffers, set a name for the buffer, + ;; depending on the invoking keys. The user may still set this + ;; as a command option, which will overwrite what we do here. + (if org-agenda-sticky + (setq org-agenda-buffer-name + (or (and (stringp match) (format "*Org Agenda(%s:%s)*" keys match)) + (format "*Org Agenda(%s)*" keys)))) (put 'org-agenda-redo-command 'org-lprops lprops) (cond ((eq type 'agenda) @@ -2962,12 +2964,17 @@ This ensures the export commands can easily use it." (pop-up-frames nil) (dir default-directory) (pars (org-make-parameter-alist parameters)) - cmd thiscmdkey files opts cmd-or-set bufname) + cmd thiscmdkey thiscmdcmd files opts cmd-or-set bufname) (save-window-excursion (while cmds (setq cmd (pop cmds) thiscmdkey (car cmd) - bufname (if org-agenda-sticky (format "*Org Agenda(%s)*" thiscmdkey) + thiscmdcmd (cdr cmd) + match (nth 2 thiscmdcmd) + bufname (if org-agenda-sticky + (or (and (stringp match) + (format "*Org Agenda(%s:%s)*" thiscmdkey match)) + (format "*Org Agenda(%s)*" thiscmdkey)) org-agenda-buffer-name) cmd-or-set (nth 2 cmd) opts (nth (if (listp cmd-or-set) 3 4) cmd) From a9b8778b0c654bb6f73c1b86d6604b880a0e9b2d Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 28 Aug 2012 13:11:12 +0200 Subject: [PATCH 03/10] Code clean-up: rename some agenda internals. * org.el (org-agenda-prepare-buffers): Rename from `org-prepare-agenda-buffers'. (org-match-sparse-tree, org-map-entries): Use the new names. * org-agenda.el (org-agenda-prepare-window): Rename from `org-prepare-agenda-window'. (org-agenda-prepare): Rename from `org-prepare-agenda'. (org-agenda-run-series, org-agenda-prepare, org-timeline) (org-agenda-list, org-search-view, org-todo-list) (org-tags-view, org-agenda-list-stuck-projects, org-diary) (org-agenda-to-appt): Use the new names. * org-mobile.el (org-mobile-create-index-file): Ditto. * org-icalendar.el (org-export-icalendar): Ditto. * org-clock.el (org-dblock-write:clocktable) (org-dblock-write:clocktable): Ditto. * org2rem.el (org2rem): Ditto. --- contrib/lisp/org2rem.el | 2 +- lisp/org-agenda.el | 28 ++++++++++++++-------------- lisp/org-clock.el | 4 ++-- lisp/org-icalendar.el | 2 +- lisp/org-mobile.el | 2 +- lisp/org.el | 8 ++++---- 6 files changed, 23 insertions(+), 23 deletions(-) diff --git a/contrib/lisp/org2rem.el b/contrib/lisp/org2rem.el index d54eff377..30524629b 100644 --- a/contrib/lisp/org2rem.el +++ b/contrib/lisp/org2rem.el @@ -211,7 +211,7 @@ The file is stored under the name `org-combined-agenda-remind-file'." If COMBINE is non-nil, combine all calendar entries into a single large file and store it under the name `org-combined-agenda-remind-file'." (save-excursion - (org-prepare-agenda-buffers files) + (org-agenda-prepare-buffers files) (let* ((dir (org-export-directory :ical (list :publishing-directory org-export-publishing-directory))) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 2025fe939..e1315ae46 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2782,7 +2782,7 @@ L Timeline for current buffer # List stuck projects (!=configure) (defvar org-agenda-multi-current-cmd nil) (defvar org-agenda-multi-overriding-arguments nil) (defun org-agenda-run-series (name series) - (org-let (nth 1 series) '(org-prepare-agenda name)) + (org-let (nth 1 series) '(org-agenda-prepare name)) ;; We need to reset agenda markers here, because when constructing a ;; block agenda, the individual blocks do not do that. (org-agenda-reset-markers) @@ -3345,7 +3345,7 @@ generating a new one." ;; does not have org variables local org-agenda-this-buffer-is-sticky)))) -(defun org-prepare-agenda-window (abuf) +(defun org-agenda-prepare-window (abuf) "Setup agenda buffer in the window." (let* ((awin (get-buffer-window abuf)) wconf) @@ -3369,11 +3369,11 @@ generating a new one." (setq org-pre-agenda-window-conf (or org-pre-agenda-window-conf wconf)))) -(defun org-prepare-agenda (&optional name) +(defun org-agenda-prepare (&optional name) (if (org-agenda-use-sticky-p) (progn ;; Popup existing buffer - (org-prepare-agenda-window (get-buffer org-agenda-buffer-name)) + (org-agenda-prepare-window (get-buffer org-agenda-buffer-name)) (message "Sticky Agenda buffer, use `r' to refresh") (or org-agenda-multi (org-fit-agenda-window)) (throw 'exit nil)) @@ -3402,7 +3402,7 @@ generating a new one." ;; Setting any org variables that are in org-agenda-local-vars ;; list need to be done after the prepare call - (org-prepare-agenda-window (get-buffer-create org-agenda-buffer-name)) + (org-agenda-prepare-window (get-buffer-create org-agenda-buffer-name)) (setq buffer-read-only nil) (org-agenda-reset-markers) (let ((inhibit-read-only t)) (erase-buffer)) @@ -3410,7 +3410,7 @@ generating a new one." (setq org-agenda-buffer (current-buffer)) (setq org-agenda-contributing-files nil) (setq org-agenda-columns-active nil) - (org-prepare-agenda-buffers (org-agenda-files nil 'ifmode)) + (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) (setq org-todo-keywords-for-agenda (org-uniquify org-todo-keywords-for-agenda)) (setq org-done-keywords-for-agenda @@ -3709,7 +3709,7 @@ dates." (setq day-numbers (delq nil (mapcar (lambda(x) (if (>= x today) x nil)) day-numbers)))) - (org-prepare-agenda (concat "Timeline " (file-name-nondirectory entry))) + (org-agenda-prepare (concat "Timeline " (file-name-nondirectory entry))) (org-compile-prefix-format 'timeline) (org-set-sorting-strategy 'timeline) (if org-agenda-show-log-scoped (push :closed args)) @@ -3867,7 +3867,7 @@ given in `org-agenda-start-on-weekday'." (interactive "P") (if (and (integerp arg) (> arg 0)) (setq span arg arg nil)) - (org-prepare-agenda "Day/Week") + (org-agenda-prepare "Day/Week") (setq start-day (or start-day org-agenda-start-day)) (if org-agenda-overriding-arguments (setq arg (car org-agenda-overriding-arguments) @@ -4120,7 +4120,7 @@ as a whole, to include whitespace. This command searches the agenda files, and in addition the files listed in `org-agenda-text-search-extra-files'." (interactive "P") - (org-prepare-agenda "SEARCH") + (org-agenda-prepare "SEARCH") (org-compile-prefix-format 'search) (org-set-sorting-strategy 'search) (let* ((props (list 'face nil @@ -4331,7 +4331,7 @@ the list to these. When using \\[universal-argument], you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in `org-todo-keywords-1'." (interactive "P") - (org-prepare-agenda "TODO") + (org-agenda-prepare "TODO") (org-compile-prefix-format 'todo) (org-set-sorting-strategy 'todo) (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) @@ -4409,7 +4409,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (setq match nil)) (setq matcher (org-make-tags-matcher match) match (car matcher) matcher (cdr matcher)) - (org-prepare-agenda (concat "TAGS " match)) + (org-agenda-prepare (concat "TAGS " match)) (org-compile-prefix-format 'tags) (org-set-sorting-strategy 'tags) (setq org-agenda-query-string match) @@ -4657,7 +4657,7 @@ of what a project is and how to check if it stuck, customize the variable (todo (nth 1 org-stuck-projects)) (todo-wds (if (member "*" todo) (progn - (org-prepare-agenda-buffers (org-agenda-files + (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) (org-delete-all org-done-keywords-for-agenda @@ -4862,7 +4862,7 @@ function from a program - use `org-agenda-get-day-entries' instead." (> (- time org-diary-last-run-time) 3)) - (org-prepare-agenda-buffers files)) + (org-agenda-prepare-buffers files)) (setq org-diary-last-run-time time) ;; If this is called during org-agenda, don't return any entries to ;; the calendar. Org Agenda will list these entries itself. @@ -9164,7 +9164,7 @@ to override `appt-message-warning-time'." (files (org-agenda-files 'unrestricted)) entries file (org-agenda-buffer nil)) ;; Get all entries which may contain an appt - (org-prepare-agenda-buffers files) + (org-agenda-prepare-buffers files) (while (setq file (pop files)) (setq entries (delq nil diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 633fb2b34..263f2cbe3 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -2213,7 +2213,7 @@ the currently selected interval size." ;; we collect from several files (let* ((files scope) file) - (org-prepare-agenda-buffers files) + (org-agenda-prepare-buffers files) (while (setq file (pop files)) (with-current-buffer (find-buffer-visiting file) (save-excursion @@ -2222,7 +2222,7 @@ the currently selected interval size." ;; Just from the current file (save-restriction ;; get the right range into the restriction - (org-prepare-agenda-buffers (list (buffer-file-name))) + (org-agenda-prepare-buffers (list (buffer-file-name))) (cond ((not scope)) ; use the restriction as it is now ((eq scope 'file) (widen)) diff --git a/lisp/org-icalendar.el b/lisp/org-icalendar.el index 568cd20c8..8523b4425 100644 --- a/lisp/org-icalendar.el +++ b/lisp/org-icalendar.el @@ -256,7 +256,7 @@ The file is stored under the name `org-combined-agenda-icalendar-file'." If COMBINE is non-nil, combine all calendar entries into a single large file and store it under the name `org-combined-agenda-icalendar-file'." (save-excursion - (org-prepare-agenda-buffers files) + (org-agenda-prepare-buffers files) (let* ((dir (org-export-directory :ical (list :publishing-directory org-export-publishing-directory))) diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index 93ba7e418..d2c9c1736 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -418,7 +418,7 @@ agenda view showing the flagged items." org-mobile-directory)) file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds) - (org-prepare-agenda-buffers (mapcar 'car files-alist)) + (org-agenda-prepare-buffers (mapcar 'car files-alist)) (setq done-kwds (org-uniquify org-done-keywords-for-agenda)) (setq todo-kwds (org-delete-all done-kwds diff --git a/lisp/org.el b/lisp/org.el index 2eb270e20..1e5492d08 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -13326,7 +13326,7 @@ MATCH can contain positive and negative selection of tags, like If optional argument TODO-ONLY is non-nil, only select lines that are also TODO lines." (interactive "P") - (org-prepare-agenda-buffers (list (current-buffer))) + (org-agenda-prepare-buffers (list (current-buffer))) (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) (defalias 'org-tags-sparse-tree 'org-match-sparse-tree) @@ -14259,7 +14259,7 @@ a *different* entry, you cannot use these techniques." (if (not scope) (progn - (org-prepare-agenda-buffers + (org-agenda-prepare-buffers (list (buffer-file-name (current-buffer)))) (setq res (org-scan-tags func matcher todo-only start-level))) ;; Get the right scope @@ -14275,7 +14275,7 @@ a *different* entry, you cannot use these techniques." (setq scope (list (buffer-file-name)))) ((eq scope 'file-with-archives) (setq scope (org-add-archive-files (list (buffer-file-name)))))) - (org-prepare-agenda-buffers scope) + (org-agenda-prepare-buffers scope) (while (setq file (pop scope)) (with-current-buffer (org-find-base-buffer-visiting file) (save-excursion @@ -17060,7 +17060,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (with-current-buffer buf (save-buffer))) (kill-buffer buf)))) -(defun org-prepare-agenda-buffers (files) +(defun org-agenda-prepare-buffers (files) "Create buffers for all agenda files, protect archived trees and comments." (interactive) (let ((pa '(:org-archived t)) From 11f119776a3514b3cbc95913f016f6338ae334c9 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 28 Aug 2012 13:12:09 +0200 Subject: [PATCH 04/10] Improve filling * lisp/org.el (org-fill-paragraph): Refine filling in comments and in paragraphs. Allow commented blank lines. Take into consideration the indentation of the second line of the paragraph being filled. (org-comment-or-uncomment-region): Rewrite function. Now comment region at a fixed column: the minimal indentation of the region. (org-fill-context-prefix): Rename function into `org-adaptive-fill-function'. Also, In a paragraph, choose the same prefix as the current line. --- lisp/org.el | 190 ++++++++++++++++++++++++++++++---------------------- 1 file changed, 109 insertions(+), 81 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 2eb270e20..8a8347e17 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -20988,12 +20988,11 @@ hierarchy of headlines by UP levels before marking the subtree." ;; We use our own fill-paragraph and auto-fill functions. These ;; functions will shadow `fill-prefix' (computed internally with -;; `org-fill-context-prefix') and pass through to +;; `org-adaptive-fill-function') and pass through to ;; `fill-region-as-paragraph' and `do-auto-fill' as appropriate. (defun org-set-autofill-regexps () (interactive) - (org-set-local 'fill-paragraph-function 'org-fill-paragraph) ;; Prevent auto-fill from inserting unwanted new items. (when (boundp 'fill-nobreak-predicate) (org-set-local @@ -21002,6 +21001,8 @@ hierarchy of headlines by UP levels before marking the subtree." (append fill-nobreak-predicate '(org-fill-paragraph-separate-nobreak-p org-fill-line-break-nobreak-p))))) + (org-set-local 'fill-paragraph-function 'org-fill-paragraph) + (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function) (org-set-local 'normal-auto-fill-function 'org-auto-fill-function) (org-set-local 'comment-line-break-function 'org-comment-line-break-function) (org-set-local 'align-mode-rules-list @@ -21023,19 +21024,19 @@ hierarchy of headlines by UP levels before marking the subtree." (declare-function message-in-body-p "message" ()) (defvar org-element--affiliated-re) ; From org-element.el -(defun org-fill-context-prefix (p) - "Compute a fill prefix for the line at point P. +(defun org-adaptive-fill-function () + "Compute a fill prefix for the current line. Return fill prefix, as a string, or nil if current line isn't meant to be filled." (org-with-wide-buffer (unless (and (derived-mode-p 'message-mode) (not (message-in-body-p))) ;; FIXME: This is really the job of orgstruct++-mode - (goto-char p) - (beginning-of-line) - (let* ((element (org-element-at-point)) + (let* ((p (line-beginning-position)) + (element (save-excursion (beginning-of-line) + (org-element-at-point))) (type (org-element-type element)) (post-affiliated - (progn + (save-excursion (goto-char (org-element-property :begin element)) (while (looking-at org-element--affiliated-re) (forward-line)) (point)))) @@ -21053,7 +21054,7 @@ meant to be filled." (make-string (org-list-item-body-column (org-element-property :begin parent)) ? )) - ((looking-at "\\s-+") (match-string 0)) + ((looking-at "[ \t]*") (match-string 0)) (t "")))) (comment-block ;; Only fill contents if P is within block boundaries. @@ -21065,7 +21066,7 @@ meant to be filled." (skip-chars-backward " \r\t\n") (line-beginning-position)))) (when (and (>= p cbeg) (< p cend)) - (if (looking-at "\\s-+") (match-string 0) "")))))))))) + (if (looking-at "[ \t]*") (match-string 0) "")))))))))) (declare-function message-goto-body "message" ()) (defvar message-cite-prefix-regexp) ; From message.el @@ -21099,12 +21100,12 @@ a footnote definition, try to fill the first paragraph within." (cadadr (assoc 'paragraph-separate org-fb-vars)))) (fill-paragraph)) (save-excursion - ;; Move to end of line in order to get the first paragraph within - ;; a plain list or a footnote definition. + ;; Move to end of line in order to get the first paragraph + ;; within a plain list or a footnote definition. (end-of-line) (let ((element (org-element-at-point))) - ;; First check if point is in a blank line at the beginning of the - ;; buffer. In that case, ignore filling. + ;; First check if point is in a blank line at the beginning of + ;; the buffer. In that case, ignore filling. (if (< (point) (org-element-property :begin element)) t (case (org-element-type element) ;; Align Org tables, leave table.el tables as-is. @@ -21113,8 +21114,8 @@ a footnote definition, try to fill the first paragraph within." (when (eq (org-element-property :type element) 'org) (org-table-align)) t) - ;; Elements that may contain `line-break' type objects. (paragraph + ;; Paragraphs may contain `line-break' type objects. (let ((beg (max (point-min) (org-element-property :contents-begin element))) (end (min (point-max) @@ -21131,20 +21132,20 @@ a footnote definition, try to fill the first paragraph within." (re-search-forward (concat "^" message-cite-prefix-regexp) end t)) (setq end (match-beginning 0)))) - ;; Fill paragraph, taking line breaks into consideration. - ;; For that, slice the paragraph using line breaks as - ;; separators, and fill the parts in reverse order to - ;; avoid messing with markers. + ;; Fill paragraph, taking line breaks into + ;; consideration. For that, slice the paragraph + ;; using line breaks as separators, and fill the + ;; parts in reverse order to avoid messing with + ;; markers. (save-excursion (goto-char end) (mapc (lambda (pos) - (let ((fill-prefix (org-fill-context-prefix pos))) - (fill-region-as-paragraph pos (point) justify)) + (fill-region-as-paragraph pos (point) justify) (goto-char pos)) - ;; Find the list of ending positions for line breaks - ;; in the current paragraph. Add paragraph beginning - ;; to include first slice. + ;; Find the list of ending positions for line + ;; breaks in the current paragraph. Add paragraph + ;; beginning to include first slice. (nreverse (cons beg @@ -21154,54 +21155,60 @@ a footnote definition, try to fill the first paragraph within." 'line-break (lambda (lb) (org-element-property :end lb))))))) t))) - ;; Contents of `comment-block' type elements should be filled as - ;; plain text. + ;; Contents of `comment-block' type elements should be + ;; filled as plain text, but only if point is within block + ;; markers. (comment-block - (let ((fill-prefix (org-fill-context-prefix (point)))) - (save-excursion + (let* ((case-fold-search t) + (beg (save-excursion + (goto-char (org-element-property :begin element)) + (re-search-forward "^[ \t]*#\\+begin_comment" nil t) + (forward-line) + (point))) + (end (save-excursion + (goto-char (org-element-property :end element)) + (re-search-backward "^[ \t]*#\\+end_comment" nil t) + (line-beginning-position)))) + (when (and (>= (point) beg) (< (point) end)) (fill-region-as-paragraph - (progn - (goto-char (org-element-property :begin element)) - (while (looking-at org-element--affiliated-re) - (forward-line)) - (forward-line) - (point)) - (progn - (goto-char (org-element-property :end element)) - (skip-chars-backward " \r\t\n") + (save-excursion + (end-of-line) + (re-search-backward "^[ \t]*$" beg 'move) (line-beginning-position)) - justify))) t) - ;; Fill comments, indented or not. - (comment - (let ((fill-prefix (org-fill-context-prefix (point)))) - (save-excursion - (fill-region-as-paragraph - (progn - (goto-char (org-element-property :begin element)) - (while (looking-at org-element--affiliated-re) - (forward-line)) - (point)) - (progn - (goto-char (org-element-property :end element)) - (skip-chars-backward " \r\t\n") - (line-end-position)))))) + (save-excursion + (beginning-of-line) + (re-search-forward "^[ \t]*$" end 'move) + (line-beginning-position)) + justify))) + t) + ;; Fill comments. + (comment (fill-comment-paragraph justify)) ;; Ignore every other element. (otherwise t))))))) (defun org-auto-fill-function () "Auto-fill function." - ;; Check if auto-filling is meaningful before computing fill prefix. + ;; Check if auto-filling is meaningful. (let ((fc (current-fill-column))) (when (and fc (> (current-column) fc)) - (let ((fill-prefix (org-fill-context-prefix (point)))) + (let ((fill-prefix (org-adaptive-fill-function))) (when fill-prefix (do-auto-fill)))))) ;;; Comments -;; We control comments everywhere. `org-comment-or-uncomment-region' -;; and `org-insert-comment' takes care of `comment-dwim' behaviour -;; while `org-comment-line-break-function' handles auto-filling in +;; Org comments syntax is quite complex. It requires the entire line +;; to be just a comment. Also, even with the right syntax at the +;; beginning of line, some some elements (i.e. verse-block or +;; example-block) don't accept comments. Usual Emacs comment commands +;; cannot cope with those requirements. Therefore, Org replaces them. + +;; Org still relies on `comment-dwim', but cannot trust +;; `comment-only-p'. So, `comment-region-function' and +;; `uncomment-region-function' both point +;; to`org-comment-or-uncomment-region'. Also, `org-insert-comment' +;; takes care of insertion of comments at the beginning of line while +;; `org-comment-line-break-function' handles auto-filling in ;; a comment. (defun org-insert-comment () @@ -21212,35 +21219,56 @@ If the line is empty, insert comment at its beginning." (org-indent-line) (insert "# ")) +(defvar comment-empty-lines) ; From newcomment.el. (defun org-comment-or-uncomment-region (beg end &rest ignore) "Comment or uncomment each non-blank line in the region. Uncomment each non-blank line between BEG and END if it only contains commented lines. Otherwise, comment them." - (save-excursion - (goto-char beg) - (skip-chars-forward " \r\t\n" end) - (beginning-of-line) + (save-restriction + ;; Restrict region + (narrow-to-region (save-excursion (goto-char beg) + (skip-chars-forward " \r\t\n" end) + (line-beginning-position)) + (save-excursion (goto-char end) + (skip-chars-backward " \r\t\n" beg) + (line-end-position))) (let ((uncommentp - ;; UNCOMMENTP is non-nil when every non blank line between - ;; BEG and END is a comment. - (save-excursion - (while (progn (and (not (eobp)) - (let ((element (org-element-at-point))) - (and (eq (org-element-type element) 'comment) - (goto-char (org-element-property - :end element))))))) - (>= (point) end))) - ;; Remove or adding comment markers is going to change end - ;; position so make it a marker. - (end (copy-marker end))) - (while (< (point) end) - (unless (looking-at "\\s-*$") - (if (not uncommentp) (progn (back-to-indentation) (insert "# ")) - ;; Only comments and blank lines in region: uncomment it. - (looking-at "[ \t]*\\(# ?\\)") - (replace-match "" nil nil nil 1))) - (forward-line)) - (set-marker end nil)))) + ;; UNCOMMENTP is non-nil when every non blank line between + ;; BEG and END is a comment. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) + (let ((element (org-element-at-point))) + (and (eq (org-element-type element) 'comment) + (goto-char (min (point-max) + (org-element-property + :end element))))))) + (eobp)))) + (if uncommentp + ;; Only blank lines and comments in region: uncomment it. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)") + (replace-match "" nil nil nil 1)) + (forward-line))) + ;; Comment each line in region. + (let ((min-indent (point-max))) + ;; First find the minimum indentation across all lines. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) (not (zerop min-indent))) + (unless (looking-at "[ \t]*$") + (setq min-indent (min min-indent (current-indentation)))) + (forward-line))) + ;; Then loop over all lines. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) + (org-move-to-column min-indent t) + (insert comment-start)) + (forward-line)))))))) (defun org-comment-line-break-function (&optional soft) "Break line at point and indent, continuing comment if within one. From f6af8270130614a93df7526deb6bb50abc865e87 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 28 Aug 2012 13:14:46 +0200 Subject: [PATCH 05/10] doc/org.texi: Fix typos in the manual * org.texi (Agenda dispatcher): Mention `org-toggle-agenda-sticky'. (Agenda commands, Exporting Agenda Views): Fix typo. --- doc/org.texi | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index e1f3812e6..253331a5a 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -7422,7 +7422,8 @@ is always up to date. If you switch between views often and the build time bothers you, you can turn on sticky agenda buffers (make this the default by customizing the variable @code{org-agenda-sticky}). With sticky agendas, the dispatcher only switches to the selected view, you need to update it by hand -with @kbd{r} or @kbd{g}. +with @kbd{r} or @kbd{g}. You can toggle sticky agenda view any time with +@code{org-toggle-sticky-agenda}. @end table You can also define custom commands that will be accessible through the @@ -8584,7 +8585,7 @@ Export a single iCalendar file containing entries from all agenda files. This is a globally available command, and also available in the agenda menu. @tsubheading{Exporting to a file} -@orgcmd{C-x C-w,org-write-agenda} +@orgcmd{C-x C-w,org-agenda-write} @cindex exporting agenda views @cindex agenda views, exporting @vindex org-agenda-exporter-settings @@ -8833,7 +8834,7 @@ a PDF file will also create the postscript file.}, and iCalendar files. If you want to do this only occasionally, use the command @table @kbd -@orgcmd{C-x C-w,org-write-agenda} +@orgcmd{C-x C-w,org-agenda-write} @cindex exporting agenda views @cindex agenda views, exporting @vindex org-agenda-exporter-settings From 72f25ccfd9d8a3a4a66c5db332afb071c771689f Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 28 Aug 2012 13:17:29 +0200 Subject: [PATCH 06/10] org-agenda.el (org-todo-list): Make arg optional * org-agenda.el (org-todo-list): Make arg optional. --- lisp/org-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index e1315ae46..278417019 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -4324,7 +4324,7 @@ in `org-agenda-text-search-extra-files'." (defvar org-last-arg nil) ;;;###autoload -(defun org-todo-list (arg) +(defun org-todo-list (&optional arg) "Show all (not done) TODO entries from all agenda file in a single list. The prefix arg can be used to select a specific TODO keyword and limit the list to these. When using \\[universal-argument], you will be prompted From d58d40f0c864ae3a6d7c66df34769619ad2486c1 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 28 Aug 2012 13:27:58 +0200 Subject: [PATCH 07/10] Externalize filling and comments initializers * lisp/org.el (org-mode): Call external initalizers. Now both filling code and comments code have their own independant part in org.el. (org-setup-filling): Renamed from `org-set-autofill-regexps'. (org-setup-comments-handling): New function. --- lisp/org.el | 77 ++++++++++++++++++++++++++++++++--------------------- 1 file changed, 47 insertions(+), 30 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 8a8347e17..4c0c3f6ff 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5064,7 +5064,7 @@ The following commands are available: org-display-table 4 (vconcat (mapcar (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) - org-ellipsis))) + org-ellipsis))) (if (stringp org-ellipsis) org-ellipsis "...")))) (setq buffer-display-table org-display-table)) (org-set-regexps-and-options) @@ -5083,18 +5083,15 @@ The following commands are available: 'local) ;; Check for running clock before killing a buffer (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) - ;; Paragraphs and auto-filling - (org-set-autofill-regexps) + ;; Indentation. (org-set-local 'indent-line-function 'org-indent-line) (org-set-local 'indent-region-function 'org-indent-region) + ;; Initialize radio targets. (org-update-radio-target-regexp) - ;; Comments - (org-set-local 'comment-use-syntax nil) - (org-set-local 'comment-start "# ") - (org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)") - (org-set-local 'comment-insert-comment-function 'org-insert-comment) - (org-set-local 'comment-region-function 'org-comment-or-uncomment-region) - (org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region) + ;; Filling and auto-filling. + (org-setup-filling) + ;; Comments. + (org-setup-comments-handling) ;; Beginning/end of defun (org-set-local 'beginning-of-defun-function 'org-back-to-heading) (org-set-local 'end-of-defun-function (lambda () (interactive) (org-end-of-subtree nil t))) @@ -20986,12 +20983,21 @@ hierarchy of headlines by UP levels before marking the subtree." ;;; Filling -;; We use our own fill-paragraph and auto-fill functions. These -;; functions will shadow `fill-prefix' (computed internally with -;; `org-adaptive-fill-function') and pass through to -;; `fill-region-as-paragraph' and `do-auto-fill' as appropriate. +;; We use our own fill-paragraph and auto-fill functions. -(defun org-set-autofill-regexps () +;; `org-fill-paragraph' relies on adaptive filling and context +;; checking. Appropriate `fill-prefix' is computed with +;; `org-adaptive-fill-function'. + +;; `org-auto-fill-function' takes care of auto-filling. It calls +;; `do-auto-fill' only on valid areas with `fill-prefix' shadowed with +;; `org-adaptive-fill-function' value. Internally, +;; `org-comment-line-break-function' breaks the line. + +;; `org-setup-filling' installs filling and auto-filling related +;; variables during `org-mode' initialization. + +(defun org-setup-filling () (interactive) ;; Prevent auto-fill from inserting unwanted new items. (when (boundp 'fill-nobreak-predicate) @@ -21194,6 +21200,17 @@ a footnote definition, try to fill the first paragraph within." (let ((fill-prefix (org-adaptive-fill-function))) (when fill-prefix (do-auto-fill)))))) +(defun org-comment-line-break-function (&optional soft) + "Break line at point and indent, continuing comment if within one. +The inserted newline is marked hard if variable +`use-hard-newlines' is true, unless optional argument SOFT is +non-nil." + (if soft (insert-and-inherit ?\n) (newline 1)) + (save-excursion (forward-char -1) (delete-horizontal-space)) + (delete-horizontal-space) + (indent-to-left-margin) + (insert-before-markers-and-inherit fill-prefix)) + ;;; Comments @@ -21206,10 +21223,21 @@ a footnote definition, try to fill the first paragraph within." ;; Org still relies on `comment-dwim', but cannot trust ;; `comment-only-p'. So, `comment-region-function' and ;; `uncomment-region-function' both point -;; to`org-comment-or-uncomment-region'. Also, `org-insert-comment' -;; takes care of insertion of comments at the beginning of line while -;; `org-comment-line-break-function' handles auto-filling in -;; a comment. +;; to`org-comment-or-uncomment-region'. Eventually, +;; `org-insert-comment' takes care of insertion of comments at the +;; beginning of line. + +;; `org-setup-comments-handling' install comments related variables +;; during `org-mode' initialization. + +(defun org-setup-comments-handling () + (interactive) + (org-set-local 'comment-use-syntax nil) + (org-set-local 'comment-start "# ") + (org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)") + (org-set-local 'comment-insert-comment-function 'org-insert-comment) + (org-set-local 'comment-region-function 'org-comment-or-uncomment-region) + (org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region)) (defun org-insert-comment () "Insert an empty comment above current line. @@ -21270,17 +21298,6 @@ contains commented lines. Otherwise, comment them." (insert comment-start)) (forward-line)))))))) -(defun org-comment-line-break-function (&optional soft) - "Break line at point and indent, continuing comment if within one. -The inserted newline is marked hard if variable -`use-hard-newlines' is true, unless optional argument SOFT is -non-nil." - (if soft (insert-and-inherit ?\n) (newline 1)) - (save-excursion (forward-char -1) (delete-horizontal-space)) - (delete-horizontal-space) - (indent-to-left-margin) - (insert-before-markers-and-inherit fill-prefix)) - ;;; Other stuff. From 23204aaab7ad5ee2d10a5b7d2367419b3dcfb5e9 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 28 Aug 2012 13:29:37 +0200 Subject: [PATCH 08/10] org-agenda.el: Fix bug in `org-agenda-list' * org-agenda.el (org-agenda-list): Fix bug: don't throw an error when called from programs as (org-agenda-list). Thanks to Rainer Thiel for reporting this bug. --- lisp/org-agenda.el | 328 +++++++++++++++++++++++---------------------- 1 file changed, 168 insertions(+), 160 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 278417019..4479e827b 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -3867,166 +3867,174 @@ given in `org-agenda-start-on-weekday'." (interactive "P") (if (and (integerp arg) (> arg 0)) (setq span arg arg nil)) - (org-agenda-prepare "Day/Week") - (setq start-day (or start-day org-agenda-start-day)) - (if org-agenda-overriding-arguments - (setq arg (car org-agenda-overriding-arguments) - start-day (nth 1 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 arg start-day span)) - (org-compile-prefix-format 'agenda) - (org-set-sorting-strategy 'agenda) - (let* ((span (org-agenda-ndays-to-span - (or span org-agenda-ndays org-agenda-span))) - (today (org-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) - (start (if (or (null org-agenda-start-on-weekday) - (< ndays 7)) - sd - (let* ((nt (calendar-day-of-week - (calendar-gregorian-from-absolute sd))) - (n1 org-agenda-start-on-weekday) - (d (- nt n1))) - (- sd (+ (if (< d 0) 7 0) d))))) - (day-numbers (list start)) - (day-cnt 0) - (inhibit-redisplay (not debug-on-error)) - (org-agenda-show-log-scoped org-agenda-show-log) - 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 arg) 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-set-local 'org-starting-day (car day-numbers)) - (org-set-local 'org-arg-loc arg) - (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span)) - (unless org-agenda-compact-blocks - (let* ((d1 (car day-numbers)) - (d2 (org-last day-numbers)) - (w1 (org-days-to-iso-week d1)) - (w2 (org-days-to-iso-week d2))) - (setq s (point)) - (if org-agenda-overriding-header - (insert (org-add-props (copy-sequence org-agenda-overriding-header) - nil 'face 'org-agenda-structure) "\n") - (insert (org-agenda-span-name span) - "-agenda" - (if (< (- d2 d1) 350) - (if (= w1 w2) - (format " (W%02d)" w1) - (format " (W%02d-W%02d)" w1 w2)) - "") - ":\n"))) - (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure - 'org-date-line t)) - (org-agenda-mark-header-line s)) - (while (setq d (pop day-numbers)) - (setq date (calendar-gregorian-from-absolute d) - s (point)) - (if (or (setq todayp (= d today)) - (and (not start-pos) (= d sd))) - (setq start-pos (point)) - (if (and start-pos (not end-pos)) - (setq end-pos (point)))) - (setq files thefiles - rtnall nil) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (let ((org-agenda-entry-types org-agenda-entry-types)) - (unless org-agenda-include-deadlines - (setq org-agenda-entry-types - (delq :deadline org-agenda-entry-types))) - (cond - ((memq org-agenda-show-log-scoped '(only clockcheck)) - (setq rtn (org-agenda-get-day-entries - file date :closed))) - (org-agenda-show-log-scoped - (setq rtn (apply 'org-agenda-get-day-entries - file date - (append '(:closed) org-agenda-entry-types)))) - (t - (setq rtn (apply 'org-agenda-get-day-entries - file date - org-agenda-entry-types))))) - (setq rtnall (append rtnall rtn)))) ;; all entries - (if org-agenda-include-diary - (let ((org-agenda-search-headline-for-time t)) - (require 'diary-lib) - (setq rtn (org-get-entries-from-diary date)) - (setq rtnall (append rtnall rtn)))) - (if (or rtnall org-agenda-show-all-dates) - (progn - (setq day-cnt (1+ day-cnt)) - (insert - (if (stringp org-agenda-format-date) - (format-time-string org-agenda-format-date - (org-time-from-absolute date)) - (funcall org-agenda-format-date date)) - "\n") - (put-text-property s (1- (point)) 'face - (org-agenda-get-day-face date)) - (put-text-property s (1- (point)) 'org-date-line t) - (put-text-property s (1- (point)) 'org-agenda-date-header t) - (put-text-property s (1- (point)) 'org-day-cnt day-cnt) - (when todayp - (put-text-property s (1- (point)) 'org-today t)) - (setq rtnall - (org-agenda-add-time-grid-maybe rtnall ndays todayp)) - (if rtnall (insert ;; all entries - (org-finalize-agenda-entries rtnall) - "\n")) - (put-text-property s (1- (point)) 'day d) - (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))) - (when (and org-agenda-clockreport-mode clocktable-start) - (let ((org-agenda-files (org-agenda-files nil 'ifmode)) - ;; the above line is to ensure the restricted range! - (p (copy-sequence org-agenda-clockreport-parameter-plist)) - tbl) - (setq p (org-plist-delete p :block)) - (setq p (plist-put p :tstart clocktable-start)) - (setq p (plist-put p :tend clocktable-end)) - (setq p (plist-put p :scope 'agenda)) - (when (and (eq org-agenda-clockreport-mode 'with-filter) - (setq filter (or org-agenda-tag-filter-while-redo - (get 'org-agenda-tag-filter :preset-filter)))) - (setq p (plist-put p :tags (mapconcat (lambda (x) - (if (string-match "[<>=]" x) - "" - x)) - filter "")))) - (setq tbl (apply 'org-get-clocktable p)) - (insert tbl))) - (goto-char (point-min)) - (or org-agenda-multi (org-fit-agenda-window)) - (unless (and (pos-visible-in-window-p (point-min)) - (pos-visible-in-window-p (point-max))) - (goto-char (1- (point-max))) - (recenter -1) - (if (not (pos-visible-in-window-p (or start-pos 1))) - (progn - (goto-char (or start-pos 1)) - (recenter 1)))) - (goto-char (or start-pos 1)) - (add-text-properties (point-min) (point-max) '(org-agenda-type agenda)) - (if (eq org-agenda-show-log-scoped 'clockcheck) - (org-agenda-show-clocking-issues)) - (org-finalize-agenda) - (setq buffer-read-only t) - (message ""))) + (catch 'exit + (if org-agenda-sticky + (setq org-agenda-buffer-name + (cond ((and keys (stringp match)) + (format "*Org Agenda(%s:%s)*" keys match)) + (keys + (format "*Org Agenda(%s)*" keys)) + (t (format "*Org Agenda(a)*"))))) + (org-agenda-prepare "Day/Week") + (setq start-day (or start-day org-agenda-start-day)) + (if org-agenda-overriding-arguments + (setq arg (car org-agenda-overriding-arguments) + start-day (nth 1 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 arg start-day span)) + (org-compile-prefix-format 'agenda) + (org-set-sorting-strategy 'agenda) + (let* ((span (org-agenda-ndays-to-span + (or span org-agenda-ndays org-agenda-span))) + (today (org-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) + (start (if (or (null org-agenda-start-on-weekday) + (< ndays 7)) + sd + (let* ((nt (calendar-day-of-week + (calendar-gregorian-from-absolute sd))) + (n1 org-agenda-start-on-weekday) + (d (- nt n1))) + (- sd (+ (if (< d 0) 7 0) d))))) + (day-numbers (list start)) + (day-cnt 0) + (inhibit-redisplay (not debug-on-error)) + (org-agenda-show-log-scoped org-agenda-show-log) + 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 arg) 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-set-local 'org-starting-day (car day-numbers)) + (org-set-local 'org-arg-loc arg) + (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span)) + (unless org-agenda-compact-blocks + (let* ((d1 (car day-numbers)) + (d2 (org-last day-numbers)) + (w1 (org-days-to-iso-week d1)) + (w2 (org-days-to-iso-week d2))) + (setq s (point)) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert (org-agenda-span-name span) + "-agenda" + (if (< (- d2 d1) 350) + (if (= w1 w2) + (format " (W%02d)" w1) + (format " (W%02d-W%02d)" w1 w2)) + "") + ":\n"))) + (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure + 'org-date-line t)) + (org-agenda-mark-header-line s)) + (while (setq d (pop day-numbers)) + (setq date (calendar-gregorian-from-absolute d) + s (point)) + (if (or (setq todayp (= d today)) + (and (not start-pos) (= d sd))) + (setq start-pos (point)) + (if (and start-pos (not end-pos)) + (setq end-pos (point)))) + (setq files thefiles + rtnall nil) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (let ((org-agenda-entry-types org-agenda-entry-types)) + (unless org-agenda-include-deadlines + (setq org-agenda-entry-types + (delq :deadline org-agenda-entry-types))) + (cond + ((memq org-agenda-show-log-scoped '(only clockcheck)) + (setq rtn (org-agenda-get-day-entries + file date :closed))) + (org-agenda-show-log-scoped + (setq rtn (apply 'org-agenda-get-day-entries + file date + (append '(:closed) org-agenda-entry-types)))) + (t + (setq rtn (apply 'org-agenda-get-day-entries + file date + org-agenda-entry-types))))) + (setq rtnall (append rtnall rtn)))) ;; all entries + (if org-agenda-include-diary + (let ((org-agenda-search-headline-for-time t)) + (require 'diary-lib) + (setq rtn (org-get-entries-from-diary date)) + (setq rtnall (append rtnall rtn)))) + (if (or rtnall org-agenda-show-all-dates) + (progn + (setq day-cnt (1+ day-cnt)) + (insert + (if (stringp org-agenda-format-date) + (format-time-string org-agenda-format-date + (org-time-from-absolute date)) + (funcall org-agenda-format-date date)) + "\n") + (put-text-property s (1- (point)) 'face + (org-agenda-get-day-face date)) + (put-text-property s (1- (point)) 'org-date-line t) + (put-text-property s (1- (point)) 'org-agenda-date-header t) + (put-text-property s (1- (point)) 'org-day-cnt day-cnt) + (when todayp + (put-text-property s (1- (point)) 'org-today t)) + (setq rtnall + (org-agenda-add-time-grid-maybe rtnall ndays todayp)) + (if rtnall (insert ;; all entries + (org-finalize-agenda-entries rtnall) + "\n")) + (put-text-property s (1- (point)) 'day d) + (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))) + (when (and org-agenda-clockreport-mode clocktable-start) + (let ((org-agenda-files (org-agenda-files nil 'ifmode)) + ;; the above line is to ensure the restricted range! + (p (copy-sequence org-agenda-clockreport-parameter-plist)) + tbl) + (setq p (org-plist-delete p :block)) + (setq p (plist-put p :tstart clocktable-start)) + (setq p (plist-put p :tend clocktable-end)) + (setq p (plist-put p :scope 'agenda)) + (when (and (eq org-agenda-clockreport-mode 'with-filter) + (setq filter (or org-agenda-tag-filter-while-redo + (get 'org-agenda-tag-filter :preset-filter)))) + (setq p (plist-put p :tags (mapconcat (lambda (x) + (if (string-match "[<>=]" x) + "" + x)) + filter "")))) + (setq tbl (apply 'org-get-clocktable p)) + (insert tbl))) + (goto-char (point-min)) + (or org-agenda-multi (org-fit-agenda-window)) + (unless (and (pos-visible-in-window-p (point-min)) + (pos-visible-in-window-p (point-max))) + (goto-char (1- (point-max))) + (recenter -1) + (if (not (pos-visible-in-window-p (or start-pos 1))) + (progn + (goto-char (or start-pos 1)) + (recenter 1)))) + (goto-char (or start-pos 1)) + (add-text-properties (point-min) (point-max) '(org-agenda-type agenda)) + (if (eq org-agenda-show-log-scoped 'clockcheck) + (org-agenda-show-clocking-issues)) + (org-finalize-agenda) + (setq buffer-read-only t) + (message "")))) (defun org-agenda-ndays-to-span (n) "Return a span symbol for a span of N days, or N if none matches." From 29afec9cd0853ddaca85779a7ecb22fa61d5ff82 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 28 Aug 2012 13:31:52 +0200 Subject: [PATCH 09/10] org-agenda.el (org-agenda-prepare): Let `throw' display an error * org-agenda.el (org-agenda-prepare): Let `throw' display an error. --- lisp/org-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 4479e827b..27b7af347 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -3376,7 +3376,7 @@ generating a new one." (org-agenda-prepare-window (get-buffer org-agenda-buffer-name)) (message "Sticky Agenda buffer, use `r' to refresh") (or org-agenda-multi (org-fit-agenda-window)) - (throw 'exit nil)) + (throw 'exit "Sticky Agenda buffer, use `r' to refresh")) (setq org-todo-keywords-for-agenda nil) (setq org-drawers-for-agenda nil) (unless org-agenda-persistent-filter From e9fee9cd63813bedd8728d8e2fce1ead9a545e7e Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 28 Aug 2012 13:36:43 +0200 Subject: [PATCH 10/10] org-agenda.el (org-agenda-fit-window-to-buffer): Rename from `org-fit-agenda-window' * org-agenda.el (org-agenda-fit-window-to-buffer): Rename from `org-fit-agenda-window'. (org-agenda-run-series, org-agenda-prepare, org-agenda-list) (org-search-view, org-todo-list, org-tags-view): Use the new name. --- lisp/org-agenda.el | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 27b7af347..fa4c6b983 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2774,6 +2774,15 @@ L Timeline for current buffer # List stuck projects (!=configure) ((equal c ?q) (error "Abort")) (t (error "Invalid key %c" c)))))))) +(defun org-agenda-fit-window-to-buffer () + "Fit the window to the buffer size." + (and (memq org-agenda-window-setup '(reorganize-frame)) + (fboundp 'fit-window-to-buffer) + (org-fit-window-to-buffer + nil + (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) + (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))) + (defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter (defvar org-agenda-last-arguments nil "The arguments of the previous call to `org-agenda'.") @@ -2833,7 +2842,7 @@ L Timeline for current buffer # List stuck projects (!=configure) (setq org-agenda-multi-current-cmd nil) (setq org-agenda-redo-command redo) (goto-char (point-min))) - (org-fit-agenda-window) + (org-agenda-fit-window-to-buffer) (org-let (nth 1 series) '(org-finalize-agenda))) ;;;###autoload @@ -3283,15 +3292,6 @@ removed from the entry content. Currently only `planning' is allowed here." (error "Cannot execute org-mode agenda command on buffer in %s" major-mode))) -(defun org-fit-agenda-window () - "Fit the window to the buffer size." - (and (memq org-agenda-window-setup '(reorganize-frame)) - (fboundp 'fit-window-to-buffer) - (org-fit-window-to-buffer - nil - (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) - (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))) - ;;; Agenda prepare and finalize (defvar org-agenda-multi nil) ; dynamically scoped @@ -3375,7 +3375,7 @@ generating a new one." ;; Popup existing buffer (org-agenda-prepare-window (get-buffer org-agenda-buffer-name)) (message "Sticky Agenda buffer, use `r' to refresh") - (or org-agenda-multi (org-fit-agenda-window)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) (throw 'exit "Sticky Agenda buffer, use `r' to refresh")) (setq org-todo-keywords-for-agenda nil) (setq org-drawers-for-agenda nil) @@ -4019,7 +4019,7 @@ given in `org-agenda-start-on-weekday'." (setq tbl (apply 'org-get-clocktable p)) (insert tbl))) (goto-char (point-min)) - (or org-agenda-multi (org-fit-agenda-window)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) (unless (and (pos-visible-in-window-p (point-min)) (pos-visible-in-window-p (point-max))) (goto-char (1- (point-max))) @@ -4321,7 +4321,7 @@ in `org-agenda-text-search-extra-files'." (when rtnall (insert (org-finalize-agenda-entries rtnall) "\n")) (goto-char (point-min)) - (or org-agenda-multi (org-fit-agenda-window)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) (add-text-properties (point-min) (point-max) '(org-agenda-type search)) (org-finalize-agenda) (setq buffer-read-only t))) @@ -4396,7 +4396,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (when rtnall (insert (org-finalize-agenda-entries rtnall) "\n")) (goto-char (point-min)) - (or org-agenda-multi (org-fit-agenda-window)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) (add-text-properties (point-min) (point-max) '(org-agenda-type todo)) (org-finalize-agenda) (setq buffer-read-only t))) @@ -4467,7 +4467,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (when rtnall (insert (org-finalize-agenda-entries rtnall) "\n")) (goto-char (point-min)) - (or org-agenda-multi (org-fit-agenda-window)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) (add-text-properties (point-min) (point-max) '(org-agenda-type tags)) (org-finalize-agenda) (setq buffer-read-only t)))