My e-mails in Wanderlust have a header that looks like this:
Date: Wed, 23 Oct 2013 12:18:15 -0700
I would like to modify the beginning of my print-to-pdf function so that it searches the current buffer for the first date it finds (usually the first line of the buffer) and converts it into a proposed pdf-file-name that looks like this:
10_23_2013.pdf
The beginning of my print-to-pdf function looks like this:
(defun print-to-pdf (pdf-file-name)
"Print the current buffer to the given file."
(interactive (list
(ns-read-file-name "Write PDF file: " "/Users/HOME/.0.data/" nil ".pdf")))
(cond (
(not (equal pdf-file-name nil))
***
Can anyone think of a way to search for the date and turn it into a proposed pdf-file-name?
EDIT: Here are some of the date string functions I found by grepping the Wanderlust code:
(defun wl-make-date-string ()
(let ((system-time-locale "C"))
(format-time-string "%a, %d %b %Y %T %z")))
(defsubst wl-get-date-iso8601 (date)
(or (get-text-property 0 'wl-date date)
(let* ((d1 (timezone-fix-time date nil nil))
(time (format "%04d%02d%02dT%02d%02d%02d"
(aref d1 0) (aref d1 1) (aref d1 2)
(aref d1 3) (aref d1 4) (aref d1 5))))
(put-text-property 0 1 'wl-date time date)
time)))
(defun wl-make-date-string ()
(let ((s (current-time-string)))
(string-match "\\`\\([A-Z][a-z][a-z]\\) +[A-Z][a-z][a-z] +[0-9][0-9]? *[0-9][0-9]?:[0-9][0-9]:[0-9][0-9] *[0-9]?[0-9]?[0-9][0-9]"
s)
(concat (wl-match-string 1 s) ", "
(timezone-make-date-arpa-standard s (current-time-zone)))))
(defun wl-date-iso8601 (date)
"Convert the DATE to YYMMDDTHHMMSS."
(condition-case ()
(wl-get-date-iso8601 date)
(error "")))
Here's the function.
If you can find a way to extract Wed, 23 Oct 2013 12:18:15 -0700, it will produce
10_23_2013.pdf.
(defun transform-date (s &optional shift)
(let ((time (apply 'encode-time
(org-read-date-analyze
s nil
(decode-time (current-time))))))
(when shift
(setq time (time-add time (days-to-time shift))))
(format-time-string "%m_%d_%Y.pdf" time)))
Here's a simple finder for the date:
(defun find-and-transform ()
(goto-char (point-min))
(when (re-search-forward "Date: \\([^:]*?\\)[0-9]+:")
(transform-date
(match-string-no-properties 1))))
Related
How can I get the number of days between the given years, should I use loops?
Here's what I have now
(princ "Enter starting year: ")
(defparameter w (read))
(princ "Enter ending year: ")
(defparameter x (read))
(defun print-list (w x)
(format t "Starting year: ~a ~%" (list w))
(format t "Ending year: ~a ~%" (list x)))
(terpri)
(if(> x w)
(format t "Number of year/s: ~a ~%"(- x w))
(format t "Number of year/s: ~a ~%"(- w x)))
I'm trying to compute the days between years but the output was always failed.
A simple set of functions to perform the calculation is the following:
(defun leap-year-p (year)
"return t if year is a leap-year, nil otherwise"
(or (and (zerop (mod year 4))
(not (zerop (mod year 100))))
(zerop (mod year 400))))
(defun days-of (year)
"return the number of days of a certain year"
(if (leap-year-p year) 365 366))
(defun days-between (start-year end-year)
"return the number of days between start-year (included)
and end-year (excluded)"
(when (<= start-year end-year)
(loop for year from start-year below end-year sum (days-of year)))
A few examples of call:
CL-USER> (days-between 2020 2022)
731
CL-USER> (days-between 1820 1999)
65470
CL-USER> (days-between 2020 2020)
0
CL-USER> (days-between 1980 1890)
NIL
You can use these function to solve your problem.
I'm just starting to use ses-mode in emacs, and I plan to use it with timestamps, but I do not manage to have them parsed in a way that I can then use.
I'm taking measurements on three days of the week, so my distances between one measurement and the other is either 2 or 3 days. I chose to use ses-mode in emacs because it runs on all of my computers, including the phone.
my spreadsheet contains datestamp, conductivity, temperature, and gallon count, a couple of subsequent lines would look like this:
2014-10-03 2.95 33.4 4031070
2014-10-06 3.07 33.5 4086930
2014-10-08 2.97 33.6 4119590
I would add two more columns, the first with the difference of days between the readings, the second with the "gallon-per-day" value.
I do not manage to have the string timestamp parsed into a format where I can do computations, staying within a simple emacs spreadsheet (SES).
I've tried date-to-time, but it always returns the same value (14445 17280).
parse-time-string gives me a 9-tuple which I can't directly pass to format-time-string.
The function encode-time helps:
(let ((l (parse-time-string "2014-09-12")))
(format-time-string "%d %m %Y" (encode-time 0 0 0 (nth 3 l) (nth 4 l) (nth 5 l))))
The following version uses cl-flet to avoid doubling of code if the encoding is needed multiple times. If you need the encoding also in other functions you can use defun instead of cl-flet.
(eval-when (compile) (require 'cl)) ;; for cl-flet
(let ((A2 "2014-10-08") ;; just for testing
(A1 "2014-10-03")) ;; just for testing
(cl-flet ((encode (str)
(let ((l (parse-time-string str)))
(encode-time 0 0 0 (nth 3 l) (nth 4 l) (nth 5 l)))))
(let* ((t-prev (encode A1))
(t-this (encode A2)))
(/ (time-to-seconds (time-subtract t-this t-prev)) (* 24 60 60)))))
As a function:
(eval-when (compile) (require 'cl)) ;; for cl-flet
(defun day-diff (date1 date2)
"Calculate the difference of dates in days between DATE1-STR and DATE2-STR."
(interactive "sDate1:\nsDate2:")
(cl-flet ((encode (str)
(let ((l (parse-time-string str)))
(encode-time 0 0 0 (nth 3 l) (nth 4 l) (nth 5 l)))))
(setq date1 (encode date1)
date2 (encode date2))
(let ((ret (/ (time-to-seconds (time-subtract date1 date2)) (* 24 60 60))))
(when (called-interactively-p 'any)
(message "Day difference: %s" ret))
ret)))
(put 'day-diff 'safe-function t)
An alternative using calc would be:
(require 'calc)
(defun day-diff (date1 date2)
"Calculate the difference of dates in days between DATE1-STR and DATE2-STR."
(interactive "sDate1:\nsDate2:")
(let ((ret (string-to-number (calc-eval (format "<%s>-<%s>" date1 date2)))))
(when (called-interactively-p 'any)
(message "Day difference: %s" ret))
ret))
If you omit the nice-to-have features this becomes almost a simple cell formula: (string-to-number (calc-eval (format "<%s>-<%s>" A1 A2))).
If you want to save the stuff in the spreadsheet you can put the defun in table cell A1. A more simple example:
(progn (defun day-diff (date1 date2) (string-to-number (calc-eval (format "<%s>-<%s>" date1 date2)))) (put 'day 'safe-function t) "Actual header")
To have a more convenient editing possibility you can switch to M-x lisp-mode.
There you find
^L
(ses-cell A1 "Actual Header" (progn (defun day-diff (date1 date2) (string-to-number (calc-eval (format "<%s>-<%s>" date1 date2)))) (put 'day 'safe-function t) "Actual header") nil nil)
which you can edit. But do not insert linebreaks! ses identifies cell-positions with line numbers in that file!
Another nice alternative is to put the definition of your function into the file-local variable list.
Switch to lisp-interaction mode by M-x lisp-interaction-mode.
Go to the end of the file. There you find the lines:
;; Local Variables:
;; mode: ses
;; End:
Add your function definition as eval to this list:
;; Local Variables:
;; mode: ses
;; eval:
;; (progn
;; (defun day-diff (date1 date2)
;; (string-to-number (calc-eval (format "<%s>-<%s>" date1 date2))))
;; (put 'day-diff 'safe-function t))
;; End:
You can add the progn without the comment characters ;. In this case even indentation works. Afterwards you can call comment-region for the progn.
You can save the file and run M-x normal-mode. Afterwards the function is defined and you can use it in the spreadsheet.
I have not been able to figure out why with-current-buffer or set-buffer does not work with the function calendar-cursor-to-visible-date. I would like the function to work without actually switching to the calendar window -- i.e., it should work even when the buffer is buried. I've tried sit-for 0, but that had no affect.
I've included a broken-example using with-current-buffer and a working-example using select-window.
EDIT: I found a similar issue on an Emacs mailing list from March 2005: http://lists.gnu.org/archive/html/emacs-pretest-bug/2005-03/msg00170.html I'll do some more testing, but the following line of code fixes the broken-example -- it goes immediately after (calendar-cursor-to-visible-date date).
(set-window-point (get-buffer-window "*Calendar*" (selected-frame)) (point)))
(defun broken-example (&optional month year)
(interactive)
(delete-other-windows)
(if (get-buffer "*Calendar*")
(kill-buffer "*Calendar*"))
(calendar)
(other-window 1)
(when (get-buffer "*Calendar*")
(with-current-buffer (get-buffer "*Calendar*")
(calendar-generate-window month year)
(let ((old-date (calendar-cursor-to-date))
(today (calendar-current-date)))
(cond
((and
(calendar-date-is-visible-p old-date)
(not (equal old-date today)))
(calendar-cursor-to-visible-date old-date))
((calendar-date-is-visible-p today)
(calendar-cursor-to-visible-date today))
(t
(calendar-cursor-to-visible-date (list month 1 year))))))))
(defun working-example (&optional month year)
(interactive)
(delete-other-windows)
(if (get-buffer "*Calendar*")
(kill-buffer "*Calendar*"))
(calendar)
(other-window 1)
(when (get-buffer "*Calendar*")
(select-window (get-buffer-window "*Calendar*" (selected-frame)))
(calendar-generate-window month year)
(let ((old-date (calendar-cursor-to-date))
(today (calendar-current-date)))
(cond
((and
(calendar-date-is-visible-p old-date)
(not (equal old-date today)))
(calendar-cursor-to-visible-date old-date))
((calendar-date-is-visible-p today)
(calendar-cursor-to-visible-date today))
(t
(calendar-cursor-to-visible-date (list month 1 year)))))))
Here's my recommendation:
(with-selected-window (or (get-buffer-window (current-buffer) 0)
(selected-window))
(calendar-cursor-to-visible-date date))
Of course, calling set-window-point after the fact is a perfectly acceptable alternative as well.
December 25, 2013: First working draft of the revised function calendar-cursor-to-visible-date, which uses set-window-point:
(defun lawlist-calendar-cursor-to-visible-date (date)
"Move the cursor to DATE that is on the screen."
(let* (
(month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date))
(buffer (buffer-name)))
(goto-char (point-min))
(forward-line (+ calendar-first-date-row -1
(/ (+ day -1
(mod
(- (calendar-day-of-week (list month 1 year))
calendar-week-start-day)
7))
7)))
(move-to-column (+ calendar-left-margin (1- calendar-day-digit-width)
(* calendar-month-width
(1+ (calendar-interval
displayed-month displayed-year month year)))
(* calendar-column-width
(mod
(- (calendar-day-of-week date)
calendar-week-start-day)
7))))
(if (get-buffer-window buffer (selected-frame))
(set-window-point (get-buffer-window buffer (selected-frame)) (point)))))
I'm looking for a way to select next or previous month in both agenda view and the calendar. I've written a concept/prototype function (below), but it doesn't calculate the next or previous months and I would also need to rewrite the function every month.
The date format for the org-agenda-month-view is different than the date format for calendar-other-month. Further down below are some functions that are related to what I'm trying to accomplish -- e.g., calendar already has the ability to move forward or backward by month.
I think what may be needed is a function that identifies the month being viewed and then adds plus-or-minus one month (in the proper format) when hitting the next or previous button.
(defun lawlist-org-agenda-view-mode-dispatch ()
"Select the month in agenda view."
(interactive)
(message "View: [7] JUL | [8] AUG | [9] SEP | [o]CT | [n]OV | [d]EC ")
(let ((a (read-char-exclusive)))
(case a
(?7
(org-agenda nil "a")
(org-agenda-month-view 201307)
(calendar)
(calendar-other-month 7 2013)
(lawlist-org-agenda-view-mode-dispatch))
(?8
(org-agenda nil "a")
(org-agenda-month-view 201308)
(calendar)
(calendar-other-month 8 2013)
(lawlist-org-agenda-view-mode-dispatch))
(?9
(org-agenda nil "a")
(org-agenda-month-view 201309)
(calendar)
(calendar-other-month 9 2013)
(lawlist-org-agenda-view-mode-dispatch))
(?o
(org-agenda nil "a")
(org-agenda-month-view 201310)
(calendar)
(calendar-other-month 10 2013)
(lawlist-org-agenda-view-mode-dispatch))
(?n
(org-agenda nil "a")
(org-agenda-month-view 201311)
(calendar)
(calendar-other-month 11 2013)
(lawlist-org-agenda-view-mode-dispatch))
(?d
(org-agenda nil "a")
(org-agenda-month-view 201312)
(calendar)
(calendar-other-month 12 2013)
(lawlist-org-agenda-view-mode-dispatch))
(?q (message "Abort"))
(otherwise (error "Either press \"q\" to quit, or select another option." )))))
Here are some related functions I've extracted from cal-move.el and calendar.el:
(defun calendar-other-month (month year &optional event)
"Display a three-month calendar centered around MONTH and YEAR.
EVENT is an event like `last-nonmenu-event'."
(interactive (let ((event (list last-nonmenu-event)))
(append (calendar-read-date 'noday) event)))
(save-selected-window
(and event
(setq event (event-start event))
(select-window (posn-window event)))
(unless (and (= month displayed-month)
(= year displayed-year))
(let ((old-date (calendar-cursor-to-date))
(today (calendar-current-date)))
(calendar-generate-window month year)
(calendar-cursor-to-visible-date
(cond
((calendar-date-is-visible-p old-date) old-date)
((calendar-date-is-visible-p today) today)
(t (list month 1 year))))))))
;;;###cal-autoload
(defun calendar-forward-month (arg)
"Move the cursor forward ARG months.
Movement is backward if ARG is negative."
(interactive "p")
(calendar-cursor-to-nearest-date)
(let* ((cursor-date (calendar-cursor-to-date t))
(month (calendar-extract-month cursor-date))
(day (calendar-extract-day cursor-date))
(year (calendar-extract-year cursor-date))
(last (progn
(calendar-increment-month month year arg)
(calendar-last-day-of-month month year)))
(day (min last day))
;; Put the new month on the screen, if needed, and go to the new date.
(new-cursor-date (list month day year)))
(if (not (calendar-date-is-visible-p new-cursor-date))
(calendar-other-month month year))
(calendar-cursor-to-visible-date new-cursor-date))
(run-hooks 'calendar-move-hook))
;;;###cal-autoload
(defun calendar-backward-month (arg)
"Move the cursor backward by ARG months.
Movement is forward if ARG is negative."
(interactive "p")
(calendar-forward-month (- arg)))
;;;###cal-autoload
(defun calendar-forward-year (arg)
"Move the cursor forward by ARG years.
Movement is backward if ARG is negative."
(interactive "p")
(calendar-forward-month (* 12 arg)))
;;;###cal-autoload
(defun calendar-backward-year (arg)
"Move the cursor backward ARG years.
Movement is forward is ARG is negative."
(interactive "p")
(calendar-forward-month (* -12 arg)))
;;;###cal-autoload
(defun calendar-scroll-left (&optional arg event)
"Scroll the displayed calendar left by ARG months.
If ARG is negative the calendar is scrolled right. Maintains the relative
position of the cursor with respect to the calendar as well as possible.
EVENT is an event like `last-nonmenu-event'."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(unless arg (setq arg 1))
(save-selected-window
;; Nil if called from menu-bar.
(if (setq event (event-start event)) (select-window (posn-window event)))
(calendar-cursor-to-nearest-date)
(unless (zerop arg)
(let ((old-date (calendar-cursor-to-date))
(today (calendar-current-date))
(month displayed-month)
(year displayed-year))
(calendar-increment-month month year arg)
(calendar-generate-window month year)
(calendar-cursor-to-visible-date
(cond
((calendar-date-is-visible-p old-date) old-date)
((calendar-date-is-visible-p today) today)
(t (list month 1 year))))))
(run-hooks 'calendar-move-hook)))
(define-obsolete-function-alias
'scroll-calendar-left 'calendar-scroll-left "23.1")
;;;###cal-autoload
(defun calendar-scroll-right (&optional arg event)
"Scroll the displayed calendar window right by ARG months.
If ARG is negative the calendar is scrolled left. Maintains the relative
position of the cursor with respect to the calendar as well as possible.
EVENT is an event like `last-nonmenu-event'."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(calendar-scroll-left (- (or arg 1)) event))
(define-obsolete-function-alias
'scroll-calendar-right 'calendar-scroll-right "23.1")
Here's my take:
(defvar lawlist-month)
(defun lawlist-org-agenda-view-mode-dispatch ()
"Select the month in agenda view."
(interactive)
(message "View: [1-9] [o]CT [n]OV [d]EC, j(next), k(prev).")
(let* ((a (read-char-exclusive))
(month (case a
(?o 10)
(?n 11)
(?d 12)
(?j (or (and lawlist-month (mod (1+ lawlist-month) 12)) 1))
(?k (or (and lawlist-month (mod (1- lawlist-month) 12)) 1))
(t (and (> a ?0) (<= a ?9) (- a ?0))))))
(if (setq lawlist-month month)
(let ((year (nth 5 (decode-time (current-time)))))
(org-agenda nil "a")
(org-agenda-month-view
(read (format "%d%02d" year month)))
(calendar)
(calendar-other-month month year)
(lawlist-org-agenda-view-mode-dispatch))
(message "Aborted"))))
It still misses some functionality like saving the window configuration and
recovering on abort.
UPD
The updated code can be found in this gist.
I've added other years besides current, with support for j/k, as well as h/l for years.
In Emacs, when you display the calendar with M-x calendar, you get a three-month display – last month, this month, and next month – in a new window that's just 8 lines tall.
Is it possible to generate a twelve-month calendar in a full-size window?
12-MONTH CALENDAR -- SCROLLS BY MONTH (FORWARDS / BACKWARDS)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; Scroll a yearly calendar by month -- in a forwards or backwards direction. ;;;
;;; ;;;
;;; To try out this example, evaluate the entire code snippet and type: ;;;
;;; ;;;
;;; M-x year-calendar ;;;
;;; ;;;
;;; To scroll forward by month, type the key: > ;;;
;;; ;;;
;;; To scroll backward by month, type the key: < ;;;
;;; ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(eval-after-load "calendar" '(progn
(define-key calendar-mode-map "<" 'lawlist-scroll-year-calendar-backward)
(define-key calendar-mode-map ">" 'lawlist-scroll-year-calendar-forward) ))
(defmacro lawlist-calendar-for-loop (var from init to final do &rest body)
"Execute a for loop.
Evaluate BODY with VAR bound to successive integers from INIT to FINAL,
inclusive. The standard macro `dotimes' is preferable in most cases."
`(let ((,var (1- ,init)))
(while (>= ,final (setq ,var (1+ ,var)))
,#body)))
(defun year-calendar (&optional month year)
"Generate a one (1) year calendar that can be scrolled by month in each direction.
This is a modification of: http://homepage3.nifty.com/oatu/emacs/calendar.html
See also: http://ivan.kanis.fr/caly.el"
(interactive)
(require 'calendar)
(let* ((current-year (number-to-string (nth 5 (decode-time (current-time)))))
(month (if month month
(string-to-number
(read-string "Please enter a month number (e.g., 1): " nil nil "1"))))
(year (if year year
(string-to-number
(read-string "Please enter a year (e.g., 2014): "
nil nil current-year)))))
(switch-to-buffer (get-buffer-create calendar-buffer))
(when (not (eq major-mode 'calendar-mode))
(calendar-mode))
(setq displayed-month month)
(setq displayed-year year)
(setq buffer-read-only nil)
(erase-buffer)
;; horizontal rows
(lawlist-calendar-for-loop j from 0 to 3 do
;; vertical columns
(lawlist-calendar-for-loop i from 0 to 2 do
(calendar-generate-month
;; month
(cond
((> (+ (* j 3) i month) 12)
(- (+ (* j 3) i month) 12))
(t
(+ (* j 3) i month)))
;; year
(cond
((> (+ (* j 3) i month) 12)
(+ year 1))
(t
year))
;; indentation / spacing between months
(+ 5 (* 25 i))))
(goto-char (point-max))
(insert (make-string (- 10 (count-lines (point-min) (point-max))) ?\n))
(widen)
(goto-char (point-max))
(narrow-to-region (point-max) (point-max)))
(widen)
(goto-char (point-min))
(setq buffer-read-only t)))
(defun lawlist-scroll-year-calendar-forward (&optional arg event)
"Scroll the yearly calendar by month in a forward direction."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(unless arg (setq arg 1))
(save-selected-window
(if (setq event (event-start event)) (select-window (posn-window event)))
(unless (zerop arg)
(let ((month displayed-month)
(year displayed-year))
(calendar-increment-month month year arg)
(year-calendar month year)))
(goto-char (point-min))
(run-hooks 'calendar-move-hook)))
(defun lawlist-scroll-year-calendar-backward (&optional arg event)
"Scroll the yearly calendar by month in a backward direction."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(lawlist-scroll-year-calendar-forward (- (or arg 1)) event))
There doesn't seem to be an easy way to do this. I was able to knock up the following code, which will show all twelve months, in a row, in a separate frame.
(require 'cl)
(require 'calendar)
(defun twelve-month-calendar ()
(interactive)
(let ((calendar-buffer (get-buffer-create "12-month calendar"))
(month 12)
(year 2012))
(set-buffer calendar-buffer)
(setq calendar-frame (make-frame))
(make-variable-buffer-local 'font-lock-face)
(set-face-attribute 'default calendar-frame :height 70)
(set-frame-width calendar-frame 300)
(erase-buffer)
(dotimes (i 12)
(calendar-generate-month month year 0)
(calendar-increment-month month year -1))
(calendar-mode)))
You might need to tweak it a bit, depending on your screen/font size.
I modified "12-MONTH CALENDAR -- SCROLLS BY MONTH (FORWARDS / BACKWARDS)" answer and adapted it to Emacs post 23.3 version - no calendar-for-loop macro - and changed scroll from by one month to by one year. This version show entire calendar for current year. Going backwards which < and forwards > by one year. It doesn't show on full screen, but half screen, which make it easy to use when working which vertical splits and it's more like extended version of build in calendar.
;; https://stackoverflow.com/questions/9547912/emacs-calendar-show-more-than-3-months
(defun farynaio/year-calendar (&optional year)
"Generate a one year calendar that can be scrolled by year in each direction.
This is a modification of: http://homepage3.nifty.com/oatu/emacs/calendar.html
See also: https://stackoverflow.com/questions/9547912/emacs-calendar-show-more-than-3-months"
(interactive)
(require 'calendar)
(let* (
(current-year (number-to-string (nth 5 (decode-time (current-time)))))
(month 0)
(year (if year year (string-to-number (format-time-string "%Y" (current-time))))))
(switch-to-buffer (get-buffer-create calendar-buffer))
(when (not (eq major-mode 'calendar-mode))
(calendar-mode))
(setq displayed-month month)
(setq displayed-year year)
(setq buffer-read-only nil)
(erase-buffer)
;; horizontal rows
(dotimes (j 4)
;; vertical columns
(dotimes (i 3)
(calendar-generate-month
(setq month (+ month 1))
year
;; indentation / spacing between months
(+ 5 (* 25 i))))
(goto-char (point-max))
(insert (make-string (- 10 (count-lines (point-min) (point-max))) ?\n))
(widen)
(goto-char (point-max))
(narrow-to-region (point-max) (point-max)))
(widen)
(goto-char (point-min))
(setq buffer-read-only t)))
(defun farynaio/scroll-year-calendar-forward (&optional arg event)
"Scroll the yearly calendar by year in a forward direction."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(unless arg (setq arg 0))
(save-selected-window
(if (setq event (event-start event)) (select-window (posn-window event)))
(unless (zerop arg)
(let* (
(year (+ displayed-year arg)))
(jarfar/year-calendar year)))
(goto-char (point-min))
(run-hooks 'calendar-move-hook)))
(defun farynaio/scroll-year-calendar-backward (&optional arg event)
"Scroll the yearly calendar by year in a backward direction."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(farynaio/scroll-year-calendar-forward (- (or arg 1)) event))
(define-key calendar-mode-map "<" 'farynaio/scroll-year-calendar-backward)
(define-key calendar-mode-map ">" 'farynaio/scroll-year-calendar-forward)
(defalias 'year-calendar 'farynaio/year-calendar)
It's not easy to do this, the code to generate calendar is:
(defun calendar-generate (month year)
"Generate a three-month Gregorian calendar centered around MONTH, YEAR."
;; A negative YEAR is interpreted as BC; -1 being 1 BC, and so on.
;; Note that while calendars for years BC could be displayed as it
;; stands, almost all other calendar functions (eg holidays) would
;; at best have unpredictable results for such dates.
(if (< (+ month (* 12 (1- year))) 2)
(error "Months before January, 1 AD cannot be displayed"))
(setq displayed-month month
displayed-year year)
(erase-buffer)
(calendar-increment-month month year -1)
(dotimes (i 3)
(calendar-generate-month month year
(+ calendar-left-margin
(* calendar-month-width i)))
(calendar-increment-month month year 1)))
Here, (dotimes (i 3) ...) generate 3 months in a row.
So if you want to generate more than 3 months in more than 1 row, you must override calendar-generate function by yourself, same as #Luke said.