Mercurial > emacs
annotate lisp/calendar/cal-move.el @ 50507:110c0e29159c
Handle multiple desktop files in different dirs.
Other cleanups.
Command line option --no-desktop introduced.
(desktop-read): Record buffers in the desktop file in
the same order as that in the buffer list,
(desktop-save): Put buffers in the order given in desktop file,
regardless of what handlers do.
(desktop-file-version): New variable. Version number of desktop
file format.
(desktop-create-buffer-form): Variable deleted.
(desktop-save): New customizable variable.
(desktop-kill): Changed to use `desktop-save'.
(desktop-file-name-format): New option: format in
which desktop file names should be saved.
(desktop-file-name): New function to convert a filename to the
format specified in `desktop-file-name-format'.
(desktop-create-buffer): Parameters renamed to descriptive
systematic names. These parameters are visible to handlers.
Renames:
ver -> desktop-file-version
mim -> desktop-buffer-minor-modes
pt -> desktop-buffer-point
mk -> desktop-buffer-mark
ro -> desktop-buffer-read-only
locals -> desktop-buffer-locals
(desktop-buffer-major-mode, desktop-buffer-file-name)
(desktop-buffer-name): Unused customizable variables deleted.
(desktop-buffer-misc): Unused variable deleted.
(desktop-save, desktop-buffer-dired-misc-data):
Use `desktop-file-name'.
(desktop-path): New customizable variable. List of directories in
which to lookup the desktop file. Replaces hardcoded list.
(desktop-globals-to-clear): New variable replaces hardcoded list.
(desktop-clear-preserve-buffers-regexp): New customizable variable.
(desktop-after-read-hook): New hook run after a desktop is read.
(desktop-no-desktop-file-hook): New hook when no desktop file found.
(desktop-change-dir): New function.
(desktop-save-in-load-dir): New function. Save desktop in
directory from witch it was loaded.
(desktop-revert): New function. Revert to the last loaded desktop.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 09 Apr 2003 01:37:56 +0000 |
parents | 4560c1d5e629 |
children | e7d0572ccca5 d7ddb3e565de |
rev | line source |
---|---|
13053 | 1 ;;; cal-move.el --- calendar functions for movement in the calendar |
2 | |
3 ;; Copyright (C) 1995 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | |
6 ;; Keywords: calendar | |
7 ;; Human-Keywords: calendar | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
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 | 25 |
26 ;;; Commentary: | |
27 | |
28 ;; This collection of functions implements movement in the calendar for | |
29 ;; calendar.el. | |
30 | |
31 ;; Comments, corrections, and improvements should be sent to | |
32 ;; Edward M. Reingold Department of Computer Science | |
33 ;; (217) 333-6733 University of Illinois at Urbana-Champaign | |
34 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue | |
35 ;; Urbana, Illinois 61801 | |
36 | |
37 ;;; Code: | |
38 | |
19892 | 39 (require 'calendar) |
40 | |
13053 | 41 (defun calendar-goto-today () |
42 "Reposition the calendar window so the current date is visible." | |
43 (interactive) | |
44 (let ((today (calendar-current-date)));; The date might have changed. | |
45 (if (not (calendar-date-is-visible-p today)) | |
46 (generate-calendar-window) | |
47 (update-calendar-mode-line) | |
25411
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
48 (calendar-cursor-to-visible-date today))) |
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
49 (run-hooks 'calendar-move-hook)) |
13053 | 50 |
51 (defun calendar-forward-month (arg) | |
52 "Move the cursor forward ARG months. | |
53 Movement is backward if ARG is negative." | |
54 (interactive "p") | |
55 (calendar-cursor-to-nearest-date) | |
56 (let* ((cursor-date (calendar-cursor-to-date t)) | |
57 (month (extract-calendar-month cursor-date)) | |
58 (day (extract-calendar-day cursor-date)) | |
59 (year (extract-calendar-year cursor-date))) | |
60 (increment-calendar-month month year arg) | |
61 (let ((last (calendar-last-day-of-month month year))) | |
62 (if (< last day) | |
63 (setq day last))) | |
64 ;; Put the new month on the screen, if needed, and go to the new date. | |
65 (let ((new-cursor-date (list month day year))) | |
66 (if (not (calendar-date-is-visible-p new-cursor-date)) | |
67 (calendar-other-month month year)) | |
25411
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
68 (calendar-cursor-to-visible-date new-cursor-date))) |
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
69 (run-hooks 'calendar-move-hook)) |
13053 | 70 |
71 (defun calendar-forward-year (arg) | |
72 "Move the cursor forward by ARG years. | |
73 Movement is backward if ARG is negative." | |
74 (interactive "p") | |
75 (calendar-forward-month (* 12 arg))) | |
76 | |
77 (defun calendar-backward-month (arg) | |
78 "Move the cursor backward by ARG months. | |
79 Movement is forward if ARG is negative." | |
80 (interactive "p") | |
81 (calendar-forward-month (- arg))) | |
82 | |
83 (defun calendar-backward-year (arg) | |
84 "Move the cursor backward ARG years. | |
85 Movement is forward is ARG is negative." | |
86 (interactive "p") | |
87 (calendar-forward-month (* -12 arg))) | |
88 | |
31670 | 89 (defun scroll-calendar-left (&optional arg) |
13053 | 90 "Scroll the displayed calendar left by ARG months. |
91 If ARG is negative the calendar is scrolled right. Maintains the relative | |
92 position of the cursor with respect to the calendar as well as possible." | |
93 (interactive "p") | |
31670 | 94 (unless arg (setq arg 1)) |
13053 | 95 (calendar-cursor-to-nearest-date) |
96 (let ((old-date (calendar-cursor-to-date)) | |
97 (today (calendar-current-date))) | |
98 (if (/= arg 0) | |
24337
d9aef2d7c503
(scroll-calendar-left): Don't set
Andreas Schwab <schwab@suse.de>
parents:
19892
diff
changeset
|
99 (let ((month displayed-month) |
d9aef2d7c503
(scroll-calendar-left): Don't set
Andreas Schwab <schwab@suse.de>
parents:
19892
diff
changeset
|
100 (year displayed-year)) |
d9aef2d7c503
(scroll-calendar-left): Don't set
Andreas Schwab <schwab@suse.de>
parents:
19892
diff
changeset
|
101 (increment-calendar-month month year arg) |
d9aef2d7c503
(scroll-calendar-left): Don't set
Andreas Schwab <schwab@suse.de>
parents:
19892
diff
changeset
|
102 (generate-calendar-window month year) |
13053 | 103 (calendar-cursor-to-visible-date |
104 (cond | |
105 ((calendar-date-is-visible-p old-date) old-date) | |
106 ((calendar-date-is-visible-p today) today) | |
25411
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
107 (t (list month 1 year))))))) |
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
108 (run-hooks 'calendar-move-hook)) |
13053 | 109 |
31670 | 110 (defun scroll-calendar-right (&optional arg) |
13053 | 111 "Scroll the displayed calendar window right by ARG months. |
112 If ARG is negative the calendar is scrolled left. Maintains the relative | |
113 position of the cursor with respect to the calendar as well as possible." | |
114 (interactive "p") | |
31670 | 115 (scroll-calendar-left (- (or arg 1)))) |
13053 | 116 |
117 (defun scroll-calendar-left-three-months (arg) | |
118 "Scroll the displayed calendar window left by 3*ARG months. | |
119 If ARG is negative the calendar is scrolled right. Maintains the relative | |
120 position of the cursor with respect to the calendar as well as possible." | |
121 (interactive "p") | |
122 (scroll-calendar-left (* 3 arg))) | |
123 | |
124 (defun scroll-calendar-right-three-months (arg) | |
125 "Scroll the displayed calendar window right by 3*ARG months. | |
126 If ARG is negative the calendar is scrolled left. Maintains the relative | |
127 position of the cursor with respect to the calendar as well as possible." | |
128 (interactive "p") | |
129 (scroll-calendar-left (* -3 arg))) | |
130 | |
131 (defun calendar-cursor-to-nearest-date () | |
132 "Move the cursor to the closest date. | |
133 The position of the cursor is unchanged if it is already on a date. | |
134 Returns the list (month day year) giving the cursor position." | |
135 (let ((date (calendar-cursor-to-date)) | |
136 (column (current-column))) | |
137 (if date | |
138 date | |
139 (if (> 3 (count-lines (point-min) (point))) | |
140 (progn | |
141 (goto-line 3) | |
142 (move-to-column column))) | |
143 (if (not (looking-at "[0-9]")) | |
144 (if (and (not (looking-at " *$")) | |
145 (or (< column 25) | |
146 (and (> column 27) | |
147 (< column 50)) | |
148 (and (> column 52) | |
149 (< column 75)))) | |
150 (progn | |
151 (re-search-forward "[0-9]" nil t) | |
152 (backward-char 1)) | |
153 (re-search-backward "[0-9]" nil t))) | |
154 (calendar-cursor-to-date)))) | |
155 | |
156 (defun calendar-forward-day (arg) | |
157 "Move the cursor forward ARG days. | |
158 Moves backward if ARG is negative." | |
159 (interactive "p") | |
160 (if (/= 0 arg) | |
161 (let* | |
162 ((cursor-date (calendar-cursor-to-date)) | |
163 (cursor-date (if cursor-date | |
164 cursor-date | |
165 (if (> arg 0) (setq arg (1- arg))) | |
166 (calendar-cursor-to-nearest-date))) | |
167 (new-cursor-date | |
168 (calendar-gregorian-from-absolute | |
169 (+ (calendar-absolute-from-gregorian cursor-date) arg))) | |
170 (new-display-month (extract-calendar-month new-cursor-date)) | |
171 (new-display-year (extract-calendar-year new-cursor-date))) | |
172 ;; Put the new month on the screen, if needed, and go to the new date. | |
173 (if (not (calendar-date-is-visible-p new-cursor-date)) | |
174 (calendar-other-month new-display-month new-display-year)) | |
25411
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
175 (calendar-cursor-to-visible-date new-cursor-date))) |
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
176 (run-hooks 'calendar-move-hook)) |
13053 | 177 |
178 (defun calendar-backward-day (arg) | |
179 "Move the cursor back ARG days. | |
180 Moves forward if ARG is negative." | |
181 (interactive "p") | |
182 (calendar-forward-day (- arg))) | |
183 | |
184 (defun calendar-forward-week (arg) | |
185 "Move the cursor forward ARG weeks. | |
186 Moves backward if ARG is negative." | |
187 (interactive "p") | |
188 (calendar-forward-day (* arg 7))) | |
189 | |
190 (defun calendar-backward-week (arg) | |
191 "Move the cursor back ARG weeks. | |
192 Moves forward if ARG is negative." | |
193 (interactive "p") | |
194 (calendar-forward-day (* arg -7))) | |
195 | |
196 (defun calendar-beginning-of-week (arg) | |
197 "Move the cursor back ARG calendar-week-start-day's." | |
198 (interactive "p") | |
199 (calendar-cursor-to-nearest-date) | |
200 (let ((day (calendar-day-of-week (calendar-cursor-to-date)))) | |
201 (calendar-backward-day | |
202 (if (= day calendar-week-start-day) | |
203 (* 7 arg) | |
204 (+ (mod (- day calendar-week-start-day) 7) | |
205 (* 7 (1- arg))))))) | |
206 | |
207 (defun calendar-end-of-week (arg) | |
208 "Move the cursor forward ARG calendar-week-start-day+6's." | |
209 (interactive "p") | |
210 (calendar-cursor-to-nearest-date) | |
211 (let ((day (calendar-day-of-week (calendar-cursor-to-date)))) | |
212 (calendar-forward-day | |
213 (if (= day (mod (1- calendar-week-start-day) 7)) | |
214 (* 7 arg) | |
215 (+ (- 6 (mod (- day calendar-week-start-day) 7)) | |
216 (* 7 (1- arg))))))) | |
217 | |
218 (defun calendar-beginning-of-month (arg) | |
219 "Move the cursor backward ARG month beginnings." | |
220 (interactive "p") | |
221 (calendar-cursor-to-nearest-date) | |
222 (let* ((date (calendar-cursor-to-date)) | |
223 (month (extract-calendar-month date)) | |
224 (day (extract-calendar-day date)) | |
225 (year (extract-calendar-year date))) | |
226 (if (= day 1) | |
227 (calendar-backward-month arg) | |
228 (calendar-cursor-to-visible-date (list month 1 year)) | |
229 (calendar-backward-month (1- arg))))) | |
230 | |
231 (defun calendar-end-of-month (arg) | |
232 "Move the cursor forward ARG month ends." | |
233 (interactive "p") | |
234 (calendar-cursor-to-nearest-date) | |
235 (let* ((date (calendar-cursor-to-date)) | |
236 (month (extract-calendar-month date)) | |
237 (day (extract-calendar-day date)) | |
238 (year (extract-calendar-year date)) | |
239 (last-day (calendar-last-day-of-month month year))) | |
240 (if (/= day last-day) | |
241 (progn | |
242 (calendar-cursor-to-visible-date (list month last-day year)) | |
243 (setq arg (1- arg)))) | |
244 (increment-calendar-month month year arg) | |
245 (let ((last-day (list | |
246 month | |
247 (calendar-last-day-of-month month year) | |
248 year))) | |
249 (if (not (calendar-date-is-visible-p last-day)) | |
250 (calendar-other-month month year) | |
25411
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
251 (calendar-cursor-to-visible-date last-day)))) |
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
252 (run-hooks 'calendar-move-hook)) |
13053 | 253 |
254 (defun calendar-beginning-of-year (arg) | |
255 "Move the cursor backward ARG year beginnings." | |
256 (interactive "p") | |
257 (calendar-cursor-to-nearest-date) | |
258 (let* ((date (calendar-cursor-to-date)) | |
259 (month (extract-calendar-month date)) | |
260 (day (extract-calendar-day date)) | |
261 (year (extract-calendar-year date)) | |
25411
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
262 (jan-first (list 1 1 year)) |
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
263 (calendar-move-hook nil)) |
13053 | 264 (if (and (= day 1) (= 1 month)) |
265 (calendar-backward-month (* 12 arg)) | |
266 (if (and (= arg 1) | |
267 (calendar-date-is-visible-p jan-first)) | |
268 (calendar-cursor-to-visible-date jan-first) | |
25411
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
269 (calendar-other-month 1 (- year (1- arg)))))) |
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
270 (run-hooks 'calendar-move-hook)) |
13053 | 271 |
272 (defun calendar-end-of-year (arg) | |
273 "Move the cursor forward ARG year beginnings." | |
274 (interactive "p") | |
275 (calendar-cursor-to-nearest-date) | |
276 (let* ((date (calendar-cursor-to-date)) | |
277 (month (extract-calendar-month date)) | |
278 (day (extract-calendar-day date)) | |
279 (year (extract-calendar-year date)) | |
25411
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
280 (dec-31 (list 12 31 year)) |
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
281 (calendar-move-hook nil)) |
13053 | 282 (if (and (= day 31) (= 12 month)) |
283 (calendar-forward-month (* 12 arg)) | |
284 (if (and (= arg 1) | |
285 (calendar-date-is-visible-p dec-31)) | |
286 (calendar-cursor-to-visible-date dec-31) | |
287 (calendar-other-month 12 (- year (1- arg))) | |
25411
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
288 (calendar-cursor-to-visible-date (list 12 31 displayed-year))))) |
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
289 (run-hooks 'calendar-move-hook)) |
13053 | 290 |
291 (defun calendar-cursor-to-visible-date (date) | |
292 "Move the cursor to DATE that is on the screen." | |
293 (let* ((month (extract-calendar-month date)) | |
294 (day (extract-calendar-day date)) | |
295 (year (extract-calendar-year date)) | |
296 (first-of-month-weekday (calendar-day-of-week (list month 1 year)))) | |
297 (goto-line (+ 3 | |
298 (/ (+ day -1 | |
299 (mod | |
300 (- (calendar-day-of-week (list month 1 year)) | |
301 calendar-week-start-day) | |
302 7)) | |
303 7))) | |
304 (move-to-column (+ 6 | |
305 (* 25 | |
306 (1+ (calendar-interval | |
307 displayed-month displayed-year month year))) | |
308 (* 3 (mod | |
309 (- (calendar-day-of-week date) | |
310 calendar-week-start-day) | |
311 7)))))) | |
312 | |
313 (defun calendar-goto-date (date) | |
314 "Move cursor to DATE." | |
315 (interactive (list (calendar-read-date))) | |
316 (let ((month (extract-calendar-month date)) | |
317 (year (extract-calendar-year date))) | |
318 (if (not (calendar-date-is-visible-p date)) | |
319 (calendar-other-month | |
320 (if (and (= month 1) (= year 1)) | |
321 2 | |
322 month) | |
323 year))) | |
25411
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
324 (calendar-cursor-to-visible-date date) |
0d68ae69cd8c
Call the new hook in every movement function.
Richard M. Stallman <rms@gnu.org>
parents:
24337
diff
changeset
|
325 (run-hooks 'calendar-move-hook)) |
13053 | 326 |
327 (provide 'cal-move) | |
328 | |
329 ;;; cal-move.el ends here |