diff --git a/lisp/org.el b/lisp/org.el index de8c72b..baffde4 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -12256,10 +12256,11 @@ p Enter a property name and its value (both with completion on existing r Show entries matching a regular expression (`/' can be used as well) d Show deadlines due within `org-deadline-warning-days'. b Show deadlines and scheduled items before a date. -a Show deadlines and scheduled items after a date." +a Show deadlines and scheduled items after a date. +i Show inactive or active timestamps within a date interval." (interactive "P") (let (ans kwd value) - (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date") + (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [i]nterval") (setq ans (read-char-exclusive)) (cond ((equal ans ?d) @@ -12268,6 +12269,8 @@ a Show deadlines and scheduled items after a date." (call-interactively 'org-check-before-date)) ((equal ans ?a) (call-interactively 'org-check-after-date)) + ((equal ans ?i) + (org-find-timestamps nil nil nil nil 'org-occur nil)) ((equal ans ?t) (org-show-todo-tree nil)) ((equal ans ?T) @@ -20665,6 +20668,198 @@ Still experimental, may disappear in the future." ;; make tree, check each match with the callback (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) +(defun org-find-timestamps (&optional first-date last-date buffer-name which collect-method sort) + "Find inactive timestamps within a date-range and maybe sort them. + +This function can help to bring the notes, that you take within +org-mode, into a chronological order, even if they are scattered +among many different nodes. The result is somewhat like a diary, +listing the timestamps of the notes, that you have taken on each day. +Such a listing might help to provide an answer to the common question +'What have I done last Week ?' +Please be aware however: This intended usage requires, +that you routinely insert (inactive) timestamps into the +notes that you write, which is a prerequisite habit that you may or +may not want to adopt. + +org-find-timstamps works in these steps: Create a regular expression +to match a given range of dates; search for it and +display the results either as a sparse tree or with the help +of occur. The original buffer is not modified. + +The Arguments FIRST-DATE and LAST-DATE (yyyy-mm-dd) define the range +of timestamps to search for. In general anything, that can be +understood by `org-read-date' will be accepted. + +BUFFER-NAME specifies the name of the buffer to search. If nil, use +the current buffer. + +The Argument WHICH (one of the symbols `active', `inactive' +or `both'), tells the function, which timestamps to search for. + +COLLECT-METHOD can be one of `org-occur', `occur' and +`multi-occur' and determines, Which buffers to search (current or +all org-mode buffers) and how to present the matches. + +Results will be sorted according to SORT (either the symbol `y' +or `n'). Sorting however is only possible, if results are presented +with `occur' or `multi-occur'. + +All Arguments can be `nil' (or ommitted), in which case their values +are queried interactively. + +" + (interactive) + + (let ((occur-buffer-name "*Occur*") + (occur-header-regex "^[0-9]+ match\\(es\\)?") ;; regexp to match for header-lines in *Occur* buffer + description + swap-dates + (days 0) + date-regex + buff + org-buffers + ) + (if buffer-name (switch-to-buffer buffer-name)) + (save-window-excursion + ;; ask for type of timestamp to search, if not supplied as an argument + (cond ((null which) + (setq which (intern-soft (car (split-string (org-icompleting-read "Please choose, which type of timestamp to search: " '("active" "inactive" "both") nil t nil nil "inactive")))))) + ((not (member which '(active inactive both))) + (error "Argument `WHICH' can not be `%s'" which))) + ;; ask for date-range, if not supplied as argument + (setq last-date (org-read-date nil nil last-date "End date (or start): " nil nil)) + (setq first-date (org-read-date nil nil first-date "Start date (or end): " nil nil)) + ;; swap dates, if required + (when (string< last-date first-date) + (setq swap-dates last-date) + (setq last-date first-date) + (setq first-date swap-dates)) + ;; readable description of what we searched for + (setq description (format "%s timestamps from %s to %s in %s, %s" + (if (eq which 'both) "active and inactive" (symbol-name which)) + first-date last-date + (if (eq collect-method 'multi-occur) "all org-buffers" (concat "buffer " (buffer-name))) + (if (and (eq sort 'yes) (not (eq collect-method 'org-occur))) "sorted" "not sorted"))) + ;; temporary buffer for date-manipulations + (with-temp-buffer + ;; construct list of dates in working buffer, loop as long we did not reach end-date + (while (not (looking-at-p last-date)) + (goto-char (point-max)) + ;; Type of timstamp (inactive) might be wrong, will be corrected below + (insert "[") + ;; Day of week (Mo) might be wrong, will be corrected below + (insert first-date " Mo]\n") + (forward-line -1) + ;; advance number of days and correct day of week + (org-timestamp-change days 'day) + (setq days (1+ days)) + (when (eq which 'both) + ;; double last timestamp + (let (start content) + (move-to-column 0) + (setq start (point)) + (forward-line) + (setq content (delete-and-extract-region start (point))) + (insert content) + (insert content) + (forward-line -1) + ) + ) + (unless (eq which 'inactive) + ;; inserted inactive timestamp above, now we correct this + (org-toggle-timestamp-type) + ) + (move-to-column 1) + ) + (goto-char (point-max)) + ;; transform constructed list of dates into a single, optimized regex + (setq date-regex (regexp-opt (split-string (buffer-string) "\n" t))) + ) + ) + ;; If no argument supplied, ask user, which buffers to search and how to present the results + (or collect-method (setq collect-method (intern (car (split-string (org-icompleting-read "Please choose, which buffers to search and how to present the matches: " '("occur -- this buffer, list" "multi-occur -- all org-buffers, list" "org-occur -- this-buffer, sparse tree") nil t nil nil "occur -- this buffer, list")))))) + + ;; Perform the actual search + (save-window-excursion + (cond ((eq collect-method 'occur) + (occur date-regex) + ) + ((eq collect-method 'org-occur) + (if (string= major-mode "org-mode") + (org-occur date-regex) + (error "Buffer not in org-mode")) + ) + ((eq collect-method 'multi-occur) + ;; construct list of all org-buffers + (dolist (buff (buffer-list)) + (set-buffer buff) + (if (string= major-mode "org-mode") + (setq org-buffers (cons buff org-buffers)))) + (multi-occur org-buffers date-regex)) + (t (error (format "Argument `COLLECT-METHOD' can not be `%s'" collect-method))) + ) + ) + ;; Postprocessing: Optionally sort buffer with results + ;; org-occur operates on the current buffer, so we cannot modify its results afterwards + (if (eq collect-method 'org-occur) + (message (concat "Sparse tree with " description)) + ;; switch to occur-buffer and modify it + (if (not (get-buffer occur-buffer-name)) + (message (concat "Did not find any matches for " description)) + (let ((original-inhibit-read-only inhibit-read-only)) + (unwind-protect + (progn + ;; next line might be risky, so we unwind-protect it + (setq inhibit-read-only t) + (set-buffer occur-buffer-name) + (goto-char (point-min)) + ;; beautify the occur-buffer by replacing the potentially long original regexp + (while (search-forward (concat " for \"" date-regex "\"") nil t) + (replace-match "" nil t)) + (goto-char (point-min)) + ;; Sort results by matching date ? + (when (cond ((eq sort 'yes) t) + ((eq sort 'no) nil) + ((null sort) (y-or-n-p "Sort results by date ? ")) + (t (error "Argument `SORT' can not be `%s'" sort))) + (when (eq collect-method 'multi-occur) + ;; bring all header lines ('xx matches for ..') to top of buffer, all lines with matches to bottom + (sort-subr t + 'forward-line + 'end-of-line + ;; search-key for this sort only differentiates between header-lines and matche-lines + (lambda () (if (looking-at-p occur-header-regex) 2 1)) + nil) + ) + ;; goto first line of matches + (goto-char (point-max)) + (search-backward-regexp occur-header-regex) + (forward-line) + ;; sort all matches according to date, that matched the regex + (sort-subr t + 'forward-line + 'end-of-line + ;; search-key for this sort is date + (lambda () (search-forward-regexp date-regex) (substring (match-string 0) 1 -1)) + nil + 'string<) + ;; pretend, that we did not modify the occur-buffer + ) + (insert (format "Searched for %s.\n" description)) + (goto-char (point-min)) + (set-buffer-modified-p nil) + ) + (setq inhibit-read-only original-inhibit-read-only) + ) + ) + ;; show result + (switch-to-buffer occur-buffer-name) + ) + ) + ) + ) + ;;;; Finish up (provide 'org)