Function: org-clock-special-range

org-clock-special-range is a byte-compiled function defined in org-clock.el.gz.

Signature

(org-clock-special-range KEY &optional TIME AS-STRINGS WSTART MSTART)

Documentation

Return two times bordering a special time range.

KEY is a symbol specifying the range and can be one of today, yesterday, thisweek, lastweek, thismonth, lastmonth, thisyear, lastyear or untilnow. If set to interactive, user is prompted for range boundaries. It can be a string or an integer.

By default, a week starts Monday 0:00 and ends Sunday 24:00. The range is determined relative to TIME, which defaults to current time.

The return value is a list containing two internal times, one for the beginning of the range and one for its end, like the ones returned by current-time or encode-time and a string used to display information. If AS-STRINGS is non-nil, the returned times will be formatted strings. Note that the first element is always nil when KEY is untilnow.

If WSTART is non-nil, use this number to specify the starting day of a week (monday is 1). If MSTART is non-nil, use this number to specify the starting day of a month (1 is the first day of the month). If you can combine both, the month starting day will have priority.

Source Code

;; Defined in /usr/src/emacs/lisp/org/org-clock.el.gz
(defun org-clock-special-range (key &optional time as-strings wstart mstart)
  "Return two times bordering a special time range.

KEY is a symbol specifying the range and can be one of `today',
`yesterday', `thisweek', `lastweek', `thismonth', `lastmonth',
`thisyear', `lastyear' or `untilnow'.  If set to `interactive',
user is prompted for range boundaries.  It can be a string or an
integer.

By default, a week starts Monday 0:00 and ends Sunday 24:00.  The
range is determined relative to TIME, which defaults to current
time.

The return value is a list containing two internal times, one for
the beginning of the range and one for its end, like the ones
returned by `current-time' or `encode-time' and a string used to
display information.  If AS-STRINGS is non-nil, the returned
times will be formatted strings.  Note that the first element is
always nil when KEY is `untilnow'.

If WSTART is non-nil, use this number to specify the starting day
of a week (monday is 1).  If MSTART is non-nil, use this number
to specify the starting day of a month (1 is the first day of the
month).  If you can combine both, the month starting day will
have priority."
  (let* ((tm (decode-time time))
	 (m (nth 1 tm))
	 (h (nth 2 tm))
	 (d (nth 3 tm))
	 (month (nth 4 tm))
	 (y (nth 5 tm))
	 (dow (nth 6 tm))
	 (skey (format "%s" key))
	 (shift 0)
	 (q (cond ((>= month 10) 4)
		  ((>= month 7) 3)
		  ((>= month 4) 2)
		  (t 1)))
	 h1 d1 month1 y1 shiftedy shiftedm shiftedq) ;; m1
    (cond
     ((string-match "\\`[0-9]+\\'" skey)
      (setq y (string-to-number skey) month 1 d 1 key 'year))
     ((string-match "\\`\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)\\'" skey)
      (setq y (string-to-number (match-string 1 skey))
	    month (string-to-number (match-string 2 skey))
	    d 1
	    key 'month))
     ((string-match "\\`\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)\\'" skey)
      (require 'cal-iso)
      (let ((date (calendar-gregorian-from-absolute
		   (calendar-iso-to-absolute
		    (list (string-to-number (match-string 2 skey))
			  1
			  (string-to-number (match-string 1 skey)))))))
	(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 q (string-to-number (match-string 2 skey)))
      (let ((date (calendar-gregorian-from-absolute
		   (calendar-iso-to-absolute
		    (org-quarter-to-date
		     q (string-to-number (match-string 1 skey)))))))
	(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))
	    d (string-to-number (match-string 3 skey))
	    key 'day))
     ((string-match "\\([-+][0-9]+\\)\\'" skey)
      (setq shift (string-to-number (match-string 1 skey))
	    key (intern (substring skey 0 (match-beginning 1))))
      (when (and (memq key '(quarter thisq)) (> shift 0))
	(error "Looking forward with quarters isn't implemented"))))
    (when (= shift 0)
      (pcase key
	(`yesterday (setq key 'today   shift -1))
	(`lastweek  (setq key 'week    shift -1))
	(`lastmonth (setq key 'month   shift -1))
	(`lastyear  (setq key 'year    shift -1))
	(`lastq     (setq key 'quarter shift -1))))
    ;; Prepare start and end times depending on KEY's type.
    (pcase key
      ((or `day `today) (setq m 0
                              h org-extend-today-until
                              h1 (+ 24 org-extend-today-until)
                              d (+ d shift)))
      ((or `week `thisweek)
       (let* ((ws (or wstart 1))
	      (diff (+ (* -7 shift) (mod (+ dow 7 (- ws)) 7))))
	 (setq m 0 h org-extend-today-until d (- d diff) d1 (+ 7 d))))
      ((or `month `thismonth)
       (setq h org-extend-today-until m 0 d (or mstart 1)
             month (+ month shift) month1 (1+ month)))
      ((or `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.
	 (let* ((interval (* -1 (+ (- q 1) shift)))
		;; Set tmp to ((years to shift) (quarters to shift)).
		(tmp (cl-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 m 0 h org-extend-today-until d 1
               month shiftedm month1 (+ 3 shiftedm) y shiftedy))
	((> (+ q shift) 0)		; Shift is within this year.
	 (setq shiftedq (+ q shift))
	 (setq shiftedy y)
	 (let ((qshift (* 3 (1- (+ q shift)))))
	   (setq m 0 h org-extend-today-until d 1
                 month (+ 1 qshift) month1 (+ 4 qshift))))))
      ((or `year `thisyear)
       (setq m 0 h org-extend-today-until d 1 month 1 y (+ y shift) y1 (1+ y)))
      ((or `interactive `untilnow))	; Special cases, ignore them.
      (_ (user-error "No such time block %s" key)))
    ;; Format start and end times according to AS-STRINGS.
    (let* ((start (pcase key
		    (`interactive (org-read-date nil t nil "Range start? "))
		    (`untilnow nil)
		    (_ (org-encode-time 0 m h d month y))))
	   (end (pcase key
		  (`interactive (org-read-date nil t nil "Range end? "))
		  (`untilnow (current-time))
		  (_ (org-encode-time 0
                                      m ;; (or m1 m)
                                      (or h1 h)
                                      (or d1 d)
                                      (or month1 month)
                                      (or y1 y)))))
	   (text
	    (pcase key
	      ((or `day `today) (format-time-string "%A, %B %d, %Y" start))
	      ((or `week `thisweek) (format-time-string "week %G-W%V" start))
	      ((or `month `thismonth) (format-time-string "%B %Y" start))
	      ((or `year `thisyear) (format-time-string "the year %Y" start))
	      ((or `quarter `thisq)
	       (concat (org-count-quarter shiftedq)
		       " quarter of " (number-to-string shiftedy)))
	      (`interactive "(Range interactively set)")
	      (`untilnow "now"))))
      (if (not as-strings) (list start end text)
	(let ((f (org-time-stamp-format 'with-time)))
	  (list (and start (format-time-string f start))
		(format-time-string f end)
		text))))))