[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v
From: |
Glenn Morris |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v |
Date: |
Sat, 15 Mar 2008 03:00:19 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Glenn Morris <gm> 08/03/15 03:00:18
Index: calendar.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calendar/calendar.el,v
retrieving revision 1.224
retrieving revision 1.225
diff -u -b -r1.224 -r1.225
--- calendar.el 14 Mar 2008 07:45:41 -0000 1.224
+++ calendar.el 15 Mar 2008 03:00:17 -0000 1.225
@@ -91,6 +91,24 @@
;; address@hidden with the SUBJECT "send-paper-cal" (no quotes) and
;; the message BODY containing your mailing address (snail).
+
+;; A note on free variables:
+
+;; The calendar passes around a few dynamically bound variables, which
+;; unfortunately have rather common names. They are meant to be
+;; available for external functions, so the names can't be changed.
+
+;; displayed-month, displayed-year: bound in generate-calendar, the
+;; central month of the 3 month calendar window
+;; original-date, number: bound in diary-list-entries, the arguments
+;; with which that function was called.
+;; date, entry: bound in list-sexp-diary-entries (qv)
+
+;; Bound in diary-list-entries:
+;; diary-entries-list: use in d-l, appt.el, and by add-to-diary-list
+;; diary-saved-point: only used in diary-lib.el, passed to the display func
+;; date-string: only used in diary-lib.el FIXME could be removed?
+
;;; Code:
;; (elisp) Eval During Compile: "Effectively `require' is
@@ -457,9 +475,9 @@
;;;###autoload
(defcustom european-calendar-style nil
"Use the European style of dates in the diary and in any displays.
-If this variable is t, a date 1/2/1990 would be interpreted as February 1,
-1990. The default European date styles (see `european-date-diary-pattern')
-are
+If this variable is non-nil, a date 1/2/1990 would be interpreted as
+February 1, 1990. The default European date styles (see
+`european-date-diary-pattern') are
DAY/MONTH
DAY/MONTH/YEAR
@@ -746,17 +764,16 @@
(if all-hebrew-calendar-holidays
(holiday-julian
11
- (let* ((m displayed-month)
+ (let ((m displayed-month)
(y displayed-year)
- (year))
+ year)
(increment-calendar-month m y -1)
- (let ((year (extract-calendar-year
+ (setq year (extract-calendar-year
(calendar-julian-from-absolute
- (calendar-absolute-from-gregorian
- (list m 1 y))))))
+ (calendar-absolute-from-gregorian (list m 1 y)))))
(if (zerop (% (1+ year) 4))
22
- 21))) "\"Tal Umatar\" (evening)")))
+ 21)) "\"Tal Umatar\" (evening)")))
"Component of the default value of `hebrew-holidays'.")
;;;###autoload
(put 'hebrew-holidays-1 'risky-local-variable t)
@@ -773,9 +790,8 @@
(calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian
(list displayed-month 28 displayed-year))))))
- (if (= (% (calendar-absolute-from-hebrew (list 10 10 h-year))
- 7)
- 6)
+ (if (= 6 (% (calendar-absolute-from-hebrew (list 10 10 h-year))
+ 7))
11 10))
"Tzom Teveth"))
(if all-hebrew-calendar-holidays
@@ -800,11 +816,10 @@
y)))))
(s-s
(calendar-hebrew-from-absolute
- (if (=
+ (if (= 6
(% (calendar-absolute-from-hebrew
(list 7 1 h-year))
- 7)
- 6)
+ 7))
(calendar-dayname-on-or-before
6 (calendar-absolute-from-hebrew
(list 11 17 h-year)))
@@ -822,15 +837,15 @@
(defvar hebrew-holidays-4
'((holiday-passover-etc)
(if (and all-hebrew-calendar-holidays
- (let* ((m displayed-month)
+ (let ((m displayed-month)
(y displayed-year)
- (year))
+ year)
(increment-calendar-month m y -1)
- (let ((year (extract-calendar-year
+ (setq year (extract-calendar-year
(calendar-julian-from-absolute
(calendar-absolute-from-gregorian
- (list m 1 y))))))
- (= 21 (% year 28)))))
+ (list m 1 y)))))
+ (= 21 (% year 28))))
(holiday-julian 3 26 "Kiddush HaHamah"))
(if all-hebrew-calendar-holidays
(holiday-tisha-b-av-etc)))
@@ -1191,20 +1206,20 @@
(defmacro 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."
+inclusive. The standard macro `dotimes' is preferable in most cases."
(declare (debug (symbolp "from" form "to" form "do" body)))
`(let ((,var (1- ,init)))
(while (>= ,final (setq ,var (1+ ,var)))
,@body)))
(defmacro calendar-sum (index initial condition expression)
- "For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION."
+ "For INDEX = INITIAL, +1, ... (as long as CONDITION holds), sum EXPRESSION."
(declare (debug (symbolp form form form)))
`(let ((,index ,initial)
(sum 0))
(while ,condition
- (setq sum (+ sum ,expression))
- (setq ,index (1+ ,index)))
+ (setq sum (+ sum ,expression)
+ ,index (1+ ,index)))
sum))
;; The following are in-line for speed; they can be called thousands of times
@@ -1242,11 +1257,11 @@
;; Note gives wrong answer for result of (calendar-read-date 'noday).
(defsubst extract-calendar-day (date)
"Extract the day part of DATE which has the form (month day year)."
- (car (cdr date)))
+ (cadr date))
(defsubst extract-calendar-year (date)
"Extract the year part of DATE which has the form (month day year)."
- (car (cdr (cdr date))))
+ (nth 2 date))
(defsubst calendar-leap-year-p (year)
"Return t if YEAR is a Gregorian leap year.
@@ -1283,11 +1298,10 @@
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(day-of-year (+ day (* 31 (1- month)))))
- (if (> month 2)
- (progn
+ (when (> month 2)
(setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
(if (calendar-leap-year-p year)
- (setq day-of-year (1+ day-of-year)))))
+ (setq day-of-year (1+ day-of-year))))
day-of-year))
(defsubst calendar-absolute-from-gregorian (date)
@@ -1378,8 +1392,7 @@
(calendar-mode)
(let* ((pop-up-windows t)
(split-height-threshold 1000)
- (date (if arg
- (calendar-read-date t)
+ (date (if arg (calendar-read-date t)
(calendar-current-date)))
(month (extract-calendar-month date))
(year (extract-calendar-year date)))
@@ -1465,7 +1478,7 @@
located, but indented INDENT spaces. The indentation is done from the first
character on the line and does not disturb the first INDENT characters on the
line."
- (let* ((blank-days ; at start of month
+ (let ((blank-days ; at start of month
(mod
(- (calendar-day-of-week (list month 1 year))
calendar-week-start-day)
@@ -1491,22 +1504,22 @@
;; Add blank days before the first of the month.
(dotimes (idummy blank-days) (insert " "))
;; Put in the days of the month.
- (calendar-for-loop i from 1 to last do
- (insert (format "%2d " i))
+ (dotimes (i last)
+ (insert (format "%2d " (1+ i)))
(add-text-properties
(- (point) 3) (1- (point))
'(mouse-face highlight
help-echo "mouse-2: menu of operations for this date"))
- (and (zerop (mod (+ i blank-days) 7))
- (/= i last)
+ (and (zerop (mod (+ i 1 blank-days) 7))
+ (/= i (1- last))
(calendar-insert-indented "" 0 t) ; force onto following line
(calendar-insert-indented "" indent))))) ; go to proper spot
(defun calendar-insert-indented (string indent &optional newline)
"Insert STRING at column INDENT.
-If the optional parameter NEWLINE is t, leave point at start of next line,
-inserting a newline if there was no next line; otherwise, leave point after
-the inserted text. Returns t."
+If the optional parameter NEWLINE is non-nil, leave point at start of next
+line, inserting a newline if there was no next line; otherwise, leave point
+after the inserted text. Returns t."
;; Try to move to that column.
(move-to-column indent)
;; If line is too short, indent out to that column.
@@ -1758,7 +1771,8 @@
:group 'calendar)
(defun mouse-calendar-other-month (event)
- "Display a three-month calendar centered around a specified month and year."
+ "Display a three-month calendar centered around a specified month and year.
+EVENT is the last mouse event."
(interactive "e")
(save-selected-window
(select-window (posn-window (event-start event)))
@@ -1864,7 +1878,7 @@
(defun exit-calendar ()
"Get out of the calendar window and hide it and related buffers."
(interactive)
- (let* ((diary-buffer (get-file-buffer diary-file)))
+ (let ((diary-buffer (get-file-buffer diary-file)))
(if (or (not diary-buffer)
(not (buffer-modified-p diary-buffer))
(yes-or-no-p
@@ -1902,7 +1916,7 @@
(defun calendar-cursor-to-date (&optional error)
"Return a list (month day year) of current cursor position.
If cursor is not on a specific date, signals an error if optional parameter
-ERROR is t, otherwise just returns nil."
+ERROR is non-nil, otherwise just returns nil."
(let* ((segment (/ (current-column) 25))
(month (% (+ displayed-month segment -1) 12))
(month (if (zerop month) 12 month))
@@ -2002,20 +2016,19 @@
With argument ARG, jump to mark, pop it, and put point at end of ring."
(interactive "P")
(let ((date (calendar-cursor-to-date t)))
- (if (null arg)
- (progn
+ (if arg
+ (if (null calendar-mark-ring)
+ (error "No mark set in this buffer")
+ (calendar-goto-date (car calendar-mark-ring))
+ (setq calendar-mark-ring
+ (cdr (nconc calendar-mark-ring (list date)))))
(push date calendar-mark-ring)
;; Since the top of the mark ring is the marked date in the
;; calendar, the mark ring in the calendar is one longer than
;; in other buffers to get the same effect.
(if (> (length calendar-mark-ring) (1+ mark-ring-max))
(setcdr (nthcdr mark-ring-max calendar-mark-ring) nil))
- (message "Mark set"))
- (if (null calendar-mark-ring)
- (error "No mark set in this buffer")
- (calendar-goto-date (car calendar-mark-ring))
- (setq calendar-mark-ring
- (cdr (nconc calendar-mark-ring (list date))))))))
+ (message "Mark set"))))
(defun calendar-exchange-point-and-mark ()
"Exchange the current cursor position with the marked date."
@@ -2096,6 +2109,34 @@
constructed as the first `calendar-abbrev-length' characters of the
corresponding full name.")
+(defun calendar-make-alist (sequence &optional start-index filter abbrevs)
+ "Make an assoc list corresponding to SEQUENCE.
+Each element of sequence will be associated with an integer, starting
+from 1, or from START-INDEX if that is non-nil. If a sequence ABBREVS
+is supplied, the function `calendar-abbrev-construct' is used to
+construct abbreviations corresponding to the elements in SEQUENCE.
+Each abbreviation is entered into the alist with the same
+association index as the full name it represents.
+If FILTER is provided, apply it to each key in the alist."
+ (let ((index 0)
+ (offset (or start-index 1))
+ (aseq (if abbrevs (calendar-abbrev-construct abbrevs sequence)))
+ (aseqp (if abbrevs (calendar-abbrev-construct abbrevs sequence
+ 'period)))
+ alist elem)
+ (dotimes (i (length sequence) (reverse alist))
+ (setq index (+ i offset)
+ elem (elt sequence i)
+ alist
+ (cons (cons (if filter (funcall filter elem) elem) index) alist))
+ (if aseq
+ (setq elem (elt aseq i)
+ alist (cons (cons (if filter (funcall filter elem) elem)
+ index) alist)))
+ (if aseqp
+ (setq elem (elt aseqp i)
+ alist (cons (cons (if filter (funcall filter elem) elem)
+ index) alist))))))
(defun calendar-read-date (&optional noday)
"Prompt for Gregorian date. Return a list (month day year).
@@ -2180,35 +2221,6 @@
calendar-day-name-array)
(if absolute date (calendar-day-of-week date))))
-(defun calendar-make-alist (sequence &optional start-index filter abbrevs)
- "Make an assoc list corresponding to SEQUENCE.
-Each element of sequence will be associated with an integer, starting
-from 1, or from START-INDEX if that is non-nil. If a sequence ABBREVS
-is supplied, the function `calendar-abbrev-construct' is used to
-construct abbreviations corresponding to the elements in SEQUENCE.
-Each abbreviation is entered into the alist with the same
-association index as the full name it represents.
-If FILTER is provided, apply it to each key in the alist."
- (let ((index 0)
- (offset (or start-index 1))
- (aseq (if abbrevs (calendar-abbrev-construct abbrevs sequence)))
- (aseqp (if abbrevs (calendar-abbrev-construct abbrevs sequence
- 'period)))
- alist elem)
- (dotimes (i (length sequence) (reverse alist))
- (setq index (+ i offset)
- elem (elt sequence i)
- alist
- (cons (cons (if filter (funcall filter elem) elem) index) alist))
- (if aseq
- (setq elem (elt aseq i)
- alist (cons (cons (if filter (funcall filter elem) elem)
- index) alist)))
- (if aseqp
- (setq elem (elt aseqp i)
- alist (cons (cons (if filter (funcall filter elem) elem)
- index) alist))))))
-
(defun calendar-month-name (month &optional abbrev)
"Return a string with the name of month number MONTH.
Months are numbered from one. Month names are taken from the
@@ -2354,9 +2366,7 @@
`calendar-month-abbrev-array' and `calendar-day-abbrev-array',
respectively. An optional parameter NODAYNAME, when t, omits the
name of the day of the week."
- (let* ((dayname
- (unless nodayname
- (calendar-day-name date abbreviate)))
+ (let* ((dayname (unless nodayname (calendar-day-name date abbreviate)))
(month (extract-calendar-month date))
(monthname (calendar-month-name month abbreviate))
(day (int-to-string (extract-calendar-day date)))
@@ -2418,7 +2428,7 @@
(defun calendar-print-other-dates ()
"Show dates on other calendars for date under the cursor."
(interactive)
- (let* ((date (calendar-cursor-to-date t)))
+ (let ((date (calendar-cursor-to-date t)))
(with-current-buffer (get-buffer-create other-calendars-buffer)
(let ((inhibit-read-only t)
(modified (buffer-modified-p)))
@@ -2473,7 +2483,7 @@
"Set mode line to STR, centered, surrounded by dashes."
(let* ((edges (window-edges))
;; As per doc of window-width, total visible mode-line length.
- (width (- (nth 2 edges) (nth 0 edges))))
+ (width (- (nth 2 edges) (car edges))))
(setq mode-line-format
(if buffer-file-name
`("-" mode-line-modified
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, (continued)
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/07
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/09
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/09
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Stefan Monnier, 2008/03/10
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/10
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/13
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/13
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/13
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/13
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/14
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v,
Glenn Morris <=
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/15
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/16
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/17
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/20
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/24
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/25
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/27
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/27
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/28
- [Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el,v, Glenn Morris, 2008/03/31