13053
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
1 ;;; cal-move.el --- calendar functions for movement in the calendar
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
2
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
4
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
6 ;; Keywords: calendar
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
7 ;; Human-Keywords: calendar
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
8
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
9 ;; This file is part of GNU Emacs.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
10
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
12 ;; it under the terms of the GNU General Public License as published by
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
14 ;; any later version.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
15
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
16 ;; GNU Emacs is distributed in the hope that it will be useful,
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
19 ;; GNU General Public License for more details.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
20
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
21 ;; You should have received a copy of the GNU General Public License
|
14169
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
24 ;; Boston, MA 02111-1307, USA.
|
13053
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
25
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
26 ;;; Commentary:
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
27
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
28 ;; This collection of functions implements movement in the calendar for
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
29 ;; calendar.el.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
30
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
31 ;; Comments, corrections, and improvements should be sent to
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
32 ;; Edward M. Reingold Department of Computer Science
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
33 ;; (217) 333-6733 University of Illinois at Urbana-Champaign
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
34 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
35 ;; Urbana, Illinois 61801
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
36
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
37 ;;; Code:
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
38
|
19892
|
39 (require 'calendar)
|
|
40
|
13053
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
41 (defun calendar-goto-today ()
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
42 "Reposition the calendar window so the current date is visible."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
43 (interactive)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
44 (let ((today (calendar-current-date)));; The date might have changed.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
45 (if (not (calendar-date-is-visible-p today))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
46 (generate-calendar-window)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
47 (update-calendar-mode-line)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
48 (calendar-cursor-to-visible-date today))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
49
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
50 (defun calendar-forward-month (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
51 "Move the cursor forward ARG months.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
52 Movement is backward if ARG is negative."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
53 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
54 (calendar-cursor-to-nearest-date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
55 (let* ((cursor-date (calendar-cursor-to-date t))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
56 (month (extract-calendar-month cursor-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
57 (day (extract-calendar-day cursor-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
58 (year (extract-calendar-year cursor-date)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
59 (increment-calendar-month month year arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
60 (let ((last (calendar-last-day-of-month month year)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
61 (if (< last day)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
62 (setq day last)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
63 ;; Put the new month on the screen, if needed, and go to the new date.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
64 (let ((new-cursor-date (list month day year)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
65 (if (not (calendar-date-is-visible-p new-cursor-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
66 (calendar-other-month month year))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
67 (calendar-cursor-to-visible-date new-cursor-date))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
68
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
69 (defun calendar-forward-year (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
70 "Move the cursor forward by ARG years.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
71 Movement is backward if ARG is negative."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
72 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
73 (calendar-forward-month (* 12 arg)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
74
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
75 (defun calendar-backward-month (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
76 "Move the cursor backward by ARG months.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
77 Movement is forward if ARG is negative."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
78 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
79 (calendar-forward-month (- arg)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
80
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
81 (defun calendar-backward-year (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
82 "Move the cursor backward ARG years.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
83 Movement is forward is ARG is negative."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
84 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
85 (calendar-forward-month (* -12 arg)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
86
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
87 (defun scroll-calendar-left (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
88 "Scroll the displayed calendar left by ARG months.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
89 If ARG is negative the calendar is scrolled right. Maintains the relative
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
90 position of the cursor with respect to the calendar as well as possible."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
91 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
92 (calendar-cursor-to-nearest-date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
93 (let ((old-date (calendar-cursor-to-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
94 (today (calendar-current-date)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
95 (if (/= arg 0)
|
24337
|
96 (let ((month displayed-month)
|
|
97 (year displayed-year))
|
|
98 (increment-calendar-month month year arg)
|
|
99 (generate-calendar-window month year)
|
13053
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
100 (calendar-cursor-to-visible-date
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
101 (cond
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
102 ((calendar-date-is-visible-p old-date) old-date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
103 ((calendar-date-is-visible-p today) today)
|
24337
|
104 (t (list month 1 year))))))))
|
13053
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
105
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
106 (defun scroll-calendar-right (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
107 "Scroll the displayed calendar window right by ARG months.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
108 If ARG is negative the calendar is scrolled left. Maintains the relative
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
109 position of the cursor with respect to the calendar as well as possible."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
110 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
111 (scroll-calendar-left (- arg)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
112
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
113 (defun scroll-calendar-left-three-months (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
114 "Scroll the displayed calendar window left by 3*ARG months.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
115 If ARG is negative the calendar is scrolled right. Maintains the relative
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
116 position of the cursor with respect to the calendar as well as possible."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
117 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
118 (scroll-calendar-left (* 3 arg)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
119
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
120 (defun scroll-calendar-right-three-months (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
121 "Scroll the displayed calendar window right by 3*ARG months.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
122 If ARG is negative the calendar is scrolled left. Maintains the relative
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
123 position of the cursor with respect to the calendar as well as possible."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
124 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
125 (scroll-calendar-left (* -3 arg)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
126
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
127 (defun calendar-cursor-to-nearest-date ()
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
128 "Move the cursor to the closest date.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
129 The position of the cursor is unchanged if it is already on a date.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
130 Returns the list (month day year) giving the cursor position."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
131 (let ((date (calendar-cursor-to-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
132 (column (current-column)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
133 (if date
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
134 date
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
135 (if (> 3 (count-lines (point-min) (point)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
136 (progn
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
137 (goto-line 3)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
138 (move-to-column column)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
139 (if (not (looking-at "[0-9]"))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
140 (if (and (not (looking-at " *$"))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
141 (or (< column 25)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
142 (and (> column 27)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
143 (< column 50))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
144 (and (> column 52)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
145 (< column 75))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
146 (progn
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
147 (re-search-forward "[0-9]" nil t)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
148 (backward-char 1))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
149 (re-search-backward "[0-9]" nil t)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
150 (calendar-cursor-to-date))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
151
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
152 (defun calendar-forward-day (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
153 "Move the cursor forward ARG days.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
154 Moves backward if ARG is negative."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
155 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
156 (if (/= 0 arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
157 (let*
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
158 ((cursor-date (calendar-cursor-to-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
159 (cursor-date (if cursor-date
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
160 cursor-date
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
161 (if (> arg 0) (setq arg (1- arg)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
162 (calendar-cursor-to-nearest-date)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
163 (new-cursor-date
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
164 (calendar-gregorian-from-absolute
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
165 (+ (calendar-absolute-from-gregorian cursor-date) arg)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
166 (new-display-month (extract-calendar-month new-cursor-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
167 (new-display-year (extract-calendar-year new-cursor-date)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
168 ;; Put the new month on the screen, if needed, and go to the new date.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
169 (if (not (calendar-date-is-visible-p new-cursor-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
170 (calendar-other-month new-display-month new-display-year))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
171 (calendar-cursor-to-visible-date new-cursor-date))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
172
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
173 (defun calendar-backward-day (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
174 "Move the cursor back ARG days.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
175 Moves forward if ARG is negative."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
176 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
177 (calendar-forward-day (- arg)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
178
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
179 (defun calendar-forward-week (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
180 "Move the cursor forward ARG weeks.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
181 Moves backward if ARG is negative."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
182 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
183 (calendar-forward-day (* arg 7)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
184
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
185 (defun calendar-backward-week (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
186 "Move the cursor back ARG weeks.
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
187 Moves forward if ARG is negative."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
188 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
189 (calendar-forward-day (* arg -7)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
190
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
191 (defun calendar-beginning-of-week (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
192 "Move the cursor back ARG calendar-week-start-day's."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
193 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
194 (calendar-cursor-to-nearest-date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
195 (let ((day (calendar-day-of-week (calendar-cursor-to-date))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
196 (calendar-backward-day
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
197 (if (= day calendar-week-start-day)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
198 (* 7 arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
199 (+ (mod (- day calendar-week-start-day) 7)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
200 (* 7 (1- arg)))))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
201
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
202 (defun calendar-end-of-week (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
203 "Move the cursor forward ARG calendar-week-start-day+6's."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
204 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
205 (calendar-cursor-to-nearest-date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
206 (let ((day (calendar-day-of-week (calendar-cursor-to-date))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
207 (calendar-forward-day
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
208 (if (= day (mod (1- calendar-week-start-day) 7))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
209 (* 7 arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
210 (+ (- 6 (mod (- day calendar-week-start-day) 7))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
211 (* 7 (1- arg)))))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
212
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
213 (defun calendar-beginning-of-month (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
214 "Move the cursor backward ARG month beginnings."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
215 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
216 (calendar-cursor-to-nearest-date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
217 (let* ((date (calendar-cursor-to-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
218 (month (extract-calendar-month date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
219 (day (extract-calendar-day date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
220 (year (extract-calendar-year date)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
221 (if (= day 1)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
222 (calendar-backward-month arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
223 (calendar-cursor-to-visible-date (list month 1 year))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
224 (calendar-backward-month (1- arg)))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
225
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
226 (defun calendar-end-of-month (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
227 "Move the cursor forward ARG month ends."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
228 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
229 (calendar-cursor-to-nearest-date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
230 (let* ((date (calendar-cursor-to-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
231 (month (extract-calendar-month date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
232 (day (extract-calendar-day date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
233 (year (extract-calendar-year date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
234 (last-day (calendar-last-day-of-month month year)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
235 (if (/= day last-day)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
236 (progn
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
237 (calendar-cursor-to-visible-date (list month last-day year))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
238 (setq arg (1- arg))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
239 (increment-calendar-month month year arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
240 (let ((last-day (list
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
241 month
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
242 (calendar-last-day-of-month month year)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
243 year)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
244 (if (not (calendar-date-is-visible-p last-day))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
245 (calendar-other-month month year)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
246 (calendar-cursor-to-visible-date last-day)))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
247
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
248 (defun calendar-beginning-of-year (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
249 "Move the cursor backward ARG year beginnings."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
250 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
251 (calendar-cursor-to-nearest-date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
252 (let* ((date (calendar-cursor-to-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
253 (month (extract-calendar-month date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
254 (day (extract-calendar-day date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
255 (year (extract-calendar-year date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
256 (jan-first (list 1 1 year)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
257 (if (and (= day 1) (= 1 month))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
258 (calendar-backward-month (* 12 arg))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
259 (if (and (= arg 1)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
260 (calendar-date-is-visible-p jan-first))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
261 (calendar-cursor-to-visible-date jan-first)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
262 (calendar-other-month 1 (- year (1- arg)))))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
263
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
264 (defun calendar-end-of-year (arg)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
265 "Move the cursor forward ARG year beginnings."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
266 (interactive "p")
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
267 (calendar-cursor-to-nearest-date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
268 (let* ((date (calendar-cursor-to-date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
269 (month (extract-calendar-month date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
270 (day (extract-calendar-day date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
271 (year (extract-calendar-year date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
272 (dec-31 (list 12 31 year)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
273 (if (and (= day 31) (= 12 month))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
274 (calendar-forward-month (* 12 arg))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
275 (if (and (= arg 1)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
276 (calendar-date-is-visible-p dec-31))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
277 (calendar-cursor-to-visible-date dec-31)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
278 (calendar-other-month 12 (- year (1- arg)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
279 (calendar-cursor-to-visible-date (list 12 31 displayed-year))))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
280
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
281 (defun calendar-cursor-to-visible-date (date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
282 "Move the cursor to DATE that is on the screen."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
283 (let* ((month (extract-calendar-month date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
284 (day (extract-calendar-day date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
285 (year (extract-calendar-year date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
286 (first-of-month-weekday (calendar-day-of-week (list month 1 year))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
287 (goto-line (+ 3
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
288 (/ (+ day -1
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
289 (mod
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
290 (- (calendar-day-of-week (list month 1 year))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
291 calendar-week-start-day)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
292 7))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
293 7)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
294 (move-to-column (+ 6
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
295 (* 25
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
296 (1+ (calendar-interval
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
297 displayed-month displayed-year month year)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
298 (* 3 (mod
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
299 (- (calendar-day-of-week date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
300 calendar-week-start-day)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
301 7))))))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
302
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
303 (defun calendar-goto-date (date)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
304 "Move cursor to DATE."
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
305 (interactive (list (calendar-read-date)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
306 (let ((month (extract-calendar-month date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
307 (year (extract-calendar-year date)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
308 (if (not (calendar-date-is-visible-p date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
309 (calendar-other-month
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
310 (if (and (= month 1) (= year 1))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
311 2
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
312 month)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
313 year)))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
314 (calendar-cursor-to-visible-date date))
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
315
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
316 (provide 'cal-move)
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
317
|
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
diff
changeset
|
318 ;;; cal-move.el ends here
|