[PATCH] Calendar sync with Emacs 21.4
18 years, 4 months
Jeff Miller
Jeff Miller
lets see if this one makes it through...
Long overdue sync with Emacs 21.4.
Users of appt may find some missing functionality. I was pretty
aggressive with the sync to Emacs appt.el.
Tested with XEmacs 21.4.19/no-mule.
Files todo-mode.el & timeclock.el sent separately. I didn't know
how to make patcher see them.
I plan to start looking at incorporating features from csv Emacs
calendar soon-ish.
ChangeLog addition:
2006-07-17 Jeff Miller <jmiller(a)cablespeed.com>
* Makefile (REQUIRES): added ibuffer & fsf-compat
* Makefile (ELCS): added timelock.elc & todo-mode.elc
* appt.el: Synced with Emacs 21.4
* cal-china.el: Synced with Emacs 21.4
* cal-coptic.el: Synced with Emacs 21.4
* cal-dst.el: Synced with Emacs 21.4
* cal-french.el: Synced with Emacs 21.4
* cal-hebrew.el: Synced with Emacs 21.4
* cal-islam.el: Synced with Emacs 21.4
* cal-iso.el: Synced with Emacs 21.4
* cal-julian.el: Synced with Emacs 21.4
* cal-mayan.el: Synced with Emacs 21.4
* cal-move.el: Synced with Emacs 21.4
* cal-persia.el: Synced with Emacs 21.4
* cal-tex.el: Synced with Emacs 21.4
* cal-x.el: Synced with Emacs 21.4
* cal-xemacs.el: Synced with Emacs 21.4
* calendar.el: Synced with Emacs 21.4
* diary-lib.el: Synced with Emacs 21.4
* holidays.el: Synced with Emacs 21.4
* lunar.el: Synced with Emacs 21.4
* solar.el: Synced with Emacs 21.4
* todo-mode.el: New file
* timeclock.el: New file
calendar source patch:
Diff command: cvs -q diff -u
Files affected: solar.el lunar.el holidays.el diary-lib.el calendar.el cal-xemacs.el cal-x.el cal-tex.el cal-persia.el cal-move.el cal-mayan.el cal-julian.el cal-iso.el cal-islam.el cal-hebrew.el cal-french.el cal-dst.el cal-coptic.el cal-china.el appt.el Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/Makefile,v
retrieving revision 1.27
diff -u -u -r1.27 Makefile
--- Makefile 2004/01/27 22:02:20 1.27
+++ Makefile 2006/07/17 23:30:37
＠＠ -22,7 +22,7 ＠＠
MAINTAINER = XEmacs Development Team <xemacs-beta(a)xemacs.org>
PACKAGE = calendar
PKG_TYPE = regular
-REQUIRES = xemacs-base
+REQUIRES = xemacs-base ibuffer fsf-compat
CATEGORY = standard
include ../../Local.rules.inc
＠＠ -30,8 +30,8 ＠＠
ELCS = appt.elc cal-dst.elc cal-french.elc cal-mayan.elc cal-x.elc \
cal-xemacs.elc calendar.elc diary-lib.elc holidays.elc cal-tex.elc \
cal-hebrew.elc cal-islam.elc cal-iso.elc cal-move.elc cal-persia.elc\
- cal-china.elc cal-coptic.elc cal-julian.elc lunar.elc solar.elc
-
+ cal-china.elc cal-coptic.elc cal-julian.elc lunar.elc solar.elc \
+ todo-mode.elc timeclock.elc
ifeq ($(BUILD_WITHOUT_MULE),)
ELCS += cal-japanese.elc
Index: appt.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/appt.el,v
retrieving revision 1.9
diff -u -u -r1.9 appt.el
--- appt.el 2004/01/27 18:17:11 1.9
+++ appt.el 2006/07/17 23:30:37
＠＠ -1,4 +1,4 ＠＠
-;;; appt.el --- appointment notification functions.
+;;; appt.el --- appointment notification functions
;; Keywords: calendar
;; Copyright (C) 1989, 1990, 1994, 1998 Free Software Foundation, Inc.
＠＠ -24,26 +24,12 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; 29-nov-89 created by Neil Mager <neilm(a)juliet.ll.mit.edu>.
-;;; 23-feb-91 hacked upon by Jamie Zawinski <jwz(a)lucid.com>.
-;;; 1-apr-91 some more.
-;;; 12-jul-95 updated for XEmacs 19.12 by Greg Veres
-;;; <gveres(a)cgl.uwaterloo.ca>
-;;; 21-mar-97 better support for fancy diary display by Tomasz J. Cholewo
-;;; <t.cholewo(a)ieee.org>
-;;;
;;; Commentary:
;;
;; appt.el - visible and/or audible notification of
;; appointments from ~/diary file.
;;
-;; Version 2.1
-;;
-;; Comments, corrections, and improvements should be sent to
-;; Neil M. Mager
-;; Net <neilm(a)juliet.ll.mit.edu>
-;; Voice (617) 981-4803
;;;
;;; Thanks to Edward M. Reingold for much help and many suggestions,
;;; And to many others for bug fixes and suggestions.
＠＠ -52,8 +38,8 ＠＠
;;; This functions in this file will alert the user of a
;;; pending appointment based on their diary file.
;;;
-;;; ******* It is necessary to invoke 'display-time' and ********
-;;; ******* 'appt-initialize' for this to work properly. ********
+;;; ******* It is necessary to invoke 'appt-initialize' for this
+;;; ******* to work properly.
;;;
;;; A message will be displayed in the mode line of the Emacs buffer
;;; and (if you request) the terminal will beep and display a message
＠＠ -83,7 +69,6 ＠＠
;;; .emacs file:
;;;
;;; (require 'appt)
-;;; (display-time)
;;; (appt-initialize)
;;;
;;; If you wish to see a list of appointments, or a full calendar, when emacs
＠＠ -175,29 +160,21 ＠＠
:type 'boolean
:group 'appt)
-(defcustom appt-msg-countdown-list '(20 15 10 5 3 1)
- "*A list of the intervals in minutes before the appointment when
- the warnings will be given. That is, if this were the list '(5 3 1),
- then a notification would be given five minutes, three minutes, and
- one minute before the appointment."
-:type '(repeat integer)
+;;;###autoload
+(defcustom appt-message-warning-time 12
+ "*Time in minutes before an appointment that the warning begins."
+:type 'integer
:group 'appt)
-(defcustom appt-check-time-syntax nil
- "*Whether all diary entries are intended to begin with time specifications.
-Appt will beep and issue a warning message when encountering unparsable
-lines."
+;;;###autoload
+(defcustom appt-audible t
+ "*Non-nil means beep to indicate appointment."
:type 'boolean
:group 'appt)
;;;###autoload
-(defcustom appt-audible t
- "*Controls whether appointment announcements should beep.
-Appt uses two sound-types for beeps: `appt' and `appt-final'.
-If this is a number, then that many beeps will occur.
-If this is a cons, the car is how many beeps, and the cdr is the
- delay between them (a float, fraction of a second to sleep.)
-See also the variable `appt-msg-countdown-list'"
+(defcustom appt-visible t
+ "*Non-nil means display appointment message in echo area."
:type 'boolean
:group 'appt)
＠＠ -208,12 +185,24 ＠＠
:group 'appt)
;;;###autoload
+(defcustom appt-msg-window t
+ "*Non-nil means display appointment message in another window."
+:type 'boolean
+:group 'appt)
+
+;;;###autoload
(defcustom appt-display-duration 10
- "*The number of seconds an appointment message is displayed in its own
- window if appt-announce-method is 'appt-window-announce."
+ "*The number of seconds an appointment message is displayed."
:type 'integer
:group 'appt)
+;;;###autoload
+(defcustom appt-display-diary t
+ "*Non-nil means to display the next days diary on the screen.
+This will occur at midnight when the appointment list is updated."
+:type 'boolean
+:group 'appt)
+
(defcustom appt-announce-method 'appt-window-announce
"*The name of the function used to notify the user of an impending
appointment. This is called with two arguments, the number of minutes
＠＠ -239,12 +228,6 ＠＠
(defconst appt-max-time 1439
"11:59pm in minutes - number of minutes in a day minus 1.")
-
-(defconst appt-check-tick -1)
-
-(defvar appt-disp-frame nil
- "If non-nil, frame to display appointments in.")
-(defvaralias 'appt-disp-screen 'appt-disp-frame)
;;; Announcement methods
＠＠ -283,12 +266,14 ＠＠
(message "%s" str))
))
+(defcustom appt-display-interval 3
+ "*Number of minutes to wait between checking the appointment list."
+:type 'integer
+:group 'appt)
+
(defvar appt-buffer-name " *appt-buf*"
"Name of the appointments buffer.")
-(defvar appt-frame-defaults nil)
-(defvaralias 'appt-screen-defaults 'appt-frame-defaults)
-
(defun appt-frame-announce (min-to-app appt)
"Set appt-announce-method to the name of this function to cause appointment
notifications to be given via messages in a pop-up frame."
＠＠ -345,11 +330,6 ＠＠
;;; just adding stuff to the display-time-string -- this causes less
;;; flicker.
-(defcustom appt-mode-line-string ""
- "*The string displayed in the mode line by the appointment package."
-:type 'string
-:group 'appt)
-
(defun appt-display-mode-line (min-to-app)
"Add an appointment annotation to the mode line."
(setq appt-mode-line-string
＠＠ -420,24 +400,6 ＠＠
(sleep-for 2))))
(goto-char (point-min)))
-(defun appt-initialize ()
- "Read your `diary-file' and remember today's appointments. Call this from
- your .emacs file, or any time you want your .diary file re-read (this happens
- automatically at midnight to notice the next day's appointments).
-
- The time must be at the beginning of a line for it to be put in the
- appointments list.
- 02/23/89
- 12:00pm lunch
- Wednesday
- 10:00am group meeting"
- (install-display-time-hook)
- (let ((n (length (appt-diary-entries))))
- (cond ((= n 0) (message "no appointments today."))
- ((= n 1) (message "1 appointment today."))
- (t (message "%d appointments today." n)))))
-
-
(defun appt-beep (&optional final-p)
(cond ((null appt-audible) nil)
((numberp appt-audible)
＠＠ -455,7 +417,24 ＠＠
(setq i (1- i)))))
(t (beep))))
+(defvar appt-disp-window-function 'appt-disp-window
+ "Function called to display appointment window.")
+
+(defvar appt-delete-window-function 'appt-delete-window
+ "Function called to remove appointment window and buffer.")
+
+(defvar appt-mode-string nil
+ "String being displayed in the mode line saying you have an appointment.
+The actual string includes the amount of time till the appointment.")
+
+(defvar appt-prev-comp-time nil
+ "Time of day (mins since midnight) at which we last checked appointments.")
+
+(defvar appt-now-displayed nil
+ "Non-nil when we have started notifying about a appointment that is near.")
+(defvar appt-display-count nil)
+
(defun appt-check ()
"Check for an appointment and update the mode line and minibuffer if
desired.
＠＠ -470,20 +449,45 ＠＠
Thursday
11:45am Lunch meeting.
-
+
+Appointments are checked every `appt-display-interval' minutes.
The following variables control appointment notification:
`appt-issue-message'
If t, the diary buffer is checked for appointments.
+`appt-message-warning-time'
+ Variable used to determine if appointment message
+ should be displayed.
+
`appt-audible'
Variable used to determine if appointment is audible.
Default is t.
+`appt-visible'
+ Variable used to determine if appointment message should be
+ displayed in the mini-buffer. Default is t.
+
+`appt-msg-window'
+ Variable used to determine if appointment message
+ should temporarily appear in another window. Mutually exclusive
+ to `appt-visible'.
+
`appt-display-duration'
The number of seconds an appointment message
is displayed in another window.
+`appt-disp-window-function'
+ Function called to display appointment window. You can customize
+ appt.el by setting this variable to a function different from the
+ one provided with this package.
+
+`appt-delete-window-function'
+ Function called to remove appointment window and buffer. You can
+ customize appt.el by setting this variable to a function different
+ from the one provided with this package.
+
+
appt-msg-countdown-list Specifies how much warning you want before
appointments.
appt-display-mode-line Whether to display a countdown to the next
＠＠ -492,180 +496,210 ＠＠
'appt-window-announce to do it in a pop-up
window, 'appt-message-announce or
'appt-persistent-message-announce to do it
- in the echo-area.
+ in the echo-area."
+
+ (let* ((min-to-app -1)
+ (new-time "")
+ (prev-appt-mode-string appt-mode-string)
+ (prev-appt-display-count (or appt-display-count 0))
+ ;; Non-nil means do a full check for pending appointments
+ ;; and display in whatever ways the user has selected.
+ ;; When no appointment is being displayed,
+ ;; we always do a full check.
+ (full-check
+ (or (not appt-now-displayed)
+ ;; This is true every appt-display-interval minutes.
+ (= 0 (mod prev-appt-display-count appt-display-interval))))
+ ;; Non-nil means only update the interval displayed in the mode line.
+ (mode-line-only
+ (and (not full-check) appt-now-displayed)))
+
+ (when (or full-check mode-line-only)
+ (save-excursion
+
+ ;; Get the current time and convert it to minutes
+ ;; from midnight. ie. 12:01am = 1, midnight = 0.
+
+ (let* ((now (decode-time))
+ (cur-hour (nth 2 now))
+ (cur-min (nth 1 now))
+ (cur-comp-time (+ (* cur-hour 60) cur-min)))
+
+ ;; At the first check in any given day, update our
+ ;; appointments to today's list.
- This function is run from the `loadst' or `wakeup' process for display-time.
- Therefore, you need to have `(display-time)' in your .emacs file."
- (if appt-issue-message
- (let ((min-to-app -1))
- ;; Get the current time and convert it to minutes
- ;; from midnight. i.e., 12:01am = 1, midnight = 0.
-
- (let* ((now (decode-time))
- (cur-hour (nth 2 now))
- (cur-min (nth 1 now))
- (cur-comp-time (+ (* cur-hour 60) cur-min))
-
- ;; At the first check in any given day, update our
- ;; appointments to today's list.
-
- ;; If the current time is the same as the tick, just return.
- ;; This means that this function has been called more than once
- ;; in the current minute, which is not useful.
- (shut-up-this-time (= cur-comp-time appt-check-tick))
- (turnover-p (> appt-check-tick cur-comp-time)))
- (setq appt-check-tick cur-comp-time)
- ;;
- ;; If it is now the next day (we have crossed midnight since the last
- ;; time this was called) then we should update our appointments to
- ;; today's list. Show the diary entries (tjc).
- (if turnover-p (progn (appt-diary-entries) (diary 1)))
- ;;
+ (if (or (null appt-prev-comp-time)
+ (< cur-comp-time appt-prev-comp-time))
+ (condition-case nil
+ (progn
+ (if (and view-diary-entries-initially appt-display-diary)
+ (diary)
+ (let ((diary-display-hook 'appt-make-list))
+ (diary))))
+ (error nil)))
+ (setq appt-prev-comp-time cur-comp-time)
+
+ (setq appt-mode-string nil)
+ (setq appt-display-count nil)
+
;; If there are entries in the list, and the
;; user wants a message issued,
;; get the first time off of the list
;; and calculate the number of minutes until the appointment.
- (if (and appt-issue-message appt-time-msg-list)
- (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
- (setq min-to-app (- appt-comp-time cur-comp-time))
-
- (while (and appt-time-msg-list
- (< appt-comp-time cur-comp-time))
- (setq appt-time-msg-list (cdr appt-time-msg-list))
- (if appt-time-msg-list
- (setq appt-comp-time
- (car (car (car appt-time-msg-list))))))
- ;;
+ (if (and appt-issue-message appt-time-msg-list)
+ (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
+ (setq min-to-app (- appt-comp-time cur-comp-time))
+
+ (while (and appt-time-msg-list
+ (< appt-comp-time cur-comp-time))
+ (setq appt-time-msg-list (cdr appt-time-msg-list))
+ (if appt-time-msg-list
+ (setq appt-comp-time
+ (car (car (car appt-time-msg-list))))))
+
;; If we have an appointment between midnight and
- ;; warning-time minutes after midnight, we must begin
- ;; to issue a message before midnight. Midnight is
- ;; considered 0 minutes and 11:59pm is 1439
- ;; minutes. Therefore we must recalculate the minutes
- ;; to appointment variable. It is equal to the number
- ;; of minutes before midnight plus the number of
+ ;; 'appt-message-warning-time' minutes after midnight,
+ ;; we must begin to issue a message before midnight.
+ ;; Midnight is considered 0 minutes and 11:59pm is
+ ;; 1439 minutes. Therefore we must recalculate the minutes
+ ;; to appointment variable. It is equal to the number of
+ ;; minutes before midnight plus the number of
;; minutes after midnight our appointment is.
- ;;
- ;; ## I don't think this does anything -- it would if
- ;; it were (for example) a 12:01am appt on the list at
- ;; 11:55pm, but that can't ever happen, because the
- ;; applicable 12:01am appt is for tomorrow, not today,
- ;; and we only have today's diary list. It's not
- ;; simply a matter of concatenating two days together,
- ;; either, because then tuesday's appts would be
- ;; signalled on monday. We have to do a real one-day
- ;; lookahead -- keep a list of tomorrow's appts, and
- ;; check it when near midnight.
- ;;
- (if (and (< appt-comp-time
- (apply 'max appt-msg-countdown-list))
- (> (+ cur-comp-time
- (apply 'max appt-msg-countdown-list))
+
+ (if (and (< appt-comp-time appt-message-warning-time)
+ (> (+ cur-comp-time appt-message-warning-time)
appt-max-time))
- (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time)
- appt-comp-time)))
- ;;
- ;; issue warning if the appointment time is within warning-time
- (cond
- ;; if there should not be any notifications in the mode-line,
- ;; clear it.
- ((> min-to-app (apply 'max appt-msg-countdown-list))
- (appt-display-mode-line nil))
- ;; do nothing if this is the second time this minute we've
- ;; gotten here, of if we shouldn't be notifying right now.
- ((or shut-up-this-time
- (and (not (= min-to-app 0))
- (not (memq min-to-app appt-msg-countdown-list))))
- nil)
-
- ((and (= min-to-app 0)
- (string-match "%%(" (nth 1 (car appt-time-msg-list))))
- ;;
- ;; If this is a magic evaluating-notification, evaluate it.
- ;; these kinds of notifications aren't subject to the
- ;; appt-msg-countdown-list.
- ;;
- (let* ((list-string (substring (nth 1 (car appt-time-msg-list))
- (1- (match-end 0))))
- (form (condition-case ()
- (read list-string)
- (error
- (ding)
- (message "Appt: error reading from \"%s\""
- (nth 1 (car appt-time-msg-list)))
- (sit-for 2)
- nil))))
- (eval form)))
- ;; issue warning if the appointment time is
- ;; within appt-message-warning time
- ((and (<= min-to-app (apply 'max appt-msg-countdown-list))
- (>= min-to-app 0))
- ;;
- ;; produce a notification.
- (appt-beep (= min-to-app 0))
- (funcall appt-announce-method min-to-app
- (car appt-time-msg-list))
- ;; update mode line and expire if necessary
- (appt-display-mode-line min-to-app)
+ (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time))
+ appt-comp-time))
+
+ ;; issue warning if the appointment time is
+ ;; within appt-message-warning time
+
+ (when (and (<= min-to-app appt-message-warning-time)
+ (>= min-to-app 0))
+ (setq appt-now-displayed t)
+ (setq appt-display-count
+ (1+ prev-appt-display-count))
+ (unless mode-line-only
+ (if appt-msg-window
+ (progn
+ (setq new-time (format-time-string "%a %b %e "
+ (current-time)))
+ (funcall
+ appt-disp-window-function
+ (number-to-string min-to-app) new-time
+ (car (cdr (car appt-time-msg-list))))
+
+ (run-at-time
+ (format "%d sec" appt-display-duration)
+ nil
+ appt-delete-window-function))
+ ;;; else
+
+ (if appt-visible
+ (message "%s"
+ (car (cdr (car appt-time-msg-list)))))
+
+ (if appt-audible
+ (beep 1))))
+
+ (when appt-display-mode-line
+ (setq appt-mode-string
+ (concat " App't in "
+ (number-to-string min-to-app)
+ " min. ")))
+
;; When an appointment is reached,
;; delete it from the list.
;; Reset the count to 0 in case we display another
;; appointment on the next cycle.
- (if (= min-to-app 0)
- (setq appt-time-msg-list
+ (if (= min-to-app 0)
+ (setq appt-time-msg-list
(cdr appt-time-msg-list)
- )))
- (t
- ;; else we're not near any appointment, or there are no
- ;; apointments; make sure mode line is clear.
- (appt-display-mode-line nil))))
- (appt-display-mode-line nil))))))
+ appt-display-count nil)))))
+
+ ;; If we have changed the mode line string,
+ ;; redisplay all mode lines.
+ (and appt-display-mode-line
+ (not (equal appt-mode-string
+ prev-appt-mode-string))
+ (progn
+ (force-mode-line-update t)
+ ;; If the string now has a notification,
+ ;; redisplay right now.
+ (if appt-mode-string
+ (sit-for 0)))))))))
+
+;;(defun appt-window-announce (min-to-app appt)
+;; "Set appt-announce-method to the name of this function to cause appointment
+;;notifications to be given via messages in a pop-up window. The variable
+;;appt-display-duration controls how long this window should be left up."
-(defun appt-window-announce (min-to-app appt)
- "Set appt-announce-method to the name of this function to cause appointment
-notifications to be given via messages in a pop-up window. The variable
-appt-display-duration controls how long this window should be left up."
+(defun appt-disp-window (min-to-app new-time appt-msg)
+ "Display appointment message APPT-MSG in a separate buffer."
(require 'electric)
- (save-excursion
- (save-window-excursion
-
- ;; Make sure we're not in the minibuffer
- ;; before splitting the window.
- (if (window-minibuffer-p (selected-window))
- nil
- (select-window (frame-lowest-window))
- (split-window))
- (let (appt-disp-buf)
- (unwind-protect
- (progn
- (setq appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name)))
- ;; set the mode-line of the pop-up window
- (setq modeline-format
- (concat "-------------------- Appointment "
- (if (eq min-to-app 0)
- "NOW"
- (concat "in " (format "%s" min-to-app)
- (if (eq min-to-app 1) " minute" " minutes")))
- ". ("
- (let ((h (string-to-int
- (substring (current-time-string) 11 13))))
- (concat (if (> h 12) (format "%s" (- h 12))
- (format "%s" h)) ":"
- (substring (current-time-string) 14 16)
- (if (< h 12) "am" "pm")))
- ") %-"))
- (pop-to-buffer appt-disp-buf)
- (insert (car (cdr appt)))
- (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf))
- (set-buffer-modified-p nil)
- (sit-for appt-display-duration))
- (and appt-disp-buf (kill-buffer appt-disp-buf)))))))
+
+ ;; Make sure we're not in the minibuffer
+ ;; before splitting the window.
+
+ (if (equal (selected-window) (minibuffer-window))
+ (if (other-window 1)
+ (select-window (other-window 1))
+ (if (display-multi-frame-p)
+ (select-frame (other-frame 1)))))
+
+ (let* ((this-buffer (current-buffer))
+ (this-window (selected-window))
+ (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))
+
+ (if (cdr (assq 'unsplittable (frame-parameters)))
+ ;; In an unsplittable frame, use something somewhere else.
+ (display-buffer appt-disp-buf)
+ ;; (unless (or (special-display-p (buffer-name appt-disp-buf))
+ ;; (same-window-p (buffer-name appt-disp-buf)))
+ ;; By default, split the bottom window and use the lower part.
+ (appt-select-lowest-window)
+ (split-window)
+ ;;)
+ (pop-to-buffer appt-disp-buf))
+ (setq mode-line-format
+ (concat "-------------------- Appointment in "
+ min-to-app " minutes. " new-time " %-"))
+ (erase-buffer)
+ (insert-string appt-msg)
+ (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t))
+ (set-buffer-modified-p nil)
+ (raise-frame (selected-frame))
+ (select-window this-window)
+ (if appt-audible
+ (beep 1))))
+
+(defun appt-delete-window ()
+ "Function called to undisplay appointment messages.
+Usually just deletes the appointment buffer."
+ (let ((window (get-buffer-window appt-buffer-name t)))
+ (and window
+ (or (eq window (frame-root-window (window-frame window)))
+ (delete-window window))))
+ (kill-buffer appt-buffer-name)
+ (if appt-audible
+ (beep 1)))
+
+(defun appt-select-lowest-window ()
+"Select the lowest window on the frame."
+ (let ((lowest-window (selected-window))
+ (bottom-edge (nth 3 (window-pixel-edges))))
+ (walk-windows (lambda (w)
+ (let ((next-bottom-edge (nth 3 (window-pixel-edges w))))
+ (when (< bottom-edge next-bottom-edge)
+ (setq bottom-edge next-bottom-edge
+ lowest-window w)))))
+ (select-window lowest-window)))
-
-;;; Interactively adding and deleting appointments
;;;###autoload
(defun appt-add (new-appt-time new-appt-msg)
- "Add an appointment for the day at TIME and issue MESSAGE.
+ "Add an appointment for the day at NEW-APPT-TIME and issue message NEW-APPT-MSG.
The time should be in either 24 hour format or am/pm format."
(interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
＠＠ -676,8 +710,7 ＠＠
(let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
(appt-time (list (appt-convert-time new-appt-time)))
(time-msg (cons appt-time (list appt-time-string))))
- (setq appt-time-msg-list (append appt-time-msg-list
- (list time-msg)))
+ (setq appt-time-msg-list (nconc appt-time-msg-list (list time-msg)))
(setq appt-time-msg-list (appt-sort-list appt-time-msg-list))))
;;;###autoload
＠＠ -688,104 +721,119 ＠＠
(while tmp-msg-list
(let* ((element (car tmp-msg-list))
(prompt-string (concat "Delete "
- (prin1-to-string (car (cdr element)))
+ ;; We want to quote any doublequotes
+ ;; in the string, as well as put
+ ;; doublequotes around it.
+ (prin1-to-string
+ (substring-no-properties
+ (car (cdr element)) 0))
" from list? "))
(test-input (y-or-n-p prompt-string)))
(setq tmp-msg-list (cdr tmp-msg-list))
(if test-input
(setq appt-time-msg-list (delq element appt-time-msg-list)))))
+ (appt-check)
(message "")))
-;; Create the appointments list from todays diary buffer.
-;; The time must be at the beginning of a line for it to be
-;; put in the appointments list.
-;; 02/23/89
-;; 12:00pm lunch
-;; Wednesday
-;; 10:00am group meeting
-;; We assume that the variables DATE and NUMBER
-;; hold the arguments that list-diary-entries received.
-;; They specify the range of dates that the diary is being processed for.
-
+(eval-when-compile (defvar number)
+ (defvar original-date)
+ (defvar diary-entries-list))
;;;###autoload
(defun appt-make-list ()
- "Don't call this directly; call appt-initialize or appt-diary-entries."
- ;; Clear the appointments list, then fill it in from the diary.
- (if diary-entries-list
-
- ;; Cycle through the entry-list (diary-entries-list)
- ;; looking for entries beginning with a time. If
- ;; the entry begins with a time, add it to the
- ;; appt-time-msg-list. Then sort the list.
-
- (let ((entry-list diary-entries-list)
- (new-appts '())
- (new-time-string ""))
- ;; Skip diary entries for dates before today.
- (while (and entry-list
- (calendar-date-compare
- (car entry-list) (list (calendar-current-date))))
- (setq entry-list (cdr entry-list)))
- ;; Parse the entries for today.
- (while (and entry-list
- (calendar-date-equal
- (calendar-current-date) (car (car entry-list))))
- (let ((time-string (car (cdr (car entry-list)))))
- (while (string-match
- "\\`[ \t\n]*\\([0-9]?[0-9]\\(:[0-9][0-9]\\)?[ \t]*\\(am\\|pm\\)?\\|noon\\|midnight\\|midnite\\).*$"
- time-string)
- (let* ((eol (match-end 0))
- (appt-time-string (substring time-string
- (match-beginning 1)
- (match-end 1)))
- (appt-msg-string
- (substring time-string (match-end 1) eol))
- (appt-time (list (appt-convert-time appt-time-string))))
- (setq time-string (substring time-string eol)
- new-appts (cons (cons appt-time
- (list (concat appt-time-string ":"
- appt-msg-string)))
- new-appts))))
- (if appt-check-time-syntax
- (while (string-match "\n*\\([^\n]+\\)$" time-string)
- (beep)
- (message "Unparsable time: %s"
- (substring time-string (match-beginning 1)
- (match-end 1)))
- (sit-for 3)
- (setq time-string (substring time-string (match-end 0)))))
-
- )
- (setq entry-list (cdr entry-list)))
- (setq appt-time-msg-list ; seems we can't nconc this list...
- (append (nreverse new-appts) appt-time-msg-list))))
- (run-hooks 'appt-make-list-hook)
- (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
-
- ;; Get the current time and convert it to minutes
- ;; from midnight, i.e., 12:01am = 1, midnight = 0,
- ;; so that the elements in the list
- ;; that are earlier than the present time can
- ;; be removed.
-
- (let* ((now (decode-time))
+ "Create the appointments list from todays diary buffer.
+The time must be at the beginning of a line for it to be
+put in the appointments list.
+ 02/23/89
+ 12:00pm lunch
+ Wednesday
+ 10:00am group meeting
+We assume that the variables DATE and NUMBER
+hold the arguments that `list-diary-entries' received.
+They specify the range of dates that the diary is being processed for."
+
+ ;; We have something to do if the range of dates that the diary is
+ ;; considering includes the current date.
+ (if (and (not (calendar-date-compare
+ (list (calendar-current-date))
+ (list original-date)))
+ (calendar-date-compare
+ (list (calendar-current-date))
+ (list (calendar-gregorian-from-absolute
+ (+ (calendar-absolute-from-gregorian original-date)
+ number)))))
+ (save-excursion
+ ;; Clear the appointments list, then fill it in from the diary.
+ (setq appt-time-msg-list nil)
+ (if diary-entries-list
+
+ ;; Cycle through the entry-list (diary-entries-list)
+ ;; looking for entries beginning with a time. If
+ ;; the entry begins with a time, add it to the
+ ;; appt-time-msg-list. Then sort the list.
+
+ (let ((entry-list diary-entries-list)
+ (new-time-string ""))
+ ;; Skip diary entries for dates before today.
+ (while (and entry-list
+ (calendar-date-compare
+ (car entry-list) (list (calendar-current-date))))
+ (setq entry-list (cdr entry-list)))
+ ;; Parse the entries for today.
+ (while (and entry-list
+ (calendar-date-equal
+ (calendar-current-date) (car (car entry-list))))
+ (let ((time-string (cadr (car entry-list))))
+ (while (string-match
+ "\\([0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?\\).*"
+ time-string)
+ (let* ((beg (match-beginning 0))
+ ;; Get just the time for this appointment.
+ (only-time (match-string 1 time-string))
+ ;; Find the end of this appointment
+ ;; (the start of the next).
+ (end (string-match
+ "^[ \t]*[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
+ time-string
+ (match-end 0)))
+ ;; Get the whole string for this appointment.
+ (appt-time-string
+ (substring time-string beg (if end (1- end)))))
+
+ ;; Add this appointment to appt-time-msg-list.
+ (let* ((appt-time (list (appt-convert-time only-time)))
+ (time-msg (list appt-time appt-time-string)))
+ (setq appt-time-msg-list
+ (nconc appt-time-msg-list (list time-msg))))
+
+ ;; Discard this appointment from the string.
+ (setq time-string
+ (if end (substring time-string end) "")))))
+ (setq entry-list (cdr entry-list)))))
+ (run-hooks 'appt-make-list-hook)
+ (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
+ ;; Get the current time and convert it to minutes
+ ;; from midnight. ie. 12:01am = 1, midnight = 0,
+ ;; so that the elements in the list
+ ;; that are earlier than the present time can
+ ;; be removed.
+ (let* ((now (decode-time))
(cur-hour (nth 2 now))
(cur-min (nth 1 now))
(cur-comp-time (+ (* cur-hour 60) cur-min))
(appt-comp-time (car (car (car appt-time-msg-list)))))
+
+ (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
+ (setq appt-time-msg-list (cdr appt-time-msg-list))
+ (if appt-time-msg-list
+ (setq appt-comp-time (car (car (car appt-time-msg-list))))))))))
+
- (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
- (setq appt-time-msg-list (cdr appt-time-msg-list))
- (if appt-time-msg-list
- (setq appt-comp-time (car (car (car appt-time-msg-list)))))))
- appt-time-msg-list)
-
-;;Simple sort to put the appointments list in order.
-;;Scan the list for the smallest element left in the list.
-;;Append the smallest element left into the new list, and remove
-;;it from the original list.
(defun appt-sort-list (appt-list)
+ "Simple sort to put the appointments list APPT-LIST in order.
+Scan the list for the smallest element left in the list.
+Append the smallest element left into the new list, and remove
+it from the original list."
(let ((order-list nil))
(while appt-list
(let* ((element (car appt-list))
＠＠ -797,44 +845,41 ＠＠
(setq element (car tmp-list))
(setq element-time (car (car element))))
(setq tmp-list (cdr tmp-list)))
- (setq order-list (append order-list (list element)))
+ (setq order-list (nconc order-list (list element)))
(setq appt-list (delq element appt-list))))
order-list))
(defun appt-convert-time (time2conv)
"Convert hour:min[am/pm] format to minutes from midnight."
- (cond ((string-match "^[ \t]*midni\\(ght\\|te\\)[ \t]*\\'" time2conv)
- 0)
- ((string-match "^[ \t]*noon[ \t]*\\'" time2conv)
- (* 12 60))
- (t
- (let ((conv-time 0)
- (hr 0)
- (min 0))
- (or (string-match
- "\\`[ \t]*\\([0-9][0-9]?\\)[ \t]*\\(:[ \t]*\\([0-9][0-9]\\)\\)?[
-\t]*\\(am\\|pm\\)?"
- time2conv)
- (error "unparsable time \"%s\"" time2conv))
- (setq hr (string-to-int
- (substring time2conv
- (match-beginning 1) (match-end 1))))
- (if (match-beginning 3)
- (setq min (string-to-int
- (substring time2conv
- (match-beginning 3) (match-end 3)))))
- ;; convert the time appointment time into 24 hour time
- (if (match-beginning 4)
- (progn
- (if (or (= hr 0) (> hr 12))
- (error "mixing 12hr and 24 hr time! %s" time2conv))
- (if (string-match "am"
- (substring time2conv (match-beginning 4)))
- (if (= hr 12) (setq hr 0))
- (if (< hr 12) (setq hr (+ 12 hr))))))
- (if (> min 59) (error "minutes outa bounds - %s" time2conv))
- (+ (* hr 60) min)))))
+
+ (let ((conv-time 0)
+ (hr 0)
+ (min 0))
+
+ (string-match ":\\([0-9][0-9]\\)" time2conv)
+ (setq min (string-to-int
+ (match-string 1 time2conv)))
+
+ (string-match "[0-9]?[0-9]:" time2conv)
+ (setq hr (string-to-int
+ (match-string 0 time2conv)))
+
+ ;; convert the time appointment time into 24 hour time
+
+ (cond ((and (string-match "pm" time2conv) (< hr 12))
+ (setq hr (+ 12 hr)))
+ ((and (string-match "am" time2conv) (= hr 12))
+ (setq hr 0)))
+
+ ;; convert the actual time
+ ;; into minutes for comparison
+ ;; against the actual time.
+
+ (setq conv-time (+ (* hr 60) min))
+ conv-time))
+
+
(defvar display-time-hook-installed nil)
＠＠ -872,14 +917,35 ＠＠
(setq display-time-hook (cons appt-check display-time-hook)))
))
-;defvar appt-timer nil
-; "Timer used for diary appointment notifications (`appt-check').")
-;(unless appt-timer
-; (progn
-; (setq appt-timer (make-itimer))
-; (set-itimer-fun
+(defvar appt-timer nil
+ "Timer used for diary appointment notifications (`appt-check').")
+
+(defun appt-initialize ()
+ "Read your `diary-file' and remember today's appointments. Call this from
+ your .emacs file, or any time you want your .diary file re-read (this happens
+ automatically at midnight to notice the next day's appointments).
+ The time must be at the beginning of a line for it to be put in the
+ appointments list.
+ 02/23/89
+ 12:00pm lunch
+ Wednesday
+ 10:00am group meeting"
+
+ (unless appt-timer
+ (setq appt-timer (run-at-time t 60 'appt-check)))
+
+ (or global-mode-string (setq global-mode-string '("")))
+ (or (memq 'appt-mode-string global-mode-string)
+ (setq global-mode-string
+ (append global-mode-string '(appt-mode-string))))
+
+ (let ((n (length (appt-diary-entries))))
+ (cond ((= n 0) (message "no appointments today."))
+ ((= n 1) (message "1 appointment today."))
+ (t (message "%d appointments today." n))))
+ )
;;; appt.el ends here
Index: cal-china.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-china.el,v
retrieving revision 1.3
diff -u -u -r1.3 cal-china.el
--- cal-china.el 2000/01/08 17:45:56 1.3
+++ cal-china.el 2006/07/17 23:30:37
＠＠ -1,4 +1,4 ＠＠
-;;; cal-china.el --- calendar functions for the Chinese calendar.
+;;; cal-china.el --- calendar functions for the Chinese calendar
;; Copyright (C) 1995,1997 Free Software Foundation, Inc.
＠＠ -23,7 +23,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
Index: cal-coptic.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-coptic.el,v
retrieving revision 1.3
diff -u -u -r1.3 cal-coptic.el
--- cal-coptic.el 2000/01/08 17:45:56 1.3
+++ cal-coptic.el 2006/07/17 23:30:37
＠＠ -1,6 +1,6 ＠＠
-;;; cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars.
+;;; cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold(a)cs.uiuc.edu>
;; Keywords: calendar
＠＠ -23,7 +23,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
Index: cal-dst.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-dst.el,v
retrieving revision 1.4
diff -u -u -r1.4 cal-dst.el
--- cal-dst.el 2000/01/08 17:45:56 1.4
+++ cal-dst.el 2006/07/17 23:30:37
＠＠ -1,4 +1,4 ＠＠
-;;; cal-dst.el --- calendar functions for daylight savings rules.
+;;; cal-dst.el --- calendar functions for daylight savings rules
;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
＠＠ -24,7 +24,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
Index: cal-french.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-french.el,v
retrieving revision 1.3
diff -u -u -r1.3 cal-french.el
--- cal-french.el 2000/01/08 17:45:56 1.3
+++ cal-french.el 2006/07/17 23:30:37
＠＠ -1,4 +1,4 ＠＠
-;;; cal-french.el --- calendar functions for the French Revolutionary calendar.
+;;; cal-french.el --- calendar functions for the French Revolutionary calendar
;; Copyright (C) 1988, 89, 92, 94, 95, 1997 Free Software Foundation, Inc.
＠＠ -23,7 +23,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
;; This collection of functions implements the features of calendar.el and
＠＠ -48,12 +48,12 ＠＠
(defun french-calendar-accents ()
"True if diacritical marks are available."
- (if (not (featurep 'xemacs) )
- (and (or window-system
- (terminal-coding-system))
- (or enable-multibyte-characters
- (and (char-table-p standard-display-table)
- (equal (aref standard-display-table 161) [161])))))
+ (and (or window-system
+ (terminal-coding-system))
+ (not (featurep 'xemacs)
+ (or enable-multibyte-characters
+ (and (char-table-p standard-display-table)
+ (equal (aref standard-display-table 161) [161])))))
t)
(defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792))
＠＠ -72,11 +72,11 ＠＠
"Octidi" "Nonidi" "Decadi"])
(defconst french-calendar-multibyte-special-days-array
- ["de la Vertu" "du Génie" "du Labour" "de la Raison" "de la Récompense"
+ ["de la Vertu" "du Génie" "du Travail" "de la Raison" "des Récompenses"
"de la Révolution"])
(defconst french-calendar-special-days-array
- ["de la Vertu" "du Ge'nie" "du Labour" "de la Raison" "de la Re'compense"
+ ["de la Vertu" "du Ge'nie" "du Travail" "de la Raison" "des Re'compenses"
"de la Re'volution"])
(defun french-calendar-month-name-array ()
＠＠ -183,10 +183,9 ＠＠
y))
(t (format
(if (french-calendar-accents)
- "Décade %s, %s de %s de l'Année %d de la Révolution"
- "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution")
- (make-string (1+ (/ (1- d) 10)) ?I)
- (aref (french-calendar-day-name-array) (% (1- d) 10))
+ "%d %s an %d de la Révolution"
+ "%d %s an %d de la Re'volution")
+ d
(aref (french-calendar-month-name-array) (1- m))
y)))))
＠＠ -238,21 +237,13 ＠＠
month-list
nil t)
(calendar-make-alist month-list 1 'car))))
- (decade (if (> month 12)
- 1
- (calendar-read
- (if accents
- "Décade (1-3): "
- "De'cade (1-3): ")
- '(lambda (x) (memq x '(1 2 3))))))
(day (if (> month 12)
(- month 12)
(calendar-read
- "Jour (1-10): "
- '(lambda (x) (and (<= 1 x) (<= x 10))))))
- (month (if (> month 12) 13 month))
- (day (+ day (* 10 (1- decade)))))
- (list (list month day year)))))
+ "Jour (1-30): "
+ '(lambda (x) (and (<= 1 x) (<= x 30))))))
+ (month (if (> month 12) 13 month)))
+ (list (list month day year)))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-french date)))
(or noecho (calendar-print-french-date)))
Index: cal-hebrew.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-hebrew.el,v
retrieving revision 1.3
diff -u -u -r1.3 cal-hebrew.el
--- cal-hebrew.el 2000/01/08 17:45:56 1.3
+++ cal-hebrew.el 2006/07/17 23:30:38
＠＠ -1,4 +1,4 ＠＠
-;;; cal-hebrew.el --- calendar functions for the Hebrew calendar.
+;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
;; Copyright (C) 1995,1997 Free Software Foundation, Inc.
＠＠ -24,7 +24,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
＠＠ -908,17 +908,17 ＠＠
(week (/ omer 7))
(day (% omer 7)))
(if (and (> omer 0) (< omer 50))
- (format "Day %d%s of the omer (until sunset)"
- omer
- (if (zerop week)
- ""
- (format ", that is, %d week%s%s"
- week
- (if (= week 1) "" "s")
- (if (zerop day)
- ""
- (format " and %d day%s"
- day (if (= day 1) "" "s")))))))))
+ (format "Day %d%s of the omer (until sunset)"
+ omer
+ (if (zerop week)
+ ""
+ (format ", that is, %d week%s%s"
+ week
+ (if (= week 1) "" "s")
+ (if (zerop day)
+ ""
+ (format " and %d day%s"
+ day (if (= day 1) "" "s")))))))))
(defun diary-yahrzeit (death-month death-day death-year)
"Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.
＠＠ -940,14 +940,14 ＠＠
(diff (- yr h-year))
(y (hebrew-calendar-yahrzeit h-date yr)))
(if (and (> diff 0) (or (= y d) (= y (1+ d))))
- (format "Yahrzeit of %s%s: %d%s anniversary"
- entry
- (if (= y d) "" " (evening)")
- diff
- (cond ((= (% diff 10) 1) "st")
- ((= (% diff 10) 2) "nd")
- ((= (% diff 10) 3) "rd")
- (t "th"))))))
+ (format "Yahrzeit of %s%s: %d%s anniversary"
+ entry
+ (if (= y d) "" " (evening)")
+ diff
+ (cond ((= (% diff 10) 1) "st")
+ ((= (% diff 10) 2) "nd")
+ ((= (% diff 10) 3) "rd")
+ (t "th"))))))
(defun diary-rosh-hodesh ()
"Rosh Hodesh diary entry.
＠＠ -967,42 +967,42 ＠＠
(h-yesterday (extract-calendar-day
(calendar-hebrew-from-absolute (1- d)))))
(if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
- (format
- "Rosh Hodesh %s"
- (if (= h-day 30)
- (format
- "%s (first day)"
- ;; next month must be in the same year since this
- ;; month can't be the last month of the year since
- ;; it has 30 days
- (aref h-month-names h-month))
- (if (= h-yesterday 30)
- (format "%s (second day)" this-month)
- this-month)))
+ (format
+ "Rosh Hodesh %s"
+ (if (= h-day 30)
+ (format
+ "%s (first day)"
+ ;; next month must be in the same year since this
+ ;; month can't be the last month of the year since
+ ;; it has 30 days
+ (aref h-month-names h-month))
+ (if (= h-yesterday 30)
+ (format "%s (second day)" this-month)
+ this-month)))
(if (= (% d 7) 6);; Saturday--check for Shabbat Mevarhim
- (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
- (format "Mevarhim Rosh Hodesh %s (%s)"
- (aref h-month-names
- (if (= h-month
- (hebrew-calendar-last-month-of-year
- h-year))
- 0 h-month))
- (aref calendar-day-name-array (- 29 h-day))))
- ((and (< h-day 30) (> h-day 22) (= 30 last-day))
- (format "Mevarhim Rosh Hodesh %s (%s-%s)"
- (aref h-month-names h-month)
- (if (= h-day 29)
- "tomorrow"
- (aref calendar-day-name-array (- 29 h-day)))
- (aref calendar-day-name-array
- (% (- 30 h-day) 7)))))
- (if (and (= h-day 29) (/= h-month 6))
- (format "Erev Rosh Hodesh %s"
- (aref h-month-names
- (if (= h-month
- (hebrew-calendar-last-month-of-year
- h-year))
- 0 h-month))))))))
+ (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
+ (format "Mevarhim Rosh Hodesh %s (%s)"
+ (aref h-month-names
+ (if (= h-month
+ (hebrew-calendar-last-month-of-year
+ h-year))
+ 0 h-month))
+ (aref calendar-day-name-array (- 29 h-day))))
+ ((and (< h-day 30) (> h-day 22) (= 30 last-day))
+ (format "Mevarhim Rosh Hodesh %s (%s-%s)"
+ (aref h-month-names h-month)
+ (if (= h-day 29)
+ "tomorrow"
+ (aref calendar-day-name-array (- 29 h-day)))
+ (aref calendar-day-name-array
+ (% (- 30 h-day) 7)))))
+ (if (and (= h-day 29) (/= h-month 6))
+ (format "Erev Rosh Hodesh %s"
+ (aref h-month-names
+ (if (= h-month
+ (hebrew-calendar-last-month-of-year
+ h-year))
+ 0 h-month))))))))
(defun diary-parasha ()
"Parasha diary entry--entry applies if date is a Saturday."
＠＠ -1034,16 +1034,16 ＠＠
(/ (- d first-saturday) 7))
(parasha (aref year-format saturday)))
(if parasha
- (format
- "Parashat %s"
- (if (listp parasha);; Israel differs from diaspora
- (if (car parasha)
- (format "%s (diaspora), %s (Israel)"
- (hebrew-calendar-parasha-name (car parasha))
- (hebrew-calendar-parasha-name (cdr parasha)))
- (format "%s (Israel)"
- (hebrew-calendar-parasha-name (cdr parasha))))
- (hebrew-calendar-parasha-name parasha))))))))
+ (format
+ "Parashat %s"
+ (if (listp parasha);; Israel differs from diaspora
+ (if (car parasha)
+ (format "%s (diaspora), %s (Israel)"
+ (hebrew-calendar-parasha-name (car parasha))
+ (hebrew-calendar-parasha-name (cdr parasha)))
+ (format "%s (Israel)"
+ (hebrew-calendar-parasha-name (cdr parasha))))
+ (hebrew-calendar-parasha-name parasha))))))))
(defvar hebrew-calendar-parashiot-names
["Bereshith" "Noah" "Lech L'cha" "Vayera" "Hayei Sarah" "Toledoth"
Index: cal-islam.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-islam.el,v
retrieving revision 1.3
diff -u -u -r1.3 cal-islam.el
--- cal-islam.el 2000/01/08 17:45:56 1.3
+++ cal-islam.el 2006/07/17 23:30:38
＠＠ -1,4 +1,4 ＠＠
-;;; cal-islam.el --- calendar functions for the Islamic calendar.
+;;; cal-islam.el --- calendar functions for the Islamic calendar
;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
＠＠ -23,7 +23,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
Index: cal-iso.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-iso.el,v
retrieving revision 1.3
diff -u -u -r1.3 cal-iso.el
--- cal-iso.el 2000/01/08 17:45:56 1.3
+++ cal-iso.el 2006/07/17 23:30:38
＠＠ -1,4 +1,4 ＠＠
-;;; cal-iso.el --- calendar functions for the ISO calendar.
+;;; cal-iso.el --- calendar functions for the ISO calendar
;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
＠＠ -23,7 +23,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
Index: cal-julian.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-julian.el,v
retrieving revision 1.3
diff -u -u -r1.3 cal-julian.el
--- cal-julian.el 2000/01/08 17:45:56 1.3
+++ cal-julian.el 2006/07/17 23:30:38
＠＠ -1,4 +1,4 ＠＠
-;;; cal-julian.el --- calendar functions for the Julian calendar.
+;;; cal-julian.el --- calendar functions for the Julian calendar
;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
＠＠ -23,7 +23,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
Index: cal-mayan.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-mayan.el,v
retrieving revision 1.4
diff -u -u -r1.4 cal-mayan.el
--- cal-mayan.el 2000/01/08 17:45:56 1.4
+++ cal-mayan.el 2006/07/17 23:30:38
＠＠ -1,4 +1,4 ＠＠
-;;; cal-mayan.el --- calendar functions for the Mayan calendars.
+;;; cal-mayan.el --- calendar functions for the Mayan calendars
;; Copyright (C) 1992, 1993, 1995, 1997 Free Software Foundation, Inc.
＠＠ -24,7 +24,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
Index: cal-move.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-move.el,v
retrieving revision 1.3
diff -u -u -r1.3 cal-move.el
--- cal-move.el 2000/01/08 17:45:57 1.3
+++ cal-move.el 2006/07/17 23:30:38
＠＠ -23,7 +23,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
＠＠ -47,7 +47,8 ＠＠
(if (not (calendar-date-is-visible-p today))
(generate-calendar-window)
(update-calendar-mode-line)
- (calendar-cursor-to-visible-date today))))
+ (calendar-cursor-to-visible-date today)))
+ (run-hooks 'calendar-move-hook))
(defun calendar-forward-month (arg)
"Move the cursor forward ARG months.
＠＠ -66,7 +67,8 ＠＠
(let ((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))))
+ (calendar-cursor-to-visible-date new-cursor-date)))
+ (run-hooks 'calendar-move-hook))
(defun calendar-forward-year (arg)
"Move the cursor forward by ARG years.
＠＠ -86,11 +88,12 ＠＠
(interactive "p")
(calendar-forward-month (* -12 arg)))
-(defun scroll-calendar-left (arg)
+(defun scroll-calendar-left (&optional arg)
"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."
(interactive "p")
+ (unless arg (setq arg 1))
(calendar-cursor-to-nearest-date)
(let ((old-date (calendar-cursor-to-date))
(today (calendar-current-date)))
＠＠ -103,14 +106,15 ＠＠
(cond
((calendar-date-is-visible-p old-date) old-date)
((calendar-date-is-visible-p today) today)
- (t (list month 1 year))))))))
+ (t (list month 1 year)))))))
+ (run-hooks 'calendar-move-hook))
-(defun scroll-calendar-right (arg)
+(defun scroll-calendar-right (&optional arg)
"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."
(interactive "p")
- (scroll-calendar-left (- arg)))
+ (scroll-calendar-left (- (or arg 1))))
(defun scroll-calendar-left-three-months (arg)
"Scroll the displayed calendar window left by 3*ARG months.
＠＠ -170,7 +174,8 ＠＠
;; Put the new month on the screen, if needed, and go to the new date.
(if (not (calendar-date-is-visible-p new-cursor-date))
(calendar-other-month new-display-month new-display-year))
- (calendar-cursor-to-visible-date new-cursor-date))))
+ (calendar-cursor-to-visible-date new-cursor-date)))
+ (run-hooks 'calendar-move-hook))
(defun calendar-backward-day (arg)
"Move the cursor back ARG days.
＠＠ -245,7 +250,8 ＠＠
year)))
(if (not (calendar-date-is-visible-p last-day))
(calendar-other-month month year)
- (calendar-cursor-to-visible-date last-day)))))
+ (calendar-cursor-to-visible-date last-day))))
+ (run-hooks 'calendar-move-hook))
(defun calendar-beginning-of-year (arg)
"Move the cursor backward ARG year beginnings."
＠＠ -255,13 +261,15 ＠＠
(month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
- (jan-first (list 1 1 year)))
+ (jan-first (list 1 1 year))
+ (calendar-move-hook nil))
(if (and (= day 1) (= 1 month))
(calendar-backward-month (* 12 arg))
(if (and (= arg 1)
(calendar-date-is-visible-p jan-first))
(calendar-cursor-to-visible-date jan-first)
- (calendar-other-month 1 (- year (1- arg)))))))
+ (calendar-other-month 1 (- year (1- arg))))))
+ (run-hooks 'calendar-move-hook))
(defun calendar-end-of-year (arg)
"Move the cursor forward ARG year beginnings."
＠＠ -271,14 +279,16 ＠＠
(month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
- (dec-31 (list 12 31 year)))
+ (dec-31 (list 12 31 year))
+ (calendar-move-hook nil))
(if (and (= day 31) (= 12 month))
(calendar-forward-month (* 12 arg))
(if (and (= arg 1)
(calendar-date-is-visible-p dec-31))
(calendar-cursor-to-visible-date dec-31)
(calendar-other-month 12 (- year (1- arg)))
- (calendar-cursor-to-visible-date (list 12 31 displayed-year))))))
+ (calendar-cursor-to-visible-date (list 12 31 displayed-year)))))
+ (run-hooks 'calendar-move-hook))
(defun calendar-cursor-to-visible-date (date)
"Move the cursor to DATE that is on the screen."
＠＠ -313,7 +323,8 ＠＠
2
month)
year)))
- (calendar-cursor-to-visible-date date))
+ (calendar-cursor-to-visible-date date)
+ (run-hooks 'calendar-move-hook))
(provide 'cal-move)
Index: cal-persia.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-persia.el,v
retrieving revision 1.3
diff -u -u -r1.3 cal-persia.el
--- cal-persia.el 2000/01/08 17:45:57 1.3
+++ cal-persia.el 2006/07/17 23:30:38
＠＠ -1,4 +1,4 ＠＠
-;;; cal-persia.el --- calendar functions for the Persian calendar.
+;;; cal-persia.el --- calendar functions for the Persian calendar
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
＠＠ -23,7 +23,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
Index: cal-tex.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-tex.el,v
retrieving revision 1.3
diff -u -u -r1.3 cal-tex.el
--- cal-tex.el 2000/01/08 17:45:57 1.3
+++ cal-tex.el 2006/07/17 23:30:38
＠＠ -1,4 +1,4 ＠＠
-;;; cal-tex.el --- calendar functions for printing calendars with LaTeX.
+;;; cal-tex.el --- calendar functions for printing calendars with LaTeX
;; Copyright (C) 1995 Free Software Foundation, Inc.
＠＠ -24,7 +24,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
＠＠ -75,6 +75,11 ＠＠
:type 'boolean
:group 'calendar-tex)
+(defcustom cal-tex-rules nil
+ "*If t, pages will be ruled in some styles."
+:type 'boolean
+:group 'calendar-tex)
+
(defcustom cal-tex-daily-string
'(let* ((year (extract-calendar-year date))
(day (calendar-day-number date))
＠＠ -323,10 +328,10 ＠＠
(cal-tex-noindent)
(cal-tex-nl)
(calendar-for-loop i from 1 to 12 do
- (insert (cal-tex-mini-calendar i year
- (calendar-month-name i)
- "1in" ".9in" "tiny" "0.6mm")))
- (insert
+ (insert (cal-tex-mini-calendar i year
+ (calendar-month-name i)
+ "1in" ".9in" "tiny" "0.6mm")))
+ (insert
"\\noindent\\fbox{\\January}\\fbox{\\February}\\fbox{\\March}\\\\
\\noindent\\fbox{\\April}\\fbox{\\May}\\fbox{\\June}\\\\
\\noindent\\fbox{\\July}\\fbox{\\August}\\fbox{\\September}\\\\
＠＠ -505,15 +510,15 ＠＠
(calendar-for-loop i from 0 to 6 do
(if (memq i cal-tex-which-days)
(insert (format cal-tex-day-name-format
- (aref calendar-day-name-array
- (mod (+ calendar-week-start-day i) 7)))))
+ (aref calendar-day-name-array
+ (mod (+ calendar-week-start-day i) 7)))))
(cal-tex-comment)))
(defun cal-tex-insert-month-header (n month year end-month end-year)
"Create a title for a calendar.
A title is inserted for a calendar with N months starting with
MONTH YEAR and ending with END-MONTH END-YEAR."
- (let ( (month-name (calendar-month-name month))
+ (let ((month-name (calendar-month-name month))
(end-month-name (calendar-month-name end-month)))
(if (= 1 n)
(insert (format "\\calmonth{%s}{%s}\n\\vspace*{-0.5cm}"
＠＠ -923,9 +928,10 ＠＠
(if (not weekend)
(progn
(calendar-for-loop i from 8 to 12 do
- (insert (format "{\\large\\sf %d}\\\\\n" i)))
+ (insert (format "{\\large\\sf %d}\\\\\n" i)))
(calendar-for-loop i from 1 to 5 do
- (insert (format "{\\large\\sf %d}\\\\\n" i)))))
+ (insert (format "{\\large\\sf %d}\\\\\n"
+ (if cal-tex-24 (+ i 12) i))))))
(cal-tex-nl ".5cm")
(if weekend
(progn
＠＠ -1005,20 +1011,20 ＠＠
(if (= (extract-calendar-month date)
(extract-calendar-month d))
(format "%s %s"
- (calendar-month-name
- (extract-calendar-month date))
+ (calendar-month-name
+ (extract-calendar-month date))
(extract-calendar-year date))
(if (= (extract-calendar-year date)
(extract-calendar-year d))
(format "%s---%s %s"
- (calendar-month-name
- (extract-calendar-month date))
+ (calendar-month-name
+ (extract-calendar-month date))
(calendar-month-name
(extract-calendar-month d))
(extract-calendar-year date))
(format "%s %s---%s %s"
- (calendar-month-name
- (extract-calendar-month date))
+ (calendar-month-name
+ (extract-calendar-month date))
(extract-calendar-year date)
(calendar-month-name (extract-calendar-month d))
(extract-calendar-year d))))))
＠＠ -1196,7 +1202,8 ＠＠
"Day-per-page Filofax style calendar for week indicated by cursor.
Optional prefix argument specifies number of weeks. Weeks start on Monday.
Diary entries are included if `cal-tex-diary' is t.
-Holidays are included if `cal-tex-holidays' is t."
+Holidays are included if `cal-tex-holidays' is t.
+Pages are ruled if `cal-tex-rules' is t."
(interactive "P")
(let* ((n (if arg arg 1))
(date (calendar-gregorian-from-absolute
＠＠ -1231,28 +1238,32 ＠＠
\\long\\def\\rightday#1#2#3{%
\\rule{\\textwidth}{0.3pt}\\\\%
\\hbox to \\textwidth{%
- \\vbox to 1.85in{%
+ \\vbox {%
\\vspace*{2pt}%
\\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
\\hbox to \\textwidth{\\vbox {\\raggedleft \\em #2}}%
- \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #1}}}}}
+ \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
\\long\\def\\weekend#1#2#3{%
\\rule{\\textwidth}{0.3pt}\\\\%
\\hbox to \\textwidth{%
- \\vbox to 2in{%
+ \\vbox {%
\\vspace*{2pt}%
\\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
\\hbox to \\textwidth{\\vbox {\\noindent \\em #2}}%
- \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #1}}}}}
+ \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}
\\long\\def\\leftday#1#2#3{%
\\rule{\\textwidth}{0.3pt}\\\\%
\\hbox to \\textwidth{%
- \\vbox to 1.85in{%
+ \\vbox {%
\\vspace*{2pt}%
\\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
\\hbox to \\textwidth{\\vbox {\\noindent \\em #2}}%
- \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #1}}}}}
+ \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
+\\newbox\\LineBox
+\\setbox\\LineBox=\\hbox to\\textwidth{%
+\\vrule height.2in width0pt\\leaders\\hrule\\hfill}
+\\def\\linesfill{\\par\\leaders\\copy\\LineBox\\vfill}
")
(cal-tex-b-document)
(cal-tex-cmd "\\pagestyle{empty}")
＠＠ -1264,10 +1275,12 ＠＠
(insert "%\n")
(insert (if odd "\\rightday" "\\leftday")))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
- (cal-tex-arg (cal-tex-latexify-list holidays date))
+ (cal-tex-arg (cal-tex-latexify-list holidays date "\\\\" t))
(cal-tex-arg (eval cal-tex-daily-string))
(insert "%\n")
- (insert "\\vfill\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n")
+ (if cal-tex-rules
+ (insert "\\linesfill\n")
+ (insert "\\vfill\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n"))
(cal-tex-newpage)
(setq date (cal-tex-incr-date date)))
(insert "%\n")
＠＠ -1276,12 +1289,15 ＠＠
(cal-tex-arg (calendar-date-string date))
(insert "\\weekend")
(cal-tex-arg (cal-tex-latexify-list diary-list date))
- (cal-tex-arg (cal-tex-latexify-list holidays date))
+ (cal-tex-arg (cal-tex-latexify-list holidays date "\\\\" t))
(cal-tex-arg (eval cal-tex-daily-string))
(insert "%\n")
- (insert "\\vfill")
+ (if cal-tex-rules
+ (insert "\\linesfill\n")
+ (insert "\\vfill"))
(setq date (cal-tex-incr-date date)))
- (insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n")
+ (if (not cal-tex-rules)
+ (insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n"))
(if (/= i n)
(progn
(run-hooks 'cal-tex-week-hook)
＠＠ -1438,19 +1454,26 ＠＠
(calendar-gregorian-from-absolute
(+ (if n n 1) (calendar-absolute-from-gregorian date))))
-(defun cal-tex-latexify-list (date-list date &optional separator)
+(defun cal-tex-latexify-list (date-list date &optional separator final-separator)
"Return string with concatenated, LaTeXified entries in DATE_LIST for DATE.
-Use double backslash as a separator unless optional SEPARATOR is given."
- (mapconcat '(lambda (x) (cal-tex-LaTeXify-string x))
- (let ((result)
- (p date-list))
- (while p
- (and (car (car p))
- (calendar-date-equal date (car (car p)))
- (setq result (cons (car (cdr (car p))) result)))
- (setq p (cdr p)))
- (reverse result))
- (if separator separator "\\\\")))
+Use double backslash as a separator unless optional SEPARATOR is given.
+If resulting string is not empty, put separator at end if optional
+FINAL-SEPARATOR is t."
+ (let* ((sep (if separator separator "\\\\"))
+ (result
+ (mapconcat '(lambda (x) (cal-tex-LaTeXify-string x))
+ (let ((result)
+ (p date-list))
+ (while p
+ (and (car (car p))
+ (calendar-date-equal date (car (car p)))
+ (setq result (cons (car (cdr (car p))) result)))
+ (setq p (cdr p)))
+ (reverse result))
+ sep)))
+ (if (and final-separator (not (string-equal result "")))
+ (concat result sep)
+ result)))
(defun cal-tex-previous-month (date)
"Return the date of the first day in the month previous to DATE."
Index: cal-x.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-x.el,v
retrieving revision 1.4
diff -u -u -r1.4 cal-x.el
--- cal-x.el 2000/01/08 17:45:57 1.4
+++ cal-x.el 2006/07/17 23:30:38
＠＠ -6,7 +6,7 ＠＠
;; Edward M. Reingold <reingold(a)cs.uiuc.edu>
;; Modified for XEmacs by: Chuck Thompson <cthomp(a)cs.uiuc.edu>
;; Keywords: calendar
-;; Human-Keywords: calendar, dedicated frames, x-windows
+;; Human-Keywords: calendar, dedicated frames, X Window System
;; This file is part of GNU Emacs.
＠＠ -25,11 +25,11 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with (Mostly): FSF 20.5
+;;; Synched up with (Mostly): FSF 21.4
;;; Commentary:
-;; This collection of functions implements dedicated frames in x-windows for
+;; This collection of functions implements dedicated frames in X for
;; calendar.el.
;; Comments, corrections, and improvements should be sent to
＠＠ -89,7 +89,7 ＠＠
(defun calendar-one-frame-setup (&optional arg)
"Start calendar and display it in a dedicated frame together with the diary."
- (if (calendar-not-using-window-system-p)
+ (if (not (display-multi-frame-p))
(calendar-basic-setup arg)
(if (frame-live-p calendar-frame) (delete-frame calendar-frame))
(if (frame-live-p diary-frame) (delete-frame diary-frame))
＠＠ -115,7 +115,7 ＠＠
(defun calendar-only-one-frame-setup (&optional arg)
"Start calendar and display it in a dedicated frame."
- (if (calendar-not-using-window-system-p)
+ (if (not (display-multi-frame-p))
(calendar-basic-setup arg)
(if (frame-live-p calendar-frame) (delete-frame calendar-frame))
(let ((special-display-buffer-names nil)
＠＠ -132,7 +132,7 ＠＠
(defun calendar-two-frame-setup (&optional arg)
"Start calendar and diary in separate, dedicated frames."
- (if (calendar-not-using-window-system-p)
+ (if (not (display-multi-frame-p))
(calendar-basic-setup arg)
(if (frame-live-p calendar-frame) (delete-frame calendar-frame))
(if (frame-live-p diary-frame) (delete-frame diary-frame))
Index: cal-xemacs.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-xemacs.el,v
retrieving revision 1.5
diff -u -u -r1.5 cal-xemacs.el
--- cal-xemacs.el 2000/09/13 05:32:53 1.5
+++ cal-xemacs.el 2006/07/17 23:30:38
＠＠ -26,7 +26,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: cal-menu.el in Emacs 20.3
+;;; Synched up with: cal-menu.el in Emacs 21.4
;;; Commentary:
＠＠ -43,6 +43,19 ＠＠
(eval-when-compile (require 'calendar))
(require 'easymenu)
+
+;; XEmacs change
+;; not available until 21.5
+(unless (fboundp 'display-popup-menus-p)
+ (defun display-popup-menus-p (&optional display)
+ "Return non-nil if popup menus are supported on DISPLAY.
+DISPLAY can be a frame, a device, a console, or nil (meaning the selected
+frame). Support for popup menus requires that the mouse be available."
+ (and
+ (memq (framep-on-display display) '(x ns gtk mswindows))
+ (display-mouse-p display)))
+ )
+
(defconst calendar-popup-menu-3
'("Calendar"
＠＠ -64,7 +77,6 ＠＠
(define-key calendar-mode-map 'button2 'calendar-mouse-2-date-menu)
-
(defun cal-tex-mouse-filofax (e)
"Pop up sub-submenu for Mouse-2 for Filofax cal-tex commands for selected date."
(interactive "e")
＠＠ -160,7 +172,7 ＠＠
(add-submenu '("Calendar") calendar-diary-menu))
(if (not (assoc "Moon" current-menubar))
(add-menu-button '("Calendar") ["Moon" calendar-phases-of-moon t]))))
-
+
(defun cal-menu-list-holidays-year ()
"Display a list of the holidays of the selected date's year."
(interactive)
Index: calendar.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/calendar.el,v
retrieving revision 1.7
diff -u -u -r1.7 calendar.el
--- calendar.el 2003/08/28 06:57:28 1.7
+++ calendar.el 2006/07/17 23:30:39
＠＠ -1,7 +1,7 ＠＠
-;;; calendar.el --- Calendar functions.
+;;; calendar.el --- calendar functions
-;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997,
+;; 2000, 2001 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold(a)cs.uiuc.edu>
;; Keywords: calendar
＠＠ -26,7 +26,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with (Mostly): FSF 20.5
+;;; Synched up with (Mostly): FSF 21.4
;;; Commentary:
＠＠ -96,8 +96,50 ＠＠
;; reingold(a)cs.uiuc.edu 1304 West Springfield Avenue
;; Urbana, Illinois 61801
+;; XEmacs change
+;; not available until 21.5
+(unless (fboundp 'display-multi-frame-p)
+ (defun display-multi-frame-p ()
+ (not (null (memq (device-type) '(x mswindows gtk))))
+ ))
+
+;; XEmacs change
+;; not available until 21.5
+(unless (fboundp 'display-color-p)
+ (defun display-color-p ()
+ (eq 'color (device-class))
+ ))
+
+;; XEmacs change
+;; only available in MULE
+(unless (featurep 'mule)
+ (setq enable-multibyte-characters nil))
+
+; propertize appeared in XEmacs subr.el r21-5-7: 1.26
+(unless (fboundp 'propertize)
+;; `propertize' is a builtin in GNU Emacs 21.
+ (defun propertize (string &rest properties)
+ "Return a copy of STRING with text properties added.
+First argument is the string to copy.
+Remaining arguments form a sequence of PROPERTY VALUE pairs for text
+properties to add to the result."
+ (let ((str (copy-sequence string)))
+ (add-text-properties 0 (length str)
+ properties
+ str)
+ str))
+ )
+
;;; Code:
+(eval-when-compile
+ (defvar displayed-month)
+ (defvar displayed-year)
+ (defvar calendar-month-name-array)
+ (defvar calendar-starred-day))
+
+(require 'ibuffer)
+
(defun calendar-version ()
(interactive)
(message "Version 6, October 12, 1995"))
＠＠ -164,7 +206,7 ＠＠
;;;###autoload
(defcustom number-of-diary-entries 1
"*Specifies how many days of diary entries are to be displayed initially.
-This variable affects the diary display when the command M-x diary is used,
+This variable affects the diary display when the command \\[diary] is used,
or if the value of the variable `view-diary-entries-initially' is t. For
example, if the default value 1 is used, then only the current day's diary
entries will be displayed. If the value 2 is used, then both the current
＠＠ -197,35 +239,56 ＠＠
:type 'boolean
:group 'diary)
+;;;###autoload
+(defcustom calendar-remove-frame-by-deleting nil
+ "*Determine how the calendar mode removes a frame no longer needed.
+If nil, make an icon of the frame. If non-nil, delete the frame."
+:type 'boolean
+:group 'view)
+
+(defface diary-face
+ '((((class color) (background light))
+ (:foreground "red"))
+ (((class color) (background dark))
+ (:foreground "yellow"))
+ (t
+ (:weight bold t)))
+ "Face for highlighting diary entries."
+:group 'diary)
+
+(defface calendar-today-face
+ '((t (:underline t)))
+ "Face for indicating today's date."
+:group 'diary)
+
+(defface holiday-face
+ '((((class color) (background light))
+ (:background "pink"))
+ (((class color) (background dark))
+ (:background "chocolate4"))
+ (t
+ (:inverse-video t)))
+ "Face for indicating dates that have holidays."
+:group 'diary)
+
(defcustom diary-entry-marker
- (progn
- (make-face 'diary-face)
- (cond ((face-differs-from-default-p 'diary-face) nil)
- (t (set-face-foreground 'diary-face "red" 'global '(x color))
- (set-face-highlight-p 'diary-face t 'global 'tty)
- ;; avoid a weird problem when byte-compiling appt.el
- ;; in batch mode.
- (if (and (not noninteractive) (fboundp 'x-make-font-bold))
- (let ((bfont (x-make-font-bold
- (face-font-instance 'default)))
- (mono-tag (list 'x 'mono))
- (gray-tag (list 'x 'grayscale)))
- (if bfont
- (progn
- (set-face-font 'diary-face bfont 'global mono-tag)
- (set-face-font 'diary-face bfont 'global
- gray-tag)))))))
+ (if (not (display-color-p))
+ "+"
'diary-face)
"*How to mark dates that have diary entries.
The value can be either a single-character string or a face."
:type '(choice string face)
:group 'diary)
+(eval-after-load "facemenu"
+ '(progn
+ (add-to-list 'facemenu-unlisted-faces 'diary-face)
+ (add-to-list 'facemenu-unlisted-faces 'calendar-today-face)
+ (add-to-list 'facemenu-unlisted-faces 'holiday-face)))
+
(defcustom calendar-today-marker
- (progn
- (make-face 'calendar-today-face)
- (if (not (face-differs-from-default-p 'calendar-today-face))
- (set-face-underline-p 'calendar-today-face t))
+ (if (not (display-color-p))
+ "="
'calendar-today-face)
"*How to mark today's date in the calendar.
The value can be either a single-character string or a face.
＠＠ -235,22 +298,8 ＠＠
:group 'calendar)
(defcustom calendar-holiday-marker
- (progn
- (make-face 'holiday-face)
- (cond ((face-differs-from-default-p 'holiday-face) nil)
- (t (let ((color-tag (list 'x 'color))
- (mono-tag (list 'x 'mono))
- (gray-tag (list 'x 'grayscale)))
- (set-face-background 'holiday-face [default foreground] 'global
- mono-tag)
- (set-face-foreground 'holiday-face [default background] 'global
- mono-tag)
- (set-face-background 'holiday-face [default foreground] 'global
- gray-tag)
- (set-face-foreground 'holiday-face [default background] 'global
- gray-tag)
- (set-face-background 'holiday-face "pink" 'global color-tag)
- (set-face-reverse-p 'holiday-face t 'global 'tty))))
+ (if (not (display-color-p))
+ "*"
'holiday-face)
"*How to mark notable dates in the calendar.
The value can be either a single-character string or a face."
＠＠ -352,6 +401,18 ＠＠
:group 'calendar-hooks)
;;;###autoload
+(defcustom calendar-move-hook nil
+ "*List of functions called whenever the cursor moves in the calendar.
+
+For example,
+
+ (add-hook 'calendar-move-hook (lambda () (view-diary-entries 1)))
+
+redisplays the diary for whatever date the cursor is moved to."
+:type 'hook
+:group 'calendar-hooks)
+
+;;;###autoload
(defcustom diary-file "~/diary"
"*Name of the file in which one's personal diary of dates is kept.
＠＠ -478,7 +539,7 ＠＠
;;;###autoload
(defcustom sexp-diary-entry-symbol "%%"
- "*The string used to indicate a sexp diary entry in diary-file.
+ "*The string used to indicate a sexp diary entry in `diary-file'.
See the documentation for the function `list-sexp-diary-entries'."
:type 'string
:group 'diary)
＠＠ -518,6 +579,7 ＠＠
"*List of pseudo-patterns describing the American patterns of date used.
See the documentation of `diary-date-forms' for an explanation."
:type '(repeat (choice (cons :tag "Backup"
+ :value (backup . nil)
(const backup)
(repeat (list :inline t :format "%v"
(symbol :tag "Keyword")
＠＠ -531,12 +593,13 ＠＠
(defcustom european-date-diary-pattern
'((day "/" month "[^/0-9]")
(day "/" month "/" year "[^0-9]")
- (backup day " *" monthname "\\W+\\<[^*0-9]")
+ (backup day " *" monthname "\\W+\\<\\([^*0-9]\\|\\([0-9]+[:aApP]\\)\\)")
(day " *" monthname " *" year "[^0-9]")
(dayname "\\W"))
"*List of pseudo-patterns describing the European patterns of date used.
See the documentation of `diary-date-forms' for an explanation."
:type '(repeat (choice (cons :tag "Backup"
+ :value (backup . nil)
(const backup)
(repeat (list :inline t :format "%v"
(symbol :tag "Keyword")
＠＠ -551,7 +614,7 ＠＠
european-date-diary-pattern
american-date-diary-pattern)
"*List of pseudo-patterns describing the forms of date used in the diary.
-The patterns on the list must be MUTUALLY EXCLUSIVE and must should not match
+The patterns on the list must be MUTUALLY EXCLUSIVE and must not match
any portion of the diary entry itself, just the date component.
A pseudo-pattern is a list of regular expressions and the keywords `month',
＠＠ -573,6 +636,7 ＠＠
current word of the diary entry, so in no case can the pattern match more than
a portion of the first word of the diary entry."
:type '(repeat (choice (cons :tag "Backup"
+ :value (backup . nil)
(const backup)
(repeat (list :inline t :format "%v"
(symbol :tag "Keyword")
＠＠ -586,7 +650,7 ＠＠
(defcustom european-calendar-display-form
'((if dayname (concat dayname ", ")) day " " monthname " " year)
"*Pseudo-pattern governing the way a date appears in the European style.
-See the documentation of calendar-date-display-form for an explanation."
+See the documentation of `calendar-date-display-form' for an explanation."
:type 'sexp
:group 'calendar)
＠＠ -728,7 +792,7 ＠＠
"*List of functions called after marking diary entries in the calendar.
A function `mark-included-diary-files' is also provided for use as the
-mark-diary-entries-hook; it enables you to use shared diary files together
+`mark-diary-entries-hook'; it enables you to use shared diary files together
with your own. The files included are specified in the diary file by lines
of the form
#include \"filename\"
＠＠ -1023,7 +1087,7 ＠＠
(append general-holidays local-holidays other-holidays
christian-holidays hebrew-holidays islamic-holidays
oriental-holidays solar-holidays)
- "*List of notable days for the command M-x holidays.
+ "*List of notable days for the command \\[holidays].
Additional holidays are easy to add to the list, just put them in the list
`other-holidays' in your .emacs file. Similarly, by setting any of
＠＠ -1130,24 +1194,24 ＠＠
(defmacro increment-calendar-month (mon yr n)
"Move the variables MON and YR to the month and year by N months.
Forward if N is positive or backward if N is negative."
- (` (let (( macro-y (+ (* (, yr) 12) (, mon) -1 (, n) )))
- (setq (, mon) (1+ (% macro-y 12) ))
- (setq (, yr) (/ macro-y 12)))))
+ `(let ((macro-y (+ (* ,yr 12) ,mon -1 ,n)))
+ (setq ,mon (1+ (% macro-y 12)))
+ (setq ,yr (/ macro-y 12))))
(defmacro calendar-for-loop (var from init to final do &rest body)
"Execute a for loop."
- (` (let (( (, var) (1- (, init)) ))
- (while (>= (, final) (setq (, var) (1+ (, var))))
- (,＠ 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."
- (` (let (( (, index) (, initial))
+ `(let ((,index ,initial)
(sum 0))
- (while (, condition)
- (setq sum (+ sum (, expression) ))
- (setq (, index) (1+ (, index))))
- sum)))
+ (while ,condition
+ (setq sum (+ sum ,expression))
+ (setq ,index (1+ ,index)))
+ sum))
;; The following are in-line for speed; they can be called thousands of times
;; when looking up holidays or processing the diary. Here, for example, are
＠＠ -1192,7 +1256,7 ＠＠
(car (cdr (cdr date))))
(defsubst calendar-leap-year-p (year)
- "Returns t if YEAR is a Gregorian leap year."
+ "Return t if YEAR is a Gregorian leap year."
(and (zerop (% year 4))
(or (not (zerop (% year 100)))
(zerop (% year 400)))))
＠＠ -1328,6 +1392,9 ＠＠
"Move cursor to DATE."
t)
+(autoload 'calendar-only-one-frame-setup "cal-x"
+ "Start calendar and display it in a dedicated frame.")
+
(autoload 'calendar-one-frame-setup "cal-x"
"Start calendar and display it in a dedicated frame together with the diary.")
＠＠ -1345,7 +1412,10 ＠＠
;;;###autoload
(defun calendar (&optional arg)
"Choose between the one frame, two frame, or basic calendar displays.
-The original function `calendar' has been renamed `calendar-basic-setup'."
+If called with an optional prefix argument, prompts for month and year.
+
+The original function `calendar' has been renamed `calendar-basic-setup'.
+See the documentation of that function for more information."
(interactive "P")
(cond ((equal calendar-setup 'one-frame) (calendar-one-frame-setup arg))
((equal calendar-setup 'two-frames) (calendar-two-frame-setup arg))
＠＠ -1366,10 +1436,6 ＠＠
`number-of-diary-entries' controls the number of days of diary entries
displayed upon initial display of the calendar.
-An optional prefix argument ARG causes the calendar displayed to be ARG
-months in the future if ARG is positive or in the past if ARG is negative;
-in this case the cursor goes on the first day of the month.
-
Once in the calendar window, future or past months can be moved into view.
Arbitrary months can be displayed, or the calendar can be scrolled forward
or backward.
＠＠ -1382,7 +1448,7 ＠＠
Diary entries can be marked on the calendar or displayed in another window.
-Use M-x describe-mode for details of the key bindings in the calendar window.
+Use \\[describe-mode] for details of the key bindings in the calendar window.
The Gregorian calendar is assumed.
＠＠ -1510,10 +1576,14 ＠＠
"String of astronomical (Julian) day number of Gregorian date."
t)
-(autoload 'calendar-goto-astro-date "cal-julian"
+(autoload 'calendar-goto-astro-day-number "cal-julian"
"Move cursor to astronomical (Julian) day number."
t)
+(autoload 'calendar-print-astro-day-number "cal-julian"
+ "Show the astro date equivalents of date."
+ t)
+
(autoload 'calendar-julian-from-absolute "cal-julian"
"Compute the Julian (month day year) corresponding to the absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
＠＠ -1544,6 +1614,10 ＠＠
"String of ISO date of Gregorian date."
t)
+(autoload 'calendar-goto-islamic-date "cal-islam"
+ "Move cursor to Islamic date."
+ t)
+
(autoload 'calendar-print-islamic-date "cal-islam"
"Show the Islamic date equivalents of date."
t)
＠＠ -1776,9 +1850,13 ＠＠
(calendar-cursor-to-visible-date
(if today-visible today (list displayed-month 1 displayed-year)))
(set-buffer-modified-p nil)
- (or (one-window-p t)
- (/= (frame-width) (window-width))
- (shrink-window (- (window-height) 9)))
+ (if (or (one-window-p t) (/= (frame-width) (window-width)))
+ ;; Don't mess with the window size, but ensure that the first
+ ;; line is fully visible
+ (if (fboundp 'set-window-vscroll)
+ (set-window-vscroll nil 0))
+ ;; Adjust the window to exactly fit the displayed calendar
+ (ibuffer-shrink-to-fit ))
(sit-for 0)
(and mark-holidays-in-calendar
(mark-calendar-holidays)
＠＠ -1792,7 +1870,7 ＠＠
(defun generate-calendar (month year)
"Generate a three-month Gregorian calendar centered around MONTH, YEAR."
(if (< (+ month (* 12 (1- year))) 2)
- (error "Months before February, 1 AD are not available."))
+ (error "Months before February, 1 AD are not available"))
(setq displayed-month month)
(setq displayed-year year)
(erase-buffer)
＠＠ -1816,6 +1894,7 ＠＠
(goto-char (point-min))
(calendar-insert-indented
(calendar-string-spread
+ ;; XEmacs change - primarily for cal-japanese
(list (format "%s %s"
(calendar-month-name month)
(calendar-year-name year month 1))) ? 20)
＠＠ -1832,8 +1911,9 ＠＠
;; Put in the days of the month
(calendar-for-loop i from 1 to last do
(insert (format "%2d " i))
- (put-text-property (- (point) (if (< i 10) 2 3)) (1- (point))
- 'highlight t)
+ (add-text-properties (- (point) (if (< i 10) 2 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)
(calendar-insert-indented "" 0 t) ;; Force onto following line
＠＠ -1887,34 +1967,34 ＠＠
(setq l (cdr l))))
(define-key calendar-mode-map "-" 'negative-argument)
(define-key calendar-mode-map "\C-x>" 'scroll-calendar-right)
- (define-key calendar-mode-map '[prior] 'scroll-calendar-right-three-months)
- (define-key calendar-mode-map "\M-v" 'scroll-calendar-right-three-months)
+ (define-key calendar-mode-map [prior] 'scroll-calendar-right-three-months)
+ (define-key calendar-mode-map "\ev" 'scroll-calendar-right-three-months)
(define-key calendar-mode-map "\C-x<" 'scroll-calendar-left)
- (define-key calendar-mode-map '[next] 'scroll-calendar-left-three-months)
+ (define-key calendar-mode-map [next] 'scroll-calendar-left-three-months)
(define-key calendar-mode-map "\C-v" 'scroll-calendar-left-three-months)
(define-key calendar-mode-map "\C-b" 'calendar-backward-day)
(define-key calendar-mode-map "\C-p" 'calendar-backward-week)
- (define-key calendar-mode-map "\M-{" 'calendar-backward-month)
+ (define-key calendar-mode-map "\e{" 'calendar-backward-month)
(define-key calendar-mode-map "\C-x[" 'calendar-backward-year)
(define-key calendar-mode-map "\C-f" 'calendar-forward-day)
(define-key calendar-mode-map "\C-n" 'calendar-forward-week)
- (define-key calendar-mode-map '[left] 'calendar-backward-day)
- (define-key calendar-mode-map '[up] 'calendar-backward-week)
- (define-key calendar-mode-map '[right] 'calendar-forward-day)
- (define-key calendar-mode-map '[down] 'calendar-forward-week)
- (define-key calendar-mode-map "\M-}" 'calendar-forward-month)
+ (define-key calendar-mode-map [left] 'calendar-backward-day)
+ (define-key calendar-mode-map [up] 'calendar-backward-week)
+ (define-key calendar-mode-map [right] 'calendar-forward-day)
+ (define-key calendar-mode-map [down] 'calendar-forward-week)
+ (define-key calendar-mode-map "\e}" 'calendar-forward-month)
(define-key calendar-mode-map "\C-x]" 'calendar-forward-year)
(define-key calendar-mode-map "\C-a" 'calendar-beginning-of-week)
(define-key calendar-mode-map "\C-e" 'calendar-end-of-week)
- (define-key calendar-mode-map "\M-a" 'calendar-beginning-of-month)
- (define-key calendar-mode-map "\M-e" 'calendar-end-of-month)
- (define-key calendar-mode-map "\M-<" 'calendar-beginning-of-year)
- (define-key calendar-mode-map "\M->" 'calendar-end-of-year)
+ (define-key calendar-mode-map "\ea" 'calendar-beginning-of-month)
+ (define-key calendar-mode-map "\ee" 'calendar-end-of-month)
+ (define-key calendar-mode-map "\e<" 'calendar-beginning-of-year)
+ (define-key calendar-mode-map "\e>" 'calendar-end-of-year)
(define-key calendar-mode-map "\C-＠" 'calendar-set-mark)
;; Many people are used to typing C-SPC and getting C-＠.
- (define-key calendar-mode-map "\C- " 'calendar-set-mark)
+ (define-key calendar-mode-map [?\C- ] 'calendar-set-mark)
(define-key calendar-mode-map "\C-x\C-x" 'calendar-exchange-point-and-mark)
- (define-key calendar-mode-map "\M-=" 'calendar-count-days-region)
+ (define-key calendar-mode-map "\e=" 'calendar-count-days-region)
(define-key calendar-mode-map "gd" 'calendar-goto-date)
(define-key calendar-mode-map "gj" 'calendar-goto-julian-date)
(define-key calendar-mode-map "ga" 'calendar-goto-astro-day-number)
＠＠ -1993,7 +2073,7 ＠＠
(define-key calendar-mode-map "tY" 'cal-tex-cursor-year-landscape))
(defun describe-calendar-mode ()
- "Create a help buffer with a brief description of the calendar-mode."
+ "Create a help buffer with a brief description of the `calendar-mode'."
(interactive)
(with-output-to-temp-buffer "*Help*"
(princ
＠＠ -2010,13 +2090,38 ＠＠
;; Calendar mode is suitable only for specially formatted data.
(put 'calendar-mode 'mode-class 'special)
+;; XEmacs - usage of propertize here is essentially a no-op.
+;; xemacs doesn't support text properties in the mode-line.
+;;
(defvar calendar-mode-line-format
(list
- (substitute-command-keys "\\<calendar-mode-map>\\[scroll-calendar-left]")
+ (propertize (substitute-command-keys
+ "\\<calendar-mode-map>\\[scroll-calendar-left]")
+ 'help-echo "mouse-2: scroll left"
+ )
"Calendar"
- (substitute-command-keys "\\<calendar-mode-map>\\[calendar-goto-info-node] info/\\[calendar-other-month] other/\\[calendar-goto-today] today")
- '(calendar-date-string (calendar-current-date) t)
- (substitute-command-keys "\\<calendar-mode-map>\\[scroll-calendar-right]"))
+ (concat
+ (propertize
+ (substitute-command-keys
+ "\\<calendar-mode-map>\\[calendar-goto-info-node] info")
+ 'help-echo "mouse-2: read Info on Calendar"
+ )
+ "/"
+ (propertize
+ (substitute-command-keys
+ "\\<calendar-mode-map>\\[calendar-other-month] other")
+ 'help-echo "mouse-2: choose another month"
+ )
+ "/"
+ (propertize
+ (substitute-command-keys
+ "\\<calendar-mode-map>\\[calendar-goto-today] today")
+ 'help-echo "mouse-2: go to today's date"
+ '(calendar-date-string (calendar-current-date) t)))
+ (propertize (substitute-command-keys
+ "\\<calendar-mode-map>\\[scroll-calendar-right]")
+ 'help-echo "mouse-2: scroll right"
+ ))
"The mode line of the calendar buffer.")
(defun calendar-goto-info-node ()
＠＠ -2026,7 +2131,7 ＠＠
(let ((where (save-window-excursion
(Info-find-emacs-command-nodes 'calendar))))
(if (not where)
- (error "Couldn't find documentation for the calendar.")
+ (error "Couldn't find documentation for the calendar")
(let (same-window-buffer-names)
(info))
(Info-find-node (car (car where)) (car (cdr (car where)))))))
＠＠ -2046,7 +2151,7 ＠＠
(setq buffer-read-only t)
(setq indent-tabs-mode nil)
(update-calendar-mode-line)
- (if (and (string-match "XEmacs" emacs-version)
+ (if (and (featurep 'xemacs)
(featurep 'menubar) current-menubar)
(progn
(require 'cal-xemacs)
＠＠ -2054,7 +2159,6 ＠＠
(make-variable-buffer-local 'scroll-on-clipped-lines)
(setq scroll-on-clipped-lines nil)))
- (make-local-hook 'activate-menubar-hook)
(add-hook 'activate-menubar-hook 'cal-menu-update nil t)
(make-local-variable 'calendar-mark-ring)
(make-local-variable 'displayed-month);; Month in middle of window.
＠＠ -2073,7 +2177,9 ＠＠
(if (< (length strings) 2)
(append (list "") strings (list ""))
strings)))
+ ;; XEmacs change. Mule vs non-Mule
(func (if (fboundp 'string-width) 'string-width 'length))
+ ;; XEmacs change. primarily for cal-japanese.
(n (- length (funcall func (apply 'concat strings))))
(m (1- (length strings)))
(s (car strings))
＠＠ -2085,6 +2191,7 ＠＠
(car strings)))
(setq i (1+ i))
(setq strings (cdr strings)))
+ ;; XEmacs change - primarily for cal-japanese
(truncate-string-to-width s length)))
(defun update-calendar-mode-line ()
＠＠ -2094,13 +2201,13 ＠＠
(set-buffer calendar-buffer)
(setq mode-line-format
(calendar-string-spread
- calendar-mode-line-format ? (frame-width))))))
+ calendar-mode-line-format ? (frame-width))))))
(defun calendar-window-list ()
"List of all calendar-related windows."
(let ((calendar-buffers (calendar-buffer-list))
list)
- (walk-windows '(lambda (w)
+ (walk-windows (lambda (w)
(if (memq (window-buffer w) calendar-buffers)
(setq list (cons w list))))
nil t)
＠＠ -2142,32 +2249,34 ＠＠
(let ((buffer (if (window-live-p window) (window-buffer window))))
(if (memq buffer (calendar-buffer-list))
(cond
- ((and window-system
+ ((and (display-multi-frame-p)
(eq 'icon (cdr (assoc 'visibility
(frame-parameters
(window-frame window))))))
nil)
- ((and window-system (window-dedicated-p window))
- (iconify-frame (window-frame window)))
+ ((and (display-multi-frame-p) (window-dedicated-p window))
+ (if calendar-remove-frame-by-deleting
+ (delete-frame (window-frame window))
+ (iconify-frame (window-frame window))))
((not (and (select-window window) (one-window-p window)))
(delete-window window))
(t (set-buffer buffer)
(bury-buffer))))))
(defun calendar-current-date ()
- "Returns the current date in a list (month day year)."
+ "Return the current date in a list (month day year)."
(let ((now (decode-time)))
(list (nth 4 now) (nth 3 now) (nth 5 now))))
(defun calendar-cursor-to-date (&optional error)
- "Returns a list (month day year) of current cursor position.
+ "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."
;; #### This check is to avoid a race condition created by
;; pop-to-buffer's call to other-window interacting with the 19.13
;; changes allowing that to be in another frame.
- (if (not (number-or-marker-p displayed-month))
- nil
+; (if (not (number-or-marker-p displayed-month))
+; nil
(let* ((segment (/ (current-column) 25))
(month (% (+ displayed-month segment -1) 12))
(month (if (= 0 month) 12 month))
＠＠ -2190,7 +2299,8 ＠＠
(if (looking-at ".\\*\\*")
(list month calendar-starred-day year)
(if error (error "Not on a date!"))))
- (if error (error "Not on a date!")))))))
+ (if error (error "Not on a date!"))))))
+;)
;; The following version of calendar-gregorian-from-absolute is preferred for
;; reasons of clarity, BUT it's much slower than the version that follows it.
＠＠ -2319,13 +2429,13 ＠＠
value))
(defun calendar-read-date (&optional noday)
- "Prompt for Gregorian date. Returns a list (month day year).
+ "Prompt for Gregorian date. Return a list (month day year).
If optional NODAY is t, does not ask for day, but just returns
\(month nil year); if NODAY is any other non-nil value the value returned is
\(month year) "
(let* ((year (calendar-read
"Year (>0): "
- '(lambda (x) (> x 0))
+ (lambda (x) (> x 0))
(int-to-string (extract-calendar-year
(calendar-current-date)))))
(month-array calendar-month-name-array)
＠＠ -2343,7 +2453,7 ＠＠
(list month year))
(list month
(calendar-read (format "Day (1-%d): " last)
- '(lambda (x) (and (< 0 x) (<= x last))))
+ (lambda (x) (and (< 0 x) (<= x last))))
year))))
(defun calendar-interval (mon1 yr1 mon2 yr2)
＠＠ -2352,21 +2462,26 ＠＠
(- mon2 mon1)))
(defun calendar-day-name (date &optional width absolute)
- "Returns a string with the name of the day of the week of DATE.
+ "Return a string with the name of the day of the week of DATE.
If WIDTH is non-nil, return just the first WIDTH characters of the name.
If ABSOLUTE is non-nil, then DATE is actually the day-of-the-week
rather than a date."
(let ((string (aref calendar-day-name-array
(if absolute date (calendar-day-of-week date)))))
- (if width
- (let ((i 0) (result "") (pos 0))
- (while (and (< i width) (< i (length string)))
- (let ((chartext (char-to-string (aref string pos))))
- (setq pos (+ pos (length chartext)))
- (setq result (concat result chartext)))
- (setq i (1+ i)))
- result)
- string)))
+; (if width
+; (let ((i 0) (result "") (pos 0))
+; (while (and (< i width) (< i (length string)))
+; (let ((chartext (char-to-string (aref string pos))))
+; (setq pos (+ pos (length chartext)))
+; (setq result (concat result chartext)))
+; (setq i (1+ i)))
+; result)
+; string)))
+
+ (cond ((null width) string)
+ (enable-multibyte-characters (truncate-string-to-width string width))
+ (t (substring string 0 width)))))
+
(defvar calendar-english-day-name-array
["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"])
＠＠ -2385,7 +2500,7 ＠＠
If FILTER is provided, apply it to each item in the list."
(let ((index (if start-index (1- start-index) 0)))
(mapcar
- '(lambda (x)
+ (lambda (x)
(setq index (1+ index))
(cons (if filter (funcall filter x) x)
index))
＠＠ -2397,6 +2512,7 ＠＠
(let ((string (aref calendar-month-name-array (1- month))))
(if width
(let ((i 0) (result "") (pos 0))
+ ;; XEmacs change - primarily for cal-japanese.
(while (and (< i width) (< i (length string)))
(let ((chartext (char-to-string (aref string pos))))
(setq pos (+ pos (length chartext)))
＠＠ -2413,7 +2529,7 ＠＠
(funcall calendar-year-name-function year month day))
(defun calendar-day-of-week (date)
- "Returns the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc."
+ "Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc."
(% (calendar-absolute-from-gregorian date) 7))
(defun calendar-unmark ()
＠＠ -2424,14 +2540,14 ＠＠
(redraw-calendar))
(defun calendar-date-is-visible-p (date)
- "Returns t if DATE is legal and is visible in the calendar window."
+ "Return t if DATE is legal and is visible in the calendar window."
(let ((gap (calendar-interval
displayed-month displayed-year
(extract-calendar-month date) (extract-calendar-year date))))
(and (calendar-date-is-legal-p date) (> 2 gap) (< -2 gap))))
(defun calendar-date-is-legal-p (date)
- "Returns t if DATE is a legal date."
+ "Return t if DATE is a legal date."
(let ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date)))
＠＠ -2440,7 +2556,7 ＠＠
(<= 1 year))))
(defun calendar-date-equal (date1 date2)
- "Returns t if the DATE1 and DATE2 are the same."
+ "Return t if the DATE1 and DATE2 are the same."
(and
(= (extract-calendar-month date1) (extract-calendar-month date2))
(= (extract-calendar-day date1) (extract-calendar-day date2))
＠＠ -2449,7 +2565,7 ＠＠
(defun mark-visible-calendar-date (date &optional mark)
"Mark DATE in the calendar window with MARK.
MARK is either a single-character string or a face.
-MARK defaults to diary-entry-marker."
+MARK defaults to `diary-entry-marker'."
(if (calendar-date-is-legal-p date)
(save-excursion
(set-buffer calendar-buffer)
＠＠ -2466,10 +2582,10 ＠＠
(defun calendar-star-date ()
"Replace the date under the cursor in the calendar window with asterisks.
-This function can be used with the today-visible-calendar-hook run after the
+This function can be used with the `today-visible-calendar-hook' run after the
calendar window has been prepared."
- (let ((buffer-read-only nil))
- (make-variable-buffer-local 'calendar-starred-day)
+ (let ((inhibit-read-only t))
+ (make-local-variable 'calendar-starred-day)
(forward-char 1)
(setq calendar-starred-day
(string-to-int
＠＠ -2481,15 +2597,15 ＠＠
(defun calendar-mark-today ()
"Mark the date under the cursor in the calendar window.
-The date is marked with calendar-today-marker. This function can be used with
-the today-visible-calendar-hook run after the calendar window has been
+The date is marked with `calendar-today-marker'. This function can be used with
+the `today-visible-calendar-hook' run after the calendar window has been
prepared."
(mark-visible-calendar-date
(calendar-cursor-to-date)
calendar-today-marker))
(defun calendar-date-compare (date1 date2)
- "Returns t if DATE1 is before DATE2, nil otherwise.
+ "Return t if DATE1 is before DATE2, nil otherwise.
The actual dates are in the car of DATE1 and DATE2."
(< (calendar-absolute-from-gregorian (car date1))
(calendar-absolute-from-gregorian (car date2))))
＠＠ -2516,7 +2632,7 ＠＠
(mapconcat 'eval calendar-date-display-form "")))
(defun calendar-dayname-on-or-before (dayname date)
- "Returns the absolute date of the DAYNAME on or before absolute DATE.
+ "Return the absolute date of the DAYNAME on or before absolute DATE.
DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.
Note: Applying this function to d+6 gives us the DAYNAME on or after an
Index: diary-lib.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/diary-lib.el,v
retrieving revision 1.4
diff -u -u -r1.4 diary-lib.el
--- diary-lib.el 2000/01/08 17:45:57 1.4
+++ diary-lib.el 2006/07/17 23:30:40
＠＠ -1,4 +1,4 ＠＠
-;;; diary-lib.el --- diary functions.
+;;; diary-lib.el --- diary functions
;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995 Free Software
;; Foundation, Inc.
＠＠ -23,7 +23,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; (Mostly) Synched up with: FSF 20.5
+;;; (Mostly) Synched up with: FSF 21.4
;;; XEmacs has extra function `diary-countdown'
;;; Commentary:
＠＠ -100,23 +100,23 ＠＠
t)
(autoload 'diary-french-date "cal-french"
- "French calendar equivalent of date diary entry."
+ "French calendar equivalent of date diary entry."
t)
(autoload 'diary-mayan-date "cal-mayan"
- "Mayan calendar equivalent of date diary entry."
+ "Mayan calendar equivalent of date diary entry."
t)
(autoload 'diary-iso-date "cal-iso"
- "ISO calendar equivalent of date diary entry."
+ "ISO calendar equivalent of date diary entry."
t)
(autoload 'diary-julian-date "cal-julian"
- "Julian calendar equivalent of date diary entry."
+ "Julian calendar equivalent of date diary entry."
t)
(autoload 'diary-astro-day-number "cal-julian"
- "Astronomical (Julian) day number diary entry."
+ "Astronomical (Julian) day number diary entry."
t)
(autoload 'diary-chinese-date "cal-china"
＠＠ -124,27 +124,27 ＠＠
t)
(autoload 'diary-islamic-date "cal-islam"
- "Islamic calendar equivalent of date diary entry."
+ "Islamic calendar equivalent of date diary entry."
t)
(autoload 'list-islamic-diary-entries "cal-islam"
- "Add any Islamic date entries from the diary file to `diary-entries-list'."
+ "Add any Islamic date entries from the diary file to `diary-entries-list'."
t)
(autoload 'mark-islamic-diary-entries "cal-islam"
- "Mark days in the calendar window that have Islamic date diary entries."
+ "Mark days in the calendar window that have Islamic date diary entries."
t)
(autoload 'mark-islamic-calendar-date-pattern "cal-islam"
"Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR."
- t)
+ t)
(autoload 'diary-hebrew-date "cal-hebrew"
"Hebrew calendar equivalent of date diary entry."
t)
(autoload 'diary-omer "cal-hebrew"
- "Omer count diary entry."
+ "Omer count diary entry."
t)
(autoload 'diary-yahrzeit "cal-hebrew"
＠＠ -169,7 +169,7 ＠＠
(autoload 'mark-hebrew-calendar-date-pattern "cal-hebrew"
"Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR."
- t)
+ t)
(autoload 'diary-coptic-date "cal-coptic"
"Coptic calendar equivalent of date diary entry."
＠＠ -200,6 +200,7 ＠＠
syntax of `*' changed to be a word constituent.")
(modify-syntax-entry ?* "w" diary-syntax-table)
+(modify-syntax-entry ?: "w" diary-syntax-table)
;;;###autoload
(defun list-diary-entries (date number)
＠＠ -239,7 +240,7 ＠＠
(if (< 0 number)
(let* ((original-date date);; save for possible use in the hooks
(old-diary-syntax-table)
- (diary-entries-list)
+ (diary-entries-list)
(date-string (calendar-date-string date))
(d-file (substitute-in-file-name diary-file)))
(message "Preparing diary...")
＠＠ -258,10 +259,12 ＠＠
(let ((buffer-read-only nil)
(diary-modified (buffer-modified-p))
(mark (regexp-quote diary-nonmarking-symbol)))
+ ;; First and last characters must be ^M or \n for
+ ;; selective display to work properly
(goto-char (1- (point-max)))
(if (not (looking-at "\^M\\|\n"))
(progn
- (forward-char 1)
+ (goto-char (point-max))
(insert-string "\^M")))
(goto-char (point-min))
(if (not (looking-at "\^M\\|\n"))
＠＠ -325,12 +328,12 ＠＠
(point) ?\^M ?\n t)
(add-to-diary-list
date
- (buffer-substring-no-properties
+ (buffer-substring-no-properties
entry-start (point))
(buffer-substring-no-properties
- (1+ date-start) (1- entry-start)))))))
- (setq d (cdr d)))
- (or entry-found
+ (1+ date-start) (1- entry-start)) )))))
+ (setq d (cdr d)))
+ (or entry-found
(not diary-list-include-blanks)
(setq diary-entries-list
(append diary-entries-list
＠＠ -366,20 +369,29 ＠＠
(regexp-quote diary-include-string)
" \"\\([^\"]*\\)\"")
nil t)
- (let ((diary-file (substitute-in-file-name
+ (let* ((diary-file (substitute-in-file-name
(buffer-substring-no-properties
(match-beginning 2) (match-end 2))))
(diary-list-include-blanks nil)
(list-diary-entries-hook 'include-other-diary-files)
(diary-display-hook 'ignore)
- (diary-hook nil))
+ (diary-hook nil)
+ (d-buffer (find-buffer-visiting diary-file))
+ (diary-modified (if d-buffer
+ (save-excursion
+ (set-buffer d-buffer)
+ (buffer-modified-p)))))
(if (file-exists-p diary-file)
(if (file-readable-p diary-file)
(unwind-protect
(setq diary-entries-list
(append diary-entries-list
(list-diary-entries original-date number)))
- (kill-buffer (find-buffer-visiting diary-file)))
+ (save-excursion
+ (set-buffer (find-buffer-visiting diary-file))
+ (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
+ (setq selective-display nil)
+ (set-buffer-modified-p diary-modified)))
(beep)
(message "Can't read included diary file %s" diary-file)
(sleep-for 2))
＠＠ -494,7 +506,7 ＠＠
(if date-holiday-list (insert ": "))
(let* ((l (current-column))
(longest 0))
- (insert (mapconcat '(lambda (x)
+ (insert (mapconcat (lambda (x)
(if (< longest (length x))
(setq longest (length x)))
x)
＠＠ -625,32 +637,23 ＠＠
system. Alternatively, you can specify a cron entry:
0 1 * * * diary-rem.sh
to run it every morning at 1am."
- (interactive "p")
- (let ((text nil)
- ;; Use the fancy-diary-display as it doesn't hide rest of
- ;; diary file with ^M characters. It also looks nicer.
- (diary-display-hook 'fancy-diary-display))
- (if (not current-prefix-arg)
- (setq ndays diary-mail-days))
- (calendar)
- (view-diary-entries ndays)
- (set-buffer fancy-diary-buffer)
- (setq text (buffer-substring (point-min) (point-max)))
-
- ;; Now send text as a mail message.
- (mail)
- (mail-to)
- (insert diary-mail-addr)
- (mail-subject)
- (insert "Diary entries generated ")
- (insert (format-time-string "%a %d %b %Y" (current-time)))
- (mail-text)
- (insert text)
- (mail-send-and-exit nil)
- (exit-calendar)))
+ (interactive "P")
+ (let* ((diary-display-hook 'fancy-diary-display)
+ (diary-list-include-blanks t)
+ (text (progn (list-diary-entries (calendar-current-date)
+ (if ndays ndays diary-mail-days))
+ (set-buffer fancy-diary-buffer)
+ (buffer-substring (point-min) (point-max)))))
+ (mail)
+ (mail-to) (insert diary-mail-addr)
+ (mail-subject) (insert "Diary entries generated "
+ (calendar-date-string (calendar-current-date)))
+ (mail-text) (insert text)
+ (mail-send-and-exit nil)))
+
(defun diary-name-pattern (string-array &optional fullname)
- "Convert an STRING-ARRAY, an array of strings to a pattern.
+ "Convert a STRING-ARRAY, an array of strings to a pattern.
The pattern will match any of the strings, either entirely or abbreviated
to three characters. An abbreviated form will match with or without a period;
If the optional FULLNAME is t, abbreviations will not match, just the full
＠＠ -774,7 +777,7 ＠＠
(calendar-make-alist
calendar-day-name-array
0
- '(lambda (x) (substring x 0 3))))))
+ (lambda (x) (substring x 0 3))))))
(if mm-name
(if (string-equal mm-name "*")
(setq mm 0)
＠＠ -784,7 +787,7 ＠＠
(calendar-make-alist
calendar-month-name-array
1
- '(lambda (x) (substring x 0 3)))
+ (lambda (x) (substring x 0 3)))
)))))
(mark-calendar-date-pattern mm dd yy))))
(setq d (cdr d))))
＠＠ -808,7 +811,7 ＠＠
(m)
(y)
(first-date)
- (last-date))
+ (last-date))
(save-excursion
(set-buffer calendar-buffer)
(setq m displayed-month)
＠＠ -968,20 +971,20 ＠＠
XX:XX (military time), and XXam, XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm,
or XX:XXPM."
(let ((case-fold-search nil))
- (cond ((string-match;; Military time
- "^[ \t]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s)
+ (cond ((string-match;; Military time
+ "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s)
(+ (* 100 (string-to-int
(substring s (match-beginning 1) (match-end 1))))
(string-to-int (substring s (match-beginning 2) (match-end 2)))))
((string-match;; Hour only XXam or XXpm
- "^[ \t]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
+ "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
(+ (* 100 (% (string-to-int
(substring s (match-beginning 1) (match-end 1)))
12))
(if (equal ?a (downcase (aref s (match-beginning 2))))
0 1200)))
((string-match;; Hour and minute XX:XXam or XX:XXpm
- "^[ \t]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
+ "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
(+ (* 100 (% (string-to-int
(substring s (match-beginning 1) (match-end 1)))
12))
＠＠ -990,6 +993,8 ＠＠
0 1200)))
(t diary-unknown-time))));; Unrecognizable
+;; Unrecognizable
+
(defun list-sexp-diary-entries (date)
"Add sexp entries for DATE from the diary file to `diary-entries-list'.
Also, Make them visible in the diary file. Returns t if any entries were
＠＠ -1022,7 +1027,7 ＠＠
`european-calendar-style' is nil, and DAY, MONTH, YEAR if
`european-calendar-style' is t. DAY, MONTH, and YEAR
can be lists of integers, the constant t, or an integer.
- The constant t means all values.
+ The constant t means all values.
%%(diary-float MONTH DAYNAME N &optional DAY) text
Entry will appear on the Nth DAYNAME of MONTH.
＠＠ -1031,13 +1036,13 ＠＠
the month. MONTH can be a list of months, a single
month, or t to specify all months. Optional DAY means
Nth DAYNAME of MONTH on or after/before DAY. DAY defaults
- to 1 if N>0 and the last day of the month if N<0.
+ to 1 if N>0 and the last day of the month if N<0.
%%(diary-block M1 D1 Y1 M2 D2 Y2) text
Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2,
inclusive. (If `european-calendar-style' is t, the
order of the parameters should be changed to D1, M1, Y1,
- D2, M2, Y2.)
+ D2, M2, Y2.)
%%(diary-countdown BEFORE AFTER M1 D1 Y1) text
Entry will appear on dates between BEFORE days before
＠＠ -1054,7 +1059,7 ＠＠
of years since the MONTH DAY, YEAR and %s will be replaced
by the ordinal ending of that number (that is, `st', `nd',
`rd' or `th', as appropriate. The anniversary of February
- 29 is considered to be March 1 in a non-leap year.
+ 29 is considered to be March 1 in a non-leap year.
%%(diary-cyclic N MONTH DAY YEAR) text
Entry will appear every N days, starting MONTH DAY, YEAR.
＠＠ -1063,7 +1068,7 ＠＠
can contain %d or %d%s; %d will be replaced by the number
of repetitions since the MONTH DAY, YEAR and %s will
be replaced by the ordinal ending of that number (that is,
- `st', `nd', `rd' or `th', as appropriate.
+ `st', `nd', `rd' or `th', as appropriate.
%%(diary-remind SEXP DAYS &optional MARKING) text
Entry is a reminder for diary sexp SEXP. DAYS is either a
＠＠ -1212,11 +1217,11 ＠＠
lines)))
diary-file sexp)
(sleep-for 2))))))
- (if (stringp result)
- result
+ (if (stringp result)
+ result
(if result
- entry
- nil))))
+ entry
+ nil))))
(defun diary-date (month day year)
"Specific date(s) diary entry.
＠＠ -1260,7 +1265,7 ＠＠
(list m2 d2 y2))))
(d (calendar-absolute-from-gregorian date)))
(if (and (<= date1 d) (<= d date2))
- entry)))
+ entry)))
(defun diary-countdown (before after m1 d1 y1)
"Countdown diary entry.
＠＠ -1314,9 +1319,10 ＠＠
(d2 (extract-calendar-day last))
(y2 (extract-calendar-year last)))
(if (or (and (= m1 m2) ; only possible base dates in one month
- (or (and (listp month) (memq m1 month))
- (eq month t)
- (= m1 month))
+ (or (eq month t)
+ (if (listp month)
+ (memq m1 month)
+ (= m1 month)))
(let ((d (or day (if (> n 0)
1
(calendar-last-day-of-month m1 y1)))))
＠＠ -1327,22 +1333,25 ＠＠
(or
;; m1, d1 works as a base date
(and
- (or (and (listp month) (memq m1 month))
- (eq month t)
- (= m1 month))
+ (or (eq month t)
+ (if (listp month)
+ (memq m1 month)
+ (= m1 month)))
(<= d1 (or day (if (> n 0)
1
(calendar-last-day-of-month m1 y1)))))
;; m2, d2 works as a base date
- (and (or (and (listp month) (memq m2 month))
- (eq month t)
- (= m2 month))
+ (and (or (eq month t)
+ (if (listp month)
+ (memq m2 month)
+ (= m2 month)))
(<= (or day (if (> n 0)
1
(calendar-last-day-of-month m2 y2)))
d2)))))
entry))))
+
(defun diary-anniversary (month day year)
"Anniversary diary entry.
Entry applies if date is the anniversary of MONTH, DAY, YEAR if
＠＠ -1364,14 +1373,15 ＠＠
(setq m 3
d 1))
(if (and (> diff 0) (calendar-date-equal (list m d y) date))
- (format entry diff (diary-ordinal-suffix diff)))))
+ (format entry diff (diary-ordinal-suffix diff)))))
(defun diary-cyclic (n month day year)
"Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR.
If `european-calendar-style' is t, parameters are N, DAY, MONTH, YEAR.
ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of
-years since the MONTH DAY, YEAR and the %s will be replaced by the ordinal
-ending of that number (that is, `st', `nd', `rd' or `th', as appropriate."
+repetitions since the MONTH DAY, YEAR and %s will be replaced by the
+ordinal ending of that number (that is, `st', `nd', `rd' or `th', as
+appropriate."
(let* ((d (if european-calendar-style
month
day))
＠＠ -1383,7 +1393,7 ＠＠
(list m d year))))
(cycle (/ diff n)))
(if (and (>= diff 0) (zerop (% diff n)))
- (format entry cycle (diary-ordinal-suffix cycle)))))
+ (format entry cycle (diary-ordinal-suffix cycle)))))
(defun diary-ordinal-suffix (n)
"Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)"
＠＠ -1459,7 +1469,15 ＠＠
If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
(find-file-other-window
(substitute-in-file-name (if file file diary-file)))
+ (widen)
(goto-char (point-max))
+ (when (let ((case-fold-search t))
+ (search-backward "Local Variables:"
+ (max (- (point-max) 3000) (point-min))
+ t))
+ (beginning-of-line)
+ (insert "\n")
+ (previous-line 1))
(insert
(if (bolp) "" "\n")
(if nonmarking diary-nonmarking-symbol "")
＠＠ -1553,7 +1571,7 ＠＠
(format "%s(diary-cyclic %d %s)"
sexp-diary-entry-symbol
(calendar-read "Repeat every how many days: "
- '(lambda (x) (> x 0)))
+ (lambda (x) (> x 0)))
(calendar-date-string (calendar-cursor-to-date t) nil t))
arg)))
Index: holidays.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/holidays.el,v
retrieving revision 1.5
diff -u -u -r1.5 holidays.el
--- holidays.el 2000/01/08 17:45:58 1.5
+++ holidays.el 2006/07/17 23:30:40
＠＠ -22,7 +22,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
Index: lunar.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/lunar.el,v
retrieving revision 1.4
diff -u -u -r1.4 lunar.el
--- lunar.el 2000/01/08 17:45:58 1.4
+++ lunar.el 2006/07/17 23:30:40
＠＠ -1,4 +1,4 ＠＠
-;;; lunar.el --- calendar functions for phases of the moon.
+;;; lunar.el --- calendar functions for phases of the moon
;; Copyright (C) 1992, 1993, 1995, 1997 Free Software Foundation, Inc.
＠＠ -23,7 +23,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
＠＠ -53,7 +53,7 ＠＠
(if (fboundp 'atan)
(require 'lisp-float-type)
- (error "Lunar calculations impossible since floating point is unavailable."))
+ (error "Lunar calculations impossible since floating point is unavailable"))
(require 'solar)
＠＠ -239,7 +239,7 ＠＠
(calendar-phases-of-moon))))
(defun diary-phases-of-moon ()
- "Moon phases diary entry."
+"Moon phases diary entry."
(let* ((index (* 4
(truncate
(* 12.3685
＠＠ -252,8 +252,8 ＠＠
(setq index (1+ index))
(setq phase (lunar-phase index)))
(if (calendar-date-equal (car phase) date)
- (concat (lunar-phase-name (car (cdr (cdr phase)))) " "
- (car (cdr phase))))))
+ (concat (lunar-phase-name (car (cdr (cdr phase)))) " "
+ (car (cdr phase))))))
;; For the Chinese calendar the calculations for the new moon need to be more
Index: solar.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/solar.el,v
retrieving revision 1.5
diff -u -u -r1.5 solar.el
--- solar.el 2002/09/25 18:09:10 1.5
+++ solar.el 2006/07/17 23:30:40
＠＠ -1,4 +1,4 ＠＠
-;;; solar.el --- calendar functions for solar events.
+;;; solar.el --- calendar functions for solar events
;; Copyright (C) 1992, 1993, 1995, 1997 Free Software Foundation, Inc.
＠＠ -25,7 +25,7 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 20.5
+;;; Synched up with: FSF 21.4
;;; Commentary:
＠＠ -63,7 +63,7 ＠＠
(if (fboundp 'atan)
(require 'lisp-float-type)
- (error "Solar/lunar calculations impossible since floating point is unavailable."))
+ (error "Solar/lunar calculations impossible since floating point is unavailable"))
(require 'cal-dst)
(require 'cal-julian)
＠＠ -197,8 +197,8 ＠＠
"List of season changes for the southern hemisphere.")
(defvar solar-sidereal-time-greenwich-midnight
- nil
- "Sidereal time at Greenwich at midnight (universal time).")
+ nil
+ "Sidereal time at Greenwich at midnight (universal time).")
(defvar solar-spring-or-summer-season nil
"T if spring or summer and nil otherwise.
＠＠ -318,8 +318,8 ＠＠
(if (not (and rise-time set-time))
(if (or (and (> latitude 0) solar-spring-or-summer-season)
(and (< latitude 0) (not solar-spring-or-summer-season)))
- (setq day-length 24)
- (setq day-length 0))
+ (setq day-length 24)
+ (setq day-length 0))
(setq day-length (- set-time rise-time)))
(list (if rise-time (+ rise-time (/ calendar-time-zone 60.0)) nil)
(if set-time (+ set-time (/ calendar-time-zone 60.0)) nil)
＠＠ -357,7 +357,7 ＠＠
(if (< hmin -0.61)
(if (> hmax -0.61)
(while ;(< i 20) ; we perform a simple dichotomy
- ; (> (abs (+ hut 0.61)) epsilon)
+ ;(> (abs (+ hut 0.61)) epsilon)
(>= (abs (- utmoment utmoment-old))
(/ solar-error 60))
(setq utmoment-old utmoment)
＠＠ -420,7 +420,7 ＠＠
Corresponding value is nil if there is no sunrise/sunset."
(let* (; first, get the exact moment of local noon.
(exact-local-noon (solar-exact-local-noon date))
- ; get the the time from the 2000 epoch.
+ ; get the time from the 2000 epoch.
(t0 (solar-julian-ut-centuries (car exact-local-noon)))
; store the sidereal time at Greenwich at midnight of UT time.
; find if summer or winter slightly above the equator
＠＠ -437,7 +437,7 ＠＠
; between sunset and sunrise when there is a sunset and a sunrise)
(rise-set
(progn
- (setq solar-spring-or-summer-season
+ (setq solar-spring-or-summer-season
(if (> (car (cdr (cdr equator-rise-set))) 12) 1 0))
(solar-sunrise-and-sunset
(list t0 (car (cdr exact-local-noon)))
＠＠ -916,9 +916,9 ＠＠
(light (if sunset
(cons (- (car sunset) (/ 18.0 60.0)) (cdr sunset)))))
(if sunset
- (format "%s Sabbath candle lighting"
- (apply 'solar-time-string light))))))
-
+ (format "%s Sabbath candle lighting"
+ (apply 'solar-time-string light))))))
+
(defun solar-equinoxes/solstices (k year)
"Date of equinox/solstice K for YEAR.
K=0, spring equinox; K=1, summer solstice; K=2, fall equinox;
＠＠ -1045,10 +1045,10 ＠＠
(d1 (list (car d0) (floor (car (cdr d0))) (car (cdr (cdr d0)))))
(h0 (* 24 (- (car (cdr d0)) (floor (car (cdr d0))))))
(adj (dst-adjust-time d1 h0))
- (d2 (car adj))
- (d (list (car d2) (+ (car (cdr d2))
+ (d (list (car (car adj))
+ (+ (car (cdr (car adj)))
(/ (car (cdr adj)) 24.0))
- (car (cdr (cdr d2)))))
+ (car (cdr (cdr (car adj))))))
; The following is nearly as accurate, but not quite:
;(d0 (solar-date-next-longitude
; (calendar-astro-from-absolute
＠＠ -1058,15 +1058,15 ＠＠
;(abs-day (calendar-absolute-from-astro d)))
(abs-day (calendar-absolute-from-gregorian d)))
(list
- (list d2
+ (list (calendar-gregorian-from-absolute (floor abs-day))
(format "%s %s"
(nth k (if (and calendar-latitude
(< (calendar-latitude) 0))
solar-s-hemi-seasons
solar-n-hemi-seasons))
(solar-time-string
- (car (cdr adj))
- (if (dst-in-effect abs-day)
+ (* 24 (- abs-day (floor abs-day)))
+ (if (dst-in-effect abs-day)
calendar-daylight-time-zone-name
calendar-standard-time-zone-name))))))))
cvs server: timeclock.el is a new entry, no comparison available
cvs server: todo-mode.el is a new entry, no comparison available
- 1 participants
- 1 comments
[C] xemacsweb: Update program requirements for jde and ocaml
18 years, 4 months
Adrian Aichner
Adrian Aichner
COMMIT
Hello Mike, while this does not solve your problem directly, it may
help others with similar problems.
See also
http://list-archive.xemacs.org/cgi-bin/wilma_hiliter/xemacs-beta/200512/m...
Best regards!
Adrian
xemacsweb ChangeLog patch:
Diff command: cvs -q diff -U 0
Files affected: Download/win32/ChangeLog
Index: Download/win32/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/Download/win32/ChangeLog,v
retrieving revision 1.49
diff -u -U0 -r1.49 ChangeLog
--- Download/win32/ChangeLog 2 Jun 2006 22:07:21 -0000 1.49
+++ Download/win32/ChangeLog 30 Jul 2006 10:13:20 -0000
＠＠ -0,0 +1,4 ＠＠
+2006-07-30 Adrian Aichner <adrian(a)xemacs.org>
+
+ * index.content: Update program requirements for jde and ocaml.
+
xemacsweb source patch:
Diff command: cvs -f -z3 -q diff -u -w -N
Files affected: Download/win32/index.content
Index: Download/win32/index.content
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/Download/win32/index.content,v
retrieving revision 1.41
diff -u -w -r1.41 index.content
--- Download/win32/index.content 30 Jan 2006 21:54:31 -0000 1.41
+++ Download/win32/index.content 30 Jul 2006 10:12:55 -0000
＠＠ -179,6 +179,11 ＠＠
</tr>
<tr>
<!-- one of (td th) -->
+ <td>jde</td>
+ <td>find, grep, xargs</td>
+ </tr>
+ <tr>
+ <!-- one of (td th) -->
<td>pcl-cvs</td>
<td>cvs</td>
</tr>
＠＠ -186,6 +191,11 ＠＠
<!-- one of (td th) -->
<td>prog-modes</td>
<td>perl, python</td>
+ </tr>
+ <tr>
+ <!-- one of (td th) -->
+ <td>ocaml</td>
+ <td>find, grep, xargs</td>
</tr>
<tr>
<!-- one of (td th) -->
--
Adrian Aichner
mailto:adrian＠xemacs.org
http://www.xemacs.org/
- 1 participants
- 0 comments
[AC21.5] sync to etags_pot_version 17.19
18 years, 4 months
Stephen J. Turnbull
Stephen J. Turnbull
APPROVE COMMIT 21.5
Vin, I can submit a patch for 21.4 too if you like. It's 219KB,
though, and ISTR there was some concern about syncing to Francesco's
version being right for 21.4, so I'll wait for an invitation. (I
still owe you the patch for the metacity maximize bug, don't I ....
Tomorrow.)
This patch is in response to the report by Morgon Kanter
<morgon(a)surgo.net> that the man page was out of sync with reality.
Since Francesco released a new version recently, I synced etags.1 to
that, and since I was doing that much, etags.c, too.
Almost all of the changes to etags.c involve removal of feature macros
that are never used in practice any more. There are a couple of small
changes, recognition of new keywords, mostly. So I think this is
"safe".
Index: etc/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/etc/ChangeLog,v
retrieving revision 1.73
diff -u -r1.73 ChangeLog
--- etc/ChangeLog 23 May 2006 13:18:54 -0000 1.73
+++ etc/ChangeLog 19 Jul 2006 14:16:02 -0000
＠＠ -0,0 +1,5 ＠＠
+2006-07-19 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * etags.1: Sync to pot_etags_version 17.19.
+ Thanks to Morgon Kanter <morgon(a)surgo.net>.
+
Index: lib-src/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/ChangeLog,v
retrieving revision 1.209
diff -u -r1.209 ChangeLog
--- lib-src/ChangeLog 11 Jul 2006 23:36:21 -0000 1.209
+++ lib-src/ChangeLog 19 Jul 2006 14:16:03 -0000
＠＠ -0,0 +1,4 ＠＠
+2006-07-19 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * etags.c: Sync to pot_etags_version 17.19.
+
Index: etc/etags.1
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/etc/etags.1,v
retrieving revision 1.7
diff -u -r1.7 etags.1
--- etc/etags.1 7 Oct 2004 14:51:11 -0000 1.7
+++ etc/etags.1 19 Jul 2006 14:16:02 -0000
＠＠ -1,4 +1,5 ＠＠
-.\" Copyright (c) 1992, 2001 Free Software Foundation
+.\" Copyright (C) 1992, 2001, 2002, 2003, 2004,
+.\" 2005, 2006 Free Software Foundation, Inc.
.\" See section COPYING for conditions for redistribution
.TH etags 1 "23nov2001" "GNU Tools" "GNU Tools"
.de BP
＠＠ -12,7 +13,7 ＠＠
.SH SYNOPSIS
.hy 0
.na
-\fBetags\fP [\|\-aCDGImRVh\|] [\|\-i \fIfile\fP\|] [\|\-l \fIlanguage\fP\|]
+\fBetags\fP [\|\-aCDGIRVh\|] [\|\-i \fIfile\fP\|] [\|\-l \fIlanguage\fP\|]
.if n .br
[\|\-o \fItagfile\fP\|] [\|\-r \fIregexp\fP\|]
[\|\-\-parse\-stdin=\fIfile\fP\|]
＠＠ -25,7 +26,7 ＠＠
[\|\-\-help\|] [\|\-\-version\|]
\fIfile\fP .\|.\|.
-\fBctags\fP [\|\-aCdgImRVh\|] [\|\-BtTuvwx\|] [\|\-l \fIlanguage\fP\|]
+\fBctags\fP [\|\-aCdgIRVh\|] [\|\-BtTuvwx\|] [\|\-l \fIlanguage\fP\|]
.if n .br
[\|\-o \fItagfile\fP\|] [\|\-r \fIregexp\fP\|]
[\|\-\-parse\-stdin=\fIfile\fP\|]
＠＠ -92,28 +93,31 ＠＠
.TP
.B \-d, \-\-defines
Create tag entries for C preprocessor constant definitions
-and enum constants, too. This is the
-default behavior for \fBetags\fP.
+and enum constants, too. Since this is the default behavior of
+\fBetags\fP, only \fBctags\fP accepts this option.
.TP
.B \-D, \-\-no\-defines
Do not create tag entries for C preprocessor constant definitions
and enum constants.
This may make the tags file much smaller if many header files are tagged.
-This is the default behavior for \fBctags\fP.
+Since this is the default behavior of \fBctags\fP, only \fBetags\fP
+accepts this option.
.TP
-.B \-g, \-\-globals
+.B \-\-globals
Create tag entries for global variables in C, C++, Objective C, Java,
and Perl.
-This is the default behavior for \fBetags\fP.
+Since this is the default behavior of \fBetags\fP, only \fBctags\fP
+accepts this option.
.TP
-.B \-G, \-\-no\-globals
+.B \-\-no\-globals
Do not tag global variables. Typically this reduces the file size by
-one fourth. This is the default behavior for \fBctags\fP.
+one fourth. Since this is the default behavior of \fBctags\fP, only
+\fBetags\fP accepts this option.
.TP
\fB\-i\fP \fIfile\fP, \fB\-\-include=\fIfile\fP
Include a note in the tag file indicating that, when searching for a
tag, one should also consult the tags file \fIfile\fP after checking the
-current file. This options is only accepted by \fBetags\fP.
+current file. Only \fBetags\fP accepts this option.
.TP
.B \-I, \-\-ignore\-indentation
Don't rely on indentation as much as we normally do. Currently, this
＠＠ -129,11 +133,11 ＠＠
language may be used to disable language parsing altogether; only
regexp matching is done in this case (see the \fB\-\-regex\fP option).
.TP
-.B \-m, \-\-members
+.B \-\-members
Create tag entries for variables that are members of structure-like
constructs in C++, Objective C, Java.
.TP
-.B \-M, \-\-no\-members
+.B \-\-no\-members
Do not tag member variables. This is the default behavior.
.TP
.B \-\-packages\-only
＠＠ -288,7 +292,7 ＠＠
Copyright
.if t \(co
.if n (c)
-1999, 2001 Free Software Foundation, Inc.
+1999, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
.PP
Permission is granted to make and distribute verbatim copies of this
document provided the copyright notice and this permission notice are
Index: lib-src/etags.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/etags.c,v
retrieving revision 1.34
diff -u -r1.34 etags.c
--- lib-src/etags.c 24 Nov 2005 12:37:59 -0000 1.34
+++ lib-src/etags.c 19 Jul 2006 14:16:03 -0000
＠＠ -1,7 +1,7 ＠＠
/* Tags file maker to go with GNU Emacs -*- coding: latin-1 -*-
Copyright (C) 1984, 1987, 1988, 1989, 1993, 1994, 1995,
1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005 Free Software Foundation, Inc. and Ken Arnold
+ 2005, 2006 Free Software Foundation, Inc. and Ken Arnold
This file is not considered part of GNU Emacs.
＠＠ -41,7 +41,7 ＠＠
* configuration file containing regexp definitions for etags.
*/
-char pot_etags_version[] = "＠(#) pot revision number is 17.15";
+char pot_etags_version[] = "＠(#) pot revision number is 17.19";
#define TRUE 1
#define FALSE 0
＠＠ -59,12 +59,10 ＠＠
/* On some systems, Emacs defines static as nothing for the sake
of unexec. We don't want that here since we don't use unexec. */
# undef static
-# define ETAGS_REGEXPS /* use the regexp features */
-# define LONG_OPTIONS /* accept long options */
-# ifndef PTR /* for XEmacs */
+# ifndef PTR /* for Xemacs */
# define PTR void *
# endif
-# ifndef __P /* for XEmacs */
+# ifndef __P /* for Xemacs */
# define __P(args) args
# endif
#else /* no config.h */
＠＠ -82,14 +80,7 ＠＠
# define _GNU_SOURCE 1 /* enables some compiler checks on GNU */
#endif
-#ifdef LONG_OPTIONS
-# undef LONG_OPTIONS
-# define LONG_OPTIONS TRUE
-#else
-# define LONG_OPTIONS FALSE
-#endif
-
-/* WIN32_NATIVE is for XEmacs.
+/* WIN32_NATIVE is for Xemacs.
MSDOS, WINDOWSNT, DOS_NT are for Emacs. */
#ifdef WIN32_NATIVE
# undef MSDOS
＠＠ -167,25 +158,25 ＠＠
# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
#endif
-#if LONG_OPTIONS
-# include <getopt.h>
-#else
+#ifdef NO_LONG_OPTIONS /* define this if you don't have GNU getopt */
+# define NO_LONG_OPTIONS TRUE
# define getopt_long(argc,argv,optstr,lopts,lind) getopt (argc, argv, optstr)
extern char *optarg;
extern int optind, opterr;
-#endif /* LONG_OPTIONS */
+#else
+# define NO_LONG_OPTIONS FALSE
+# include <getopt.h>
+#endif /* NO_LONG_OPTIONS */
-#ifdef ETAGS_REGEXPS
-# ifndef HAVE_CONFIG_H /* this is a standalone compilation */
-# ifdef __CYGWIN__ /* compiling on Cygwin */
+#ifndef HAVE_CONFIG_H /* this is a standalone compilation */
+# ifdef __CYGWIN__ /* compiling on Cygwin */
!!! NOTICE !!!
the regex.h distributed with Cygwin is not compatible with etags, alas!
If you want regular expression support, you should delete this notice and
arrange to use the GNU regex.h and regex.c.
-# endif
# endif
-# include <regex.h>
-#endif /* ETAGS_REGEXPS */
+#endif
+#include <regex.h>
/* Define CTAGS to make the program "ctags" compatible with the usual one.
Leave it undefined to make the program "etags", which makes emacs-style
＠＠ -312,7 +303,6 ＠＠
char *what; /* the argument itself */
} argument;
-#ifdef ETAGS_REGEXPS
/* Structure defining a regular expression. */
typedef struct regexp
{
＠＠ -327,7 +317,6 ＠＠
bool ignore_case; /* ignore case when matching */
bool multi_line; /* do a multi-line match on the whole file */
} regexp;
-#endif /* ETAGS_REGEXPS */
/* Many compilers barf on this:
＠＠ -375,11 +364,9 ＠＠
static bool nocase_tail __P((char *));
static void get_tag __P((char *, char **));
-#ifdef ETAGS_REGEXPS
static void analyse_regex __P((char *));
static void free_regexps __P((void));
static void regex_tag_multiline __P((void));
-#endif /* ETAGS_REGEXPS */
static void error __P((const char *, const char *));
static void suggest_asking_for_help __P((void));
void fatal __P((char *, char *));
＠＠ -477,17 +464,17 ＠＠
static bool ignoreindent; /* -I: ignore indentation in C */
static bool packages_only; /* --packages-only: in Ada, only tag packages*/
+/* STDIN is defined in LynxOS system headers */
+#ifdef STDIN
+# undef STDIN
+#endif
+
#define STDIN 0x1001 /* returned by getopt_long on --parse-stdin */
static bool parsing_stdin; /* --parse-stdin used */
-#ifdef ETAGS_REGEXPS
static regexp *p_head; /* list of all regexps */
static bool need_filebuf; /* some regexes are multi-line */
-#else
-# define need_filebuf FALSE
-#endif /* ETAGS_REGEXPS */
-#if LONG_OPTIONS
static struct option longopts[] =
{
{ "append", no_argument, NULL, 'a' },
＠＠ -502,11 +489,9 ＠＠
{ "members", no_argument, &members, TRUE },
{ "no-members", no_argument, &members, FALSE },
{ "output", required_argument, NULL, 'o' },
-#ifdef ETAGS_REGEXPS
{ "regex", required_argument, NULL, 'r' },
{ "no-regex", no_argument, NULL, 'R' },
{ "ignore-case-regex", required_argument, NULL, 'c' },
-#endif /* ETAGS_REGEXPS */
{ "parse-stdin", required_argument, NULL, STDIN },
{ "version", no_argument, NULL, 'V' },
＠＠ -528,7 +513,6 ＠＠
#endif
{ NULL }
};
-#endif /* LONG_OPTIONS */
static compressor compressors[] =
{
＠＠ -676,13 +660,15 ＠＠
static char Objc_help [] =
"In Objective C code, tags include Objective C definitions for classes,\n\
class categories, methods and protocols. Tags for variables and\n\
-functions in classes are named `CLASS::VARIABLE' and `CLASS::FUNCTION'.";
+functions in classes are named `CLASS::VARIABLE' and `CLASS::FUNCTION'.\n\
+(Use --help --lang=c --lang=objc --lang=java for full help.)";
static char *Pascal_suffixes [] =
{ "p", "pas", NULL };
static char Pascal_help [] =
"In Pascal code, the tags are the functions and procedures defined\n\
in the file.";
+/* " // this is for working around an Emacs highlighting bug... */
static char *Perl_suffixes [] =
{ "pl", "pm", NULL };
＠＠ -853,7 +839,7 ＠＠
print_version ()
{
printf ("%s (%s %s)\n", (CTAGS) ? "ctags" : "etags", EMACS_NAME, VERSION);
- puts ("Copyright (C) 2002 Free Software Foundation, Inc. and Ken Arnold");
+ puts ("Copyright (C) 2006 Free Software Foundation, Inc. and Ken Arnold");
puts ("This program is distributed under the same terms as Emacs");
exit (EXIT_SUCCESS);
＠＠ -880,11 +866,11 ＠＠
printf ("Usage: %s [options] [[regex-option ...] file-name] ...\n\
\n\
These are the options accepted by %s.\n", progname, progname);
- if (LONG_OPTIONS)
- puts ("You may use unambiguous abbreviations for the long option names.");
+ if (NO_LONG_OPTIONS)
+ puts ("WARNING: long option names do not work with this executable,\n\
+as it is not linked with GNU getopt.");
else
- puts ("Long option names do not work with this executable, as it is not\n\
-linked with GNU getopt.");
+ puts ("You may use unambiguous abbreviations for the long option names.");
puts (" A - as file name means read names from stdin (one per line).\n\
Absolute names are stored in the output file as they are.\n\
Relative ones are stored relative to the output file's directory.\n");
＠＠ -944,7 +930,6 ＠＠
puts ("--members\n\
Create tag entries for members of structures in some languages.");
-#ifdef ETAGS_REGEXPS
puts ("-r REGEXP, --regex=REGEXP or --regex=＠regexfile\n\
Make a tag for each line matching a regular expression pattern\n\
in the following files. {LANGUAGE}REGEXP uses REGEXP for LANGUAGE\n\
＠＠ -959,7 +944,6 ＠＠
causes dot to match any character, including newline.");
puts ("-R, --no-regex\n\
Don't create tags from regexps for the following files.");
-#endif /* ETAGS_REGEXPS */
puts ("-I, --ignore-indentation\n\
In C and C++ do not assume that a closing brace in the first\n\
column is the final brace of a function or structure definition.");
＠＠ -1189,14 +1173,8 ＠＠
/* When the optstring begins with a '-' getopt_long does not rearrange the
non-options arguments to be at the end, but leaves them alone. */
- optstring = "-";
-#ifdef ETAGS_REGEXPS
- optstring = "-r:Rc:";
-#endif /* ETAGS_REGEXPS */
- if (!LONG_OPTIONS)
- optstring += 1; /* remove the initial '-' */
- optstring = concat (optstring,
- "aCf:Il:o:SVhH",
+ optstring = concat (NO_LONG_OPTIONS ? "" : "-",
+ "ac:Cf:Il:o:r:RSVhH",
(CTAGS) ? "BxdtTuvw" : "Di:");
while ((opt = getopt_long (argc, argv, optstring, longopts, NULL)) != EOF)
＠＠ -1370,11 +1348,9 ＠＠
case at_language:
lang = argbuffer[i].lang;
break;
-#ifdef ETAGS_REGEXPS
case at_regexp:
analyse_regex (argbuffer[i].what);
break;
-#endif
case at_filename:
#ifdef VMS
while ((this_file = gfnames (argbuffer[i].what, &got_err)) != NULL)
＠＠ -1414,9 +1390,7 ＠＠
}
}
-#ifdef ETAGS_REGEXPS
free_regexps ();
-#endif /* ETAGS_REGEXPS */
free (lb.buffer);
free (filebuf.buffer);
free (token_name.buffer);
＠＠ -1974,9 +1948,7 ＠＠
parser (inf);
-#ifdef ETAGS_REGEXPS
regex_tag_multiline ();
-#endif /* ETAGS_REGEXPS */
}
＠＠ -2452,6 +2424,7 ＠＠
enum, 0, st_C_enum
typedef, 0, st_C_typedef
define, 0, st_C_define
+undef, 0, st_C_define
operator, C_PLPL, st_C_operator
template, 0, st_C_template
# DEFUN used in emacs, the next three used in glibc (SYSCALL only for mach).
＠＠ -2470,10 +2443,10 ＠＠
/*%<*/
/* C code produced by gperf version 3.0.1 */
/* Command-line: gperf -m 5 */
-/* Computed positions: -k'1-2' */
+/* Computed positions: -k'2-3' */
struct C_stab_entry { char *name; int c_ext; enum sym_type type; };
-/* maximum key range = 31, duplicates = 0 */
+/* maximum key range = 33, duplicates = 0 */
#ifdef __GNUC__
__inline
＠＠ -2489,34 +2462,45 ＠＠
{
static unsigned char asso_values[] =
{
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 1, 34, 34, 34, 14, 14,
- 34, 34, 34, 34, 34, 34, 34, 34, 13, 34,
- 13, 34, 34, 12, 34, 34, 34, 34, 34, 11,
- 34, 34, 34, 34, 34, 8, 34, 11, 34, 12,
- 11, 0, 1, 34, 7, 0, 34, 34, 11, 9,
- 0, 4, 0, 34, 7, 4, 14, 21, 34, 15,
- 0, 2, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34, 34, 34, 34, 34,
- 34, 34, 34, 34, 34, 34
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 15,
+ 14, 35, 35, 35, 35, 35, 35, 35, 14, 35,
+ 35, 35, 35, 12, 13, 35, 35, 35, 35, 12,
+ 35, 35, 35, 35, 35, 1, 35, 16, 35, 6,
+ 23, 0, 0, 35, 22, 0, 35, 35, 5, 0,
+ 0, 15, 1, 35, 6, 35, 8, 19, 35, 16,
+ 4, 5, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 35, 35, 35, 35, 35
};
- return len + asso_values[(unsigned char)str[1]] + asso_values[(unsigned char)str[0]];
+ register int hval = len;
+
+ switch (hval)
+ {
+ default:
+ hval += asso_values[(unsigned char)str[2]];
+ /*FALLTHROUGH*/
+ case 2:
+ hval += asso_values[(unsigned char)str[1]];
+ break;
+ }
+ return hval;
}
static struct C_stab_entry *
＠＠ -2526,46 +2510,48 ＠＠
{
enum
{
- TOTAL_KEYWORDS = 31,
+ TOTAL_KEYWORDS = 32,
MIN_WORD_LENGTH = 2,
MAX_WORD_LENGTH = 15,
- MIN_HASH_VALUE = 3,
- MAX_HASH_VALUE = 33
+ MIN_HASH_VALUE = 2,
+ MAX_HASH_VALUE = 34
};
static struct C_stab_entry wordlist[] =
{
- {""}, {""}, {""},
+ {""}, {""},
{"if", 0, st_C_ignore},
- {"enum", 0, st_C_enum},
+ {""},
{"＠end", 0, st_C_objend},
- {"extern", 0, st_C_extern},
- {"extends", (C_JAVA & !C_PLPL), st_C_javastruct},
- {"for", 0, st_C_ignore},
- {"interface", (C_JAVA & !C_PLPL), st_C_struct},
- {"＠protocol", 0, st_C_objprot},
- {"＠interface", 0, st_C_objprot},
- {"operator", C_PLPL, st_C_operator},
- {"return", 0, st_C_ignore},
- {"friend", C_PLPL, st_C_ignore},
- {"import", (C_JAVA & !C_PLPL), st_C_ignore},
- {"＠implementation",0, st_C_objimpl},
+ {"union", 0, st_C_struct},
{"define", 0, st_C_define},
- {"package", (C_JAVA & !C_PLPL), st_C_ignore},
- {"implements", (C_JAVA & !C_PLPL), st_C_javastruct},
- {"namespace", C_PLPL, st_C_struct},
- {"domain", C_STAR, st_C_struct},
+ {"import", (C_JAVA & !C_PLPL), st_C_ignore},
{"template", 0, st_C_template},
+ {"operator", C_PLPL, st_C_operator},
+ {"＠interface", 0, st_C_objprot},
+ {"implements", (C_JAVA & !C_PLPL), st_C_javastruct},
+ {"friend", C_PLPL, st_C_ignore},
{"typedef", 0, st_C_typedef},
+ {"return", 0, st_C_ignore},
+ {"＠implementation",0, st_C_objimpl},
+ {"＠protocol", 0, st_C_objprot},
+ {"interface", (C_JAVA & !C_PLPL), st_C_struct},
+ {"extern", 0, st_C_extern},
+ {"extends", (C_JAVA & !C_PLPL), st_C_javastruct},
{"struct", 0, st_C_struct},
+ {"domain", C_STAR, st_C_struct},
{"switch", 0, st_C_ignore},
- {"union", 0, st_C_struct},
- {"while", 0, st_C_ignore},
+ {"enum", 0, st_C_enum},
+ {"for", 0, st_C_ignore},
+ {"namespace", C_PLPL, st_C_struct},
{"class", 0, st_C_class},
+ {"while", 0, st_C_ignore},
+ {"undef", 0, st_C_define},
+ {"package", (C_JAVA & !C_PLPL), st_C_ignore},
{"__attribute__", 0, st_C_attribute},
{"SYSCALL", 0, st_C_gnumacro},
- {"PSEUDO", 0, st_C_gnumacro},
{"ENTRY", 0, st_C_gnumacro},
+ {"PSEUDO", 0, st_C_gnumacro},
{"DEFUN", 0, st_C_gnumacro}
};
＠＠ -4538,6 +4524,7 ＠＠
lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
}
}
+ free (package);
}
＠＠ -5436,6 +5423,8 ＠＠
last[len] = '\0';
}
}
+ if (last != NULL)
+ free (last);
}
＠＠ -5592,7 +5581,11 ＠＠
else if (cp[0] == '-') /* attribute, e.g. "-define" */
{
erlang_attribute (cp);
- last = NULL;
+ if (last != NULL)
+ {
+ free (last);
+ last = NULL;
+ }
}
else if ((len = erlang_func (cp, last)) > 0)
{
＠＠ -5609,6 +5602,8 ＠＠
last[len] = '\0';
}
}
+ if (last != NULL)
+ free (last);
}
＠＠ -5707,8 +5702,6 ＠＠
}
-#ifdef ETAGS_REGEXPS
-
static char *scan_separators __P((char *));
static void add_regex __P((char *, language *));
static char *substitute __P((char *, char *, struct re_registers *));
＠＠ -6113,8 +6106,6 ＠＠
}
}
-#endif /* ETAGS_REGEXPS */
-
static bool
nocase_tail (cp)
＠＠ -6377,7 +6368,6 ＠＠
}
} /* if #line directives should be considered */
-#ifdef ETAGS_REGEXPS
{
int match;
regexp *rp;
＠＠ -6434,7 +6424,6 ＠＠
}
}
}
-#endif /* ETAGS_REGEXPS */
}
＠＠ -6595,7 +6584,7 ＠＠
suggest_asking_for_help ()
{
fprintf (stderr, "\tTry `%s %s' for a complete list of options.\n",
- progname, LONG_OPTIONS ? "--help" : "-h");
+ progname, NO_LONG_OPTIONS ? "-h" : "--help");
exit (EXIT_FAILURE);
}
＠＠ -6772,8 +6761,11 ＠＠
slashp = etags_strchr (slashp + 1, '/');
}
- if (res[0] == '\0')
- return savestr ("/");
+ if (res[0] == '\0') /* just a safety net: should never happen */
+ {
+ free (res);
+ return savestr ("/");
+ }
else
return res;
}
＠＠ -6882,7 +6874,6 ＠＠
/*
* Local Variables:
- * c-indentation-style: gnu
* indent-tabs-mode: t
* tab-width: 8
* fill-column: 79
--
School of Systems and Information Engineering http://turnbull.sk.tsukuba.ac.jp
University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573 JAPAN
Ask not how you can "do" free software business;
ask what your business can "do for" free software.
- 3 participants
- 5 comments
[21.4] Metacity maximization bugfix
18 years, 5 months
Stephen J. Turnbull
Stephen J. Turnbull
21.4
This is a port of the patch applied to 21.5. I've included the
`wedge-metacity' variable because in 21.5 I've been seeing undesired
resizing (frames shrink at random intervals in Gnus). This allows
people unaffected by the resizing bug that wedges XEmacs when
maximized by metacity to defeat the patch and return to the old broken
behavior as a workaround.
"wedge-metacity" defaults to nil (ie, XEmacs is well-behaved with
metacity and similar window managers). At least for me the rare
undesirable resizing decreases height only a line at a time, and
doesn't affect width, so this is annoying but not really going to get
in the way of work.
Built for me with no warnings in any of the affected files on Mac OS X
10.3.9 "Panther", PPC architecture.
Index: src/ChangeLog
===================================================================
RCS file: /Users/steve/Software/Repositories/cvs.xemacs.org/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.290.2.111
diff -u -U 0 -r1.290.2.111 ChangeLog
--- src/ChangeLog 4 Jul 2006 13:14:11 -0000 1.290.2.111
+++ src/ChangeLog 26 Jul 2006 08:22:30 -0000
＠＠ -0,0 +1,19 ＠＠
+2006-07-26 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ Fix the "metacity maximization" bug.
+
+ * EmacsFrame.c (EmacsFrameResize): Don't change EmacsManager size.
+ * frame-x.c (x_set_frame_size): Handle EmacsManager sizing.
+
+ Unfortunately, the change may be implicated in new geometry
+ management problems (unrequested frame size changes). If you're
+ not using a window-manager that gets wedged by maximizing XEmacs,
+ setting `wedge-metacity' non-nil alleviates some geometry
+ management problems.
+
+ * console-x.h (wedge-metacity): New Lisp variable.
+ * console-x.c (wedge-metacity): Initialize it.
+ (vars_of_console_x): New function. Initialize wedge-metacity.
+ * symsinit.h (vars_of_console_x): Declare it.
+ * emacs.c (main_1): Call vars_of_console_x.
+
Index: src/EmacsFrame.c
===================================================================
RCS file: /Users/steve/Software/Repositories/cvs.xemacs.org/XEmacs/xemacs/src/EmacsFrame.c,v
retrieving revision 1.17.2.4
diff -u -r1.17.2.4 EmacsFrame.c
--- src/EmacsFrame.c 31 Jan 2005 02:55:01 -0000 1.17.2.4
+++ src/EmacsFrame.c 26 Jul 2006 08:15:20 -0000
＠＠ -390,19 +390,33 ＠＠
pixel_to_char_size (f, ew->core.width, ew->core.height, &columns, &rows);
change_frame_size (f, rows, columns, 0);
- /* Now we tell the EmacsShell that we've changed the size of the non-fixed
- portion of the frame. Note that, if we the resize occurred as a result
- of EmacsFrameSetCharSize(), this information will be stored twice.
- This is not a big deal, as storing this information doesn't actually
- do anything until the next resize. */
- if (FRAME_X_TOP_LEVEL_FRAME_P (f))
- x_wm_set_variable_size (FRAME_X_SHELL_WIDGET (f), columns, rows);
-
- /* Kick the manager so that it knows we've changed size. */
- req.request_mode = 0;
- XtQueryGeometry (FRAME_X_CONTAINER_WIDGET (f), &req, &repl);
- EmacsManagerChangeSize (FRAME_X_CONTAINER_WIDGET (f), repl.width,
- repl.height);
+ /* #### The code below is just plain wrong. If the EmacsShell or
+ EmacsManager needs to know, they should just ask. If needed information
+ is being updated here, then we should set a dirty flag and have it
+ updated on an as-needed basis.
+ Unfortunately, in 21.5 with Xft this may be causing undesired frame
+ resizing. So for now, conditionalize so people can get work done if
+ this breaks something. */
+ if (wedge_metacity) /* cf. x_set_frame_size */
+ {
+ /* Now we tell the EmacsShell that we've changed the size of the
+ non-fixed portion of the frame. Note that, if the resize occurred
+ as a result of EmacsFrameSetCharSize(), this information will be
+ stored twice. This is not a big deal, as storing this information
+ doesn't actually do anything until the next resize. */
+ if (FRAME_X_TOP_LEVEL_FRAME_P (f))
+ x_wm_set_variable_size (FRAME_X_SHELL_WIDGET (f), columns, rows);
+
+ /* Kick the manager so that it knows we've changed size.
+ #### No, no, no! If this does anything at all, it will involve
+ changing the manager's size. That's not something that a child
+ widget should initialize as part of a purely informational
+ method!! */
+ req.request_mode = 0;
+ XtQueryGeometry (FRAME_X_CONTAINER_WIDGET (f), &req, &repl);
+ EmacsManagerChangeSize (FRAME_X_CONTAINER_WIDGET (f), repl.width,
+ repl.height);
+ }
}
static Boolean
Index: src/console-x.c
===================================================================
RCS file: /Users/steve/Software/Repositories/cvs.xemacs.org/XEmacs/xemacs/src/console-x.c,v
retrieving revision 1.4
diff -u -r1.4 console-x.c
--- src/console-x.c 12 Apr 2001 18:23:30 -0000 1.4
+++ src/console-x.c 26 Jul 2006 07:59:37 -0000
＠＠ -37,6 +37,8 ＠＠
DEFINE_CONSOLE_TYPE (x);
+int wedge_metacity; /* nonzero means update WM_HINTS always */
+
static int
x_initially_selected_for_input (struct console *con)
{
＠＠ -311,6 +313,22 ＠＠
void
+vars_of_console_x (void)
+{
+ DEFVAR_BOOL ("wedge-metacity", &wedge_metacity /*
+When non-nil, frame geometry management is backward-compatible.
+This is known to create inflooping window jitter in metacity, et al.
+It also does not conform to Xt conventions for geometry management.
+Specifically, all frame resizes, XEmacs-initiated or not, update WM_HINTS.
+Furthermore, geometry changes occur in the widget resize method.
+
+The default is nil. This probably gives correct behavior regardless of the
+window manager used.
+This variable is deprecated and will be removed.
+*/ );
+}
+
+void
reinit_console_type_create_x (void)
{
REINITIALIZE_CONSOLE_TYPE (x);
Index: src/console-x.h
===================================================================
RCS file: /Users/steve/Software/Repositories/cvs.xemacs.org/XEmacs/xemacs/src/console-x.h,v
retrieving revision 1.12.2.1
diff -u -r1.12.2.1 console-x.h
--- src/console-x.h 18 Jan 2005 03:31:15 -0000 1.12.2.1
+++ src/console-x.h 26 Jul 2006 07:57:42 -0000
＠＠ -57,6 +57,8 ＠＠
DECLARE_CONSOLE_TYPE (x);
+extern int wedge_metacity;
+
struct x_device
{
/* The X connection of this device. */
Index: src/emacs.c
===================================================================
RCS file: /Users/steve/Software/Repositories/cvs.xemacs.org/XEmacs/xemacs/src/emacs.c,v
retrieving revision 1.97.2.11
diff -u -r1.97.2.11 emacs.c
--- src/emacs.c 14 Feb 2005 04:15:34 -0000 1.97.2.11
+++ src/emacs.c 26 Jul 2006 08:00:51 -0000
＠＠ -1968,6 +1968,7 ＠＠
#ifdef HAVE_BALLOON_HELP
vars_of_balloon_x ();
#endif
+ vars_of_console_x ();
vars_of_device_x ();
#ifdef HAVE_DIALOGS
vars_of_dialog_x ();
Index: src/frame-x.c
===================================================================
RCS file: /Users/steve/Software/Repositories/cvs.xemacs.org/XEmacs/xemacs/src/frame-x.c,v
retrieving revision 1.45.2.4
diff -u -r1.45.2.4 frame-x.c
--- src/frame-x.c 31 Jan 2005 02:55:16 -0000 1.45.2.4
+++ src/frame-x.c 26 Jul 2006 08:02:26 -0000
＠＠ -2360,6 +2360,17 ＠＠
x_set_frame_size (struct frame *f, int cols, int rows)
{
EmacsFrameSetCharSize (FRAME_X_TEXT_WIDGET (f), cols, rows);
+
+ if (!wedge_metacity) /* cf. EmacsFrameResize */
+ {
+ /* Kick the manager so that it knows we've changed size. */
+ XtWidgetGeometry req, repl;
+ req.request_mode = 0;
+ XtQueryGeometry (FRAME_X_CONTAINER_WIDGET (f), &req, &repl);
+ EmacsManagerChangeSize (FRAME_X_CONTAINER_WIDGET (f),
+ repl.width, repl.height);
+ }
+
#if 0
/* this is not correct. x_set_frame_size() is called from
Fset_frame_size(), which may or may not have been called
Index: src/symsinit.h
===================================================================
RCS file: /Users/steve/Software/Repositories/cvs.xemacs.org/XEmacs/xemacs/src/symsinit.h,v
retrieving revision 1.35.2.2
diff -u -r1.35.2.2 symsinit.h
--- src/symsinit.h 31 Oct 2002 15:08:50 -0000 1.35.2.2
+++ src/symsinit.h 26 Jul 2006 08:03:18 -0000
＠＠ -259,6 +259,7 ＠＠
void vars_of_console_stream (void);
void vars_of_console_mswindows (void);
void vars_of_console_tty (void);
+void vars_of_console_x (void);
void vars_of_data (void);
void vars_of_database (void);
void vars_of_debug (void);
--
Graduate School of Systems and Information Engineering University of Tsukuba
http://turnbull.sk.tsukuba.ac.jp/ Tennodai 1-1-1 Tsukuba 305-8573 JAPAN
Economics of Information Communication and Computation Systems
Experimental Economics, Microeconomic Theory, Game Theory
- 3 participants
- 5 comments
[PATCH packages] [Bug: 21.4.19] XEmacs hangs at exit with "No such coding system: iso-2022-8"
18 years, 5 months
Stephen J. Turnbull
Stephen J. Turnbull
>>>>> "Murray" == Murray Eisenberg <murray(a)math.umass.edu> writes:
Murray> At first I thought this was caused by AUCTeX, but AUCTeX
Murray> expert David Kastrup says the problem is "very clearly an
Murray> XEmacs-internal" one that has no particular relation to
Murray> AUCTeX.
Murray> Debugger entered--Lisp error: (error "No such coding system" iso-2022-8)
Actually, the problem is not XEmacs-internal. It's due to a library
that was coded by somebody who assumed that Mule facilities are always
available, but XEmacs 21.4 on Windows doesn't support Mule well, and
it's almost never available in that configuration.
The included patch should work. To test without patching and
recompiling, you can put the following form in your init.el:
(setq savehist-coding-system
(if (featurep 'xemacs)
(if (fboundp 'find-coding-system)
(or (find-coding-system 'utf-8)
(find-coding-system 'iso-2022-8)
;; support --with-file-coding
(find-coding-system 'binary))
;; drop back 15 and punt!
'binary)
;; assume Emacs 20, at least
'utf-8))
Please let me know if that does work for you. If so, I'll apply it to
CVS and we should have a package release in short order.
If you do decide to apply the patch locally, it will not interfere
with future upgrades of the package in any way (but if you upgrade
"too soon" you'll lose the patch). Don't forget to recompile with M-x
byte-compile-file.
Index: xemacs-packages/edit-utils/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/edit-utils/ChangeLog,v
retrieving revision 1.222
diff -u -U0 -r1.222 ChangeLog
--- xemacs-packages/edit-utils/ChangeLog 28 Jun 2006 07:58:06 -0000 1.222
+++ xemacs-packages/edit-utils/ChangeLog 25 Jul 2006 04:28:16 -0000
＠＠ -0,0 +1,5 ＠＠
+2006-07-25 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * savehist.el (savehist-coding-system): Get a usable value
+ regardless of presence of file-coding. Document the issue.
+
Index: xemacs-packages/edit-utils/savehist.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/edit-utils/savehist.el,v
retrieving revision 1.4
diff -u -r1.4 savehist.el
--- xemacs-packages/edit-utils/savehist.el 14 Nov 2005 07:05:54 -0000 1.4
+++ xemacs-packages/edit-utils/savehist.el 25 Jul 2006 04:28:21 -0000
＠＠ -135,12 +135,23 ＠＠
;; This should be capable of representing characters used by Emacs.
;; We prefer UTF-8 over ISO 2022 because it is well-known outside
-;; Mule. XEmacs prir to 21.5 had UTF-8 provided by an external
-;; package which may not be loaded, which is why we check for version.
-(defvar savehist-coding-system (if (and (featurep 'xemacs)
- (<= emacs-major-version 21)
- (< emacs-minor-version 5))
- 'iso-2022-8 'utf-8)
+;; Mule.
+;; XEmacs 21.1 or 21.4 may not have Mule, especially on Windows, so
+;; we check for existence of *any* coding system at all.
+;; #### Use of 'binary' as the fallback for non-Mule XEmacsen should
+;; sort-of work because it's only used (a) as a coding cookie and (b) by
+;; binding `coding-system-for-write', but maybe we should error if there
+;; is a non-binary coding cookie in that case. Needs thought....
+(defvar savehist-coding-system (if (featurep 'xemacs)
+ (if (fboundp 'find-coding-system)
+ (or (find-coding-system 'utf-8)
+ (find-coding-system 'iso-2022-8)
+ ;; support --with-file-coding
+ (find-coding-system 'binary))
+ ;; drop back 15 and punt!
+ 'binary)
+ ;; assume Emacs 20, at least
+ 'utf-8))
"The coding system savehist uses for saving the minibuffer history.
Changing this value while Emacs is running is supported, but considered
unwise, unless you know what you are doing.")
--
School of Systems and Information Engineering http://turnbull.sk.tsukuba.ac.jp
University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573 JAPAN
Ask not how you can "do" free software business;
ask what your business can "do for" free software.
- 2 participants
- 3 comments
[21.5] autoconf 2.59
18 years, 5 months
Stephen J. Turnbull
Stephen J. Turnbull
21.5
I'm going to do a bit of testing myself, and unless something really
unexpected happens in the tests, or Malcolm throws an exception, I'll
commit in a day or so under this ChangeLog:
2006-07-26 Malcolm Purvis <malcolmp(a)xemacs.org>
* configure.ac (XE_CDR): m4_cdr differs in autoconf 2.59 and 2.60.
(XE_EXPAND_COMPLEX_OPTIONS): Use XE_CDR, not m4_cdr.
>>>>> "Malcolm" == Malcolm Purvis <malcolmp(a)xemacs.org> writes:
Malcolm> The solution to the compatibility question is to make our
Malcolm> own copy of the 2.60 m4_cdr so that we can use it with
Malcolm> both versions of autoconf. Attached is a patch that does
Malcolm> this. When run through 2.59 it produces a copy of
Malcolm> configure that is identical to what is in CVS.
OK, thanks!
Malcolm> Looking through the release notes of 2.60 I see that the
Malcolm> definitions (but not the values) of datadir, infodir and
Malcolm> mandir have changed. This will have to be looked into.
OK. If you run into more real life, let me know, and I can do that
(but probably at about 1/10 the speed you'll achieve ;-).
Index: configure.ac
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.ac,v
retrieving revision 1.47
diff -u -r1.47 configure.ac
--- configure.ac 2006/07/19 19:35:25 1.47
+++ configure.ac 2006/07/25 02:12:44
＠＠ -22,8 +22,6 ＠＠
dnl Due to a dependence on the implementation of certain internal autoconf
dnl macros, die if any version other than 2.59 is used.
AC_PREREQ(2.59)dnl
-m4_if(m4_version_compare(m4_defn([m4_PACKAGE_VERSION]), [2.59]), 1,
- [m4_fatal([This script can only be generated with autoconf 2.59])], [])dnl
AC_INIT([XEmacs],[21.5],[xemacs-beta(a)xemacs.org])dnl
AC_CONFIG_SRCDIR(src/lisp.h)dnl
dnl
＠＠ -231,6 +229,13 ＠＠
for W in $2; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
$1="$T"
])dnl XE_SPACE
+dnl Autoconf 2.59 and 2.60 have slightly different versions of m4_cdr that
+dnl return different values for an empty list. XE_CDR is a copy of the 2.60
+dnl version which will be used with both versions.
+define([XE_CDR],
+[m4_if([$#], 0, [m4_fatal([$0: cannot be called without arguments])],
+ [$#], 1, [],
+ [m4_dquote(m4_shift($＠))])])dnl
dnl
dnl XE_MERGED_ARG(FEATURE, HELP-STRING, [ACTION-IF-TRUE], [ACTION-IF-FALSE])
dnl ------------------------------------------------------------------------
＠＠ -379,9 +384,9 ＠＠
dnl Internal macro to recursively expand all the options in the option list.
dnl
define([XE_EXPAND_COMPLEX_OPTIONS],
-[m4_if([$2], [[]], [],
+[m4_if([$2], [], [],
[XE_EXPAND_COMPLEX_OPTION([$1], m4_fst($2))[]dnl
-XE_EXPAND_COMPLEX_OPTIONS([$1], m4_cdr($2))])])dnl
+XE_EXPAND_COMPLEX_OPTIONS([$1], XE_CDR($2))])])dnl
dnl
dnl XE_INIT_COMPLEX_OPTION(prefix, option_list)
dnl -------------------------------------------
--
School of Systems and Information Engineering http://turnbull.sk.tsukuba.ac.jp
University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573 JAPAN
Ask not how you can "do" free software business;
ask what your business can "do for" free software.
- 1 participants
- 0 comments
[AC pkgs] Patch: remove useless "Parser Error" message with 'M-x cvs-status'
18 years, 5 months
Stephen J. Turnbull
Stephen J. Turnbull
APPROVE COMMIT packages/pcl-cvs
Thanks for the analysis and patch, Mike!
I've supplied the following ChangeLog:
2006-07-26 Mike FABIAN <mfabian(a)suse.de>
* pcl-cvs-parse.el (cvs-parse-run-table): Suppress scary warning.
- 1 participants
- 0 comments
[21.5] cvsignore debugger init files
18 years, 5 months
Marcus Crestani
Marcus Crestani
PATCH 21.5
Configure copies the debugger init files from etc/ to src/ on every
run, so add debugger init files to src/.cvsignore.
I'll commit tomorrow, if nobody objects.
src/ChangeLog addition:
2006-07-18 Marcus Crestani <crestani(a)xemacs.org>
* .cvsignore: Add .dbxrc.in and .gdbinit.in.
cvsignore-xemacs-21.5 source patch:
Diff command: cvs -q diff -u
Files affected: src/.cvsignore
Index: src/.cvsignore
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/.cvsignore,v
retrieving revision 1.11
diff -u -r1.11 .cvsignore
--- src/.cvsignore 25 Nov 2005 01:41:52 -0000 1.11
+++ src/.cvsignore 18 Jul 2006 13:42:40 -0000
＠＠ -31,4 +31,6 ＠＠
xemacs.def
xemacs.def.in
.dbxrc
+.dbxrc.in
.gdbinit
+.gdbinit.in
--
Marcus
- 1 participants
- 1 comments
[21.5] NEWGC on Intel Macs
18 years, 5 months
Marcus Crestani
Marcus Crestani
PATCH 21.5
This patch enables the incremental garbage collector on Apple's
Intel-based Macs that now can work with a POSIX-compliant write
barrier. Configure uses $machine to determine if it runs on an Intel
Mac and then enables the POSIX write barrier.
I'll commit tomorrow, if nobody objects.
ChangeLog addition:
2006-07-18 Marcus Crestani <crestani(a)xemacs.org>
* configure.ac: Intel-based Macs can use POSIX-style write
barrier. Use $machine to determine this.
macos-intel-xemacs-21.5 source patch:
Diff command: cvs -q diff -u
Files affected: configure.ac configure
Index: configure
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/configure,v
retrieving revision 1.283
diff -u -r1.283 configure
--- configure 7 Jul 2006 20:07:45 -0000 1.283
+++ configure 18 Jul 2006 15:44:57 -0000
＠＠ -4761,10 +4761,13 ＠＠
if test "$enable_newgc" = "yes"; then
if test "$enable_vdb" = "auto"; then
case "$opsys" in
- darwin ) cat >>confdefs.h <<\_ACEOF
+ darwin ) case "$machine" in
+ i686 ) check_vdb_posix=yes ;;
+ * ) cat >>confdefs.h <<\_ACEOF
#define VDB_MACH 1
_ACEOF
have_vdb_mach=yes ;;
+ esac ;;
cygwin* ) cat >>confdefs.h <<\_ACEOF
#define VDB_WIN32 1
_ACEOF
＠＠ -16478,7 +16481,7 ＠＠
/usr/openwin/share/include'
if test "$ac_x_includes" = no; then
- # Guess where to find include files, by looking for Xlib.h.
+ # Guess where to find include files, by looking for Intrinsic.h.
# First, try using that file with no special directory specified.
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
＠＠ -16486,7 +16489,7 ＠＠
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
-#include <X11/Xlib.h>
+#include <X11/Intrinsic.h>
_ACEOF
if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
(eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
＠＠ -16513,7 +16516,7 ＠＠
sed 's/^/| /' conftest.$ac_ext >&5
for ac_dir in $ac_x_header_dirs; do
- if test -r "$ac_dir/X11/Xlib.h"; then
+ if test -r "$ac_dir/X11/Intrinsic.h"; then
ac_x_includes=$ac_dir
break
fi
＠＠ -16534,11 +16537,11 ＠＠
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
-#include <X11/Xlib.h>
+#include <X11/Intrinsic.h>
int
main ()
{
-XrmInitialize ()
+XtMalloc (0)
;
return 0;
}
Index: configure.ac
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.ac,v
retrieving revision 1.45
diff -u -r1.45 configure.ac
--- configure.ac 7 Jul 2006 20:07:45 -0000 1.45
+++ configure.ac 18 Jul 2006 15:45:01 -0000
＠＠ -1767,7 +1767,10 ＠＠
if test "$enable_newgc" = "yes"; then
if test "$enable_vdb" = "auto"; then
case "$opsys" in
- darwin ) AC_DEFINE(VDB_MACH) have_vdb_mach=yes ;;
+ darwin ) case "$machine" in
+ i686 ) check_vdb_posix=yes ;;
+ * ) AC_DEFINE(VDB_MACH) have_vdb_mach=yes ;;
+ esac ;;
cygwin* ) AC_DEFINE(VDB_WIN32) have_vdb_win32=yes ;;
linux* ) check_vdb_posix=yes ;;
freebsd ) check_vdb_posix=yes ;;
--
Marcus
- 1 participants
- 1 comments
[21.5] Print addresses as pointers
18 years, 5 months
Marcus Crestani
Marcus Crestani
PATCH 21.5
Jerry pointed this out a while ago: Print addresses as pointers
instead integers, to get correct output on platforms where integers
and addresses have different sizes.
I'll commit tomorrow, if nobody objects.
src/ChangeLog addition:
2006-07-18 Marcus Crestani <crestani(a)xemacs.org>
* gc.c (kkcc_backtrace): Print adresses as pointers.
* vdb-posix.c (vdb_fault_handler): Print adresses as pointers.
newgc-xemacs-21.5 source patch:
Diff command: cvs -q diff -u
Files affected: src/vdb-posix.c src/gc.c
Index: src/gc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gc.c,v
retrieving revision 1.5
diff -u -r1.5 gc.c
--- src/gc.c 2 Jul 2006 07:32:20 -0000 1.5
+++ src/gc.c 18 Jul 2006 15:07:38 -0000
＠＠ -649,9 +649,9 ＠＠
stderr_out (" %s",
XRECORD_LHEADER_IMPLEMENTATION (obj)->name);
}
- stderr_out (" (addr: 0x%x, desc: 0x%x, ",
- (int) kkcc_bt[i].obj,
- (int) kkcc_bt[i].desc);
+ stderr_out (" (addr: %p, desc: %p, ",
+ (void *) kkcc_bt[i].obj,
+ (void *) kkcc_bt[i].desc);
if (kkcc_bt[i].pos >= 0)
stderr_out ("pos: %d)\n", kkcc_bt[i].pos);
else
Index: src/vdb-posix.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/vdb-posix.c,v
retrieving revision 1.3
diff -u -r1.3 vdb-posix.c
--- src/vdb-posix.c 19 Jun 2006 18:19:38 -0000 1.3
+++ src/vdb-posix.c 18 Jul 2006 15:07:38 -0000
＠＠ -80,8 +80,8 ＠＠
signal_name = "SIGBUS";
else
ABORT (); /* something weird happened: wrong signal caught */
- fprintf (stderr, "\n\nFatal Error: Received %s (%d) for address 0x%x\n",
- signal_name, signum, (int) GET_FAULT_ADDRESS);
+ fprintf (stderr, "\n\nFatal Error: Received %s (%d) for address %p\n",
+ signal_name, signum, (void *) GET_FAULT_ADDRESS);
#ifdef FAULT_HANDLER_CALL_PREVIOUS_HANDLER
if (signum == SIGSEGV)
segv_oact (signum);
--
Marcus
- 1 participants
- 1 comments