Mercurial > emacs

comparison lisp/calendar/cal-iso.el @ 57324:f51c087984a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Update copyright and maintainer. (calendar-iso-read-args): New function, for old interactive spec from calendar-goto-iso-date. (calendar-goto-iso-date): Use it. (calendar-goto-iso-week): New function. Suggested by Emilio C. Lopes <eclig@gmx.net>.
author Glenn Morris <rgm@gnu.org>
date Mon, 04 Oct 2004 23:42:37 +0000
parents 695cf19ef79e
children 7f7db25577d9 ff0e824afa37
comparison
equal deleted inserted replaced
57323:51f2d473391c 57324:f51c087984a0
1 ;;; cal-iso.el --- calendar functions for the ISO calendar 1 ;;; cal-iso.el --- calendar functions for the ISO calendar
2 2
3 ;; Copyright (C) 1995, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995, 1997, 2004 Free Software Foundation, Inc.
4 4
5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> 5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
6 ;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
6 ;; Keywords: calendar 7 ;; Keywords: calendar
7 ;; Human-Keywords: ISO calendar, calendar, diary 8 ;; Human-Keywords: ISO calendar, calendar, diary
8 9
9 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
10 11
94 "Show equivalent ISO date for the date under the cursor." 95 "Show equivalent ISO date for the date under the cursor."
95 (interactive) 96 (interactive)
96 (message "ISO date: %s" 97 (message "ISO date: %s"
97 (calendar-iso-date-string (calendar-cursor-to-date t)))) 98 (calendar-iso-date-string (calendar-cursor-to-date t))))
98 99
100 (defun calendar-iso-read-args (&optional dayflag)
101 "Interactively read the arguments for an iso date command."
102 (let* ((today (calendar-current-date))
103 (year (calendar-read
104 "ISO calendar year (>0): "
105 '(lambda (x) (> x 0))
106 (int-to-string (extract-calendar-year today))))
107 (no-weeks (extract-calendar-month
108 (calendar-iso-from-absolute
109 (1-
110 (calendar-dayname-on-or-before
111 1 (calendar-absolute-from-gregorian
112 (list 1 4 (1+ year))))))))
113 (week (calendar-read
114 (format "ISO calendar week (1-%d): " no-weeks)
115 '(lambda (x) (and (> x 0) (<= x no-weeks)))))
116 (day (if dayflag (calendar-read
117 "ISO day (1-7): "
118 '(lambda (x) (and (<= 1 x) (<= x 7))))
119 1)))
120 (list (list week day year))))
121
99 (defun calendar-goto-iso-date (date &optional noecho) 122 (defun calendar-goto-iso-date (date &optional noecho)
100 "Move cursor to ISO DATE; echo ISO date unless NOECHO is t." 123 "Move cursor to ISO DATE; echo ISO date unless NOECHO is t."
101 (interactive 124 (interactive (calendar-iso-read-args t))
102 (let* ((today (calendar-current-date)) 125 (calendar-goto-date (calendar-gregorian-from-absolute
103 (year (calendar-read 126 (calendar-absolute-from-iso date)))
104 "ISO calendar year (>0): " 127 (or noecho (calendar-print-iso-date)))
105 '(lambda (x) (> x 0)) 128
106 (int-to-string (extract-calendar-year today)))) 129 (defun calendar-goto-iso-week (date &optional noecho)
107 (no-weeks (extract-calendar-month 130 "Move cursor to ISO DATE; echo ISO date unless NOECHO is t.
108 (calendar-iso-from-absolute 131 Interactively, goes to the first day of the specified week."
109 (1- 132 (interactive (calendar-iso-read-args))
110 (calendar-dayname-on-or-before
111 1 (calendar-absolute-from-gregorian
112 (list 1 4 (1+ year))))))))
113 (week (calendar-read
114 (format "ISO calendar week (1-%d): " no-weeks)
115 '(lambda (x) (and (> x 0) (<= x no-weeks)))))
116 (day (calendar-read
117 "ISO day (1-7): "
118 '(lambda (x) (and (<= 1 x) (<= x 7))))))
119 (list (list week day year))))
120 (calendar-goto-date (calendar-gregorian-from-absolute 133 (calendar-goto-date (calendar-gregorian-from-absolute
121 (calendar-absolute-from-iso date))) 134 (calendar-absolute-from-iso date)))
122 (or noecho (calendar-print-iso-date))) 135 (or noecho (calendar-print-iso-date)))
123 136
124 (defun diary-iso-date () 137 (defun diary-iso-date ()