]> code.delx.au - gnu-emacs/blobdiff - lisp/calendar/calendar.el
Reduce some cal-tex code duplication
[gnu-emacs] / lisp / calendar / calendar.el
index 905600cfb748864b437b9add318a879108fdd9ea..d5514d14a32f8c3cbfe76cec64a5424d94c7980e 100644 (file)
@@ -41,7 +41,7 @@
 ;; can be translated from the (usual) Gregorian calendar to the day of
 ;; the year/days remaining in year, to the ISO commercial calendar, to
 ;; the Julian (old style) calendar, to the Hebrew calendar, to the
-;; Islamic calendar, to the Baha'i calendar, to the French
+;; Islamic calendar, to the Bahá'í calendar, to the French
 ;; Revolutionary calendar, to the Mayan calendar, to the Chinese
 ;; calendar, to the Coptic calendar, to the Ethiopic calendar, and to
 ;; the astronomical (Julian) day number.  Times of sunrise/sunset can
@@ -52,7 +52,7 @@
 ;; The following files are part of the calendar/diary code:
 
 ;;    appt.el                    Appointment notification
-;;    cal-bahai.el               Baha'i calendar
+;;    cal-bahai.el               Bahá'í calendar
 ;;    cal-china.el               Chinese calendar
 ;;    cal-coptic.el              Coptic/Ethiopic calendars
 ;;    cal-dst.el                 Daylight saving time rules
@@ -642,7 +642,7 @@ causes the diary entry \"Vacation\" to appear from November 1 through
 November 10, 1990.  See the documentation for the function
 `diary-list-sexp-entries' for more details.
 
-Diary entries based on the Hebrew, the Islamic and/or the Baha'i
+Diary entries based on the Hebrew, the Islamic and/or the Bahá'í
 calendar are also possible, but because these are somewhat slow, they
 are ignored unless you set the `diary-nongregorian-listing-hook' and
 the `diary-nongregorian-marking-hook' appropriately.  See the
@@ -679,7 +679,7 @@ details, see the documentation for the variable `diary-list-entries-hook'."
   'diary-bahai-entry-symbol "23.1")
 
 (defcustom diary-bahai-entry-symbol "B"
-  "Symbol indicating a diary entry according to the Baha'i calendar."
+  "Symbol indicating a diary entry according to the Bahá'í calendar."
   :type 'string
   :group 'diary)
 
@@ -1005,9 +1005,9 @@ calendar."
   'calendar-bahai-all-holidays-flag "23.1")
 
 (defcustom calendar-bahai-all-holidays-flag nil
-  "If nil, show only major holidays from the Baha'i calendar.
+  "If nil, show only major holidays from the Bahá'í calendar.
 These are the days on which work and school must be suspended.
-Otherwise, show all the holidays that would appear in a complete Baha'i
+Otherwise, show all the holidays that would appear in a complete Bahá'í
 calendar."
   :type 'boolean
   :group 'holidays)
@@ -1105,14 +1105,14 @@ inclusive.  The standard macro `dotimes' is preferable in most cases."
             ,index (1+ ,index)))
     sum))
 
-;; FIXME bind q to bury-buffer?
 (defmacro calendar-in-read-only-buffer (buffer &rest body)
-  "Switch to BUFFER and executes the forms in BODY.
+  "Switch to BUFFER and execute the forms in BODY.
 First creates or erases BUFFER as needed.  Leaves BUFFER read-only,
 with disabled undo.  Leaves point at point-min, displays BUFFER."
   (declare (indent 1) (debug t))
   `(progn
      (set-buffer (get-buffer-create ,buffer))
+     (or (derived-mode-p 'special-mode) (special-mode))
      (setq buffer-read-only nil
            buffer-undo-list t)
      (erase-buffer)
@@ -1424,16 +1424,24 @@ Optional integers MON and YR are used instead of today's date."
   "Move to column INDENT, adding spaces as needed.
 Inserts STRING so that it ends at INDENT.  STRING is either a
 literal string, or a sexp to evaluate to return such.  Truncates
-STRING to length TRUNCATE, ensure a trailing space."
+STRING to length TRUNCATE, and ensures a trailing space."
   (if (not (ignore-errors (stringp (setq string (eval string)))))
       (calendar-move-to-column indent)
-    (if (> (length string) truncate)
-        (setq string (substring string 0 truncate)))
+    (if (> (string-width string) truncate)
+        (setq string (truncate-string-to-width string truncate)))
     (or (string-match " $" string)
-        (if (= (length string) truncate)
-            (aset string (1- truncate) ?\s)
-          (setq string (concat string " "))))
-    (calendar-move-to-column (- indent (length string)))
+        (setq string (concat (if (= (string-width string) truncate)
+                                 (substring string 0 -1)
+                               string)
+                             ;; Avoid inserting text properties unless
+                             ;; we have to (ie, non-unit-width chars).
+                             ;; This is by no means essential.
+                             (if (= (string-width string) (length string))
+                                 " "
+                               ;; Cribbed from buff-menu.el.
+                               (propertize
+                                " " 'display `(space :align-to ,indent))))))
+    (calendar-move-to-column (- indent (string-width string)))
     (insert string)))
 
 (defun calendar-generate-month (month year indent)
@@ -1756,8 +1764,8 @@ the STRINGS are just concatenated and the result truncated."
                           (if (< (length strings) 2)
                               (append (list "") strings (list ""))
                             strings)))
-         (n (- length (length (apply 'concat strings))))
-         (m (1- (length strings)))
+         (n (- length (string-width (apply 'concat strings))))
+         (m (* (1- (length strings)) (char-width char)))
          (s (car strings))
          (strings (cdr strings))
          (i 0))
@@ -1766,7 +1774,7 @@ the STRINGS are just concatenated and the result truncated."
                       (make-string (max 0 (/ (+ n i) m)) char)
                       string)
             i (1+ i)))
-    (substring s 0 length)))
+    (truncate-string-to-width s length)))
 
 (defun calendar-update-mode-line ()
   "Update the calendar mode line with the current date and date style."
@@ -1785,19 +1793,6 @@ the STRINGS are just concatenated and the result truncated."
                          ?\s (- calendar-right-margin (1- start))))))
         (force-mode-line-update))))
 
-(defun calendar-window-list ()
-  "List of all calendar-related windows."
-  (let ((calendar-buffers (calendar-buffer-list))
-        list)
-    ;; Using 0 rather than t for last argument - see bug#2199.
-    ;; This is only used with calendar-hide-window, which ignores
-    ;; iconified frames anyway, so could use 'visible rather than 0.
-    (walk-windows (lambda (w)
-                    (if (memq (window-buffer w) calendar-buffers)
-                        (push w list)))
-                  nil 0)
-    list))
-
 (defun calendar-buffer-list ()
   "List of all calendar-related buffers (as buffers, not strings)."
   (let (buffs)
@@ -1809,41 +1804,30 @@ the STRINGS are just concatenated and the result truncated."
            (push b buffs)))
     buffs))
 
-(defun calendar-exit ()
+(defun calendar-exit (&optional kill)
   "Get out of the calendar window and hide it and related buffers."
-  (interactive)
-  (let ((diary-buffer (get-file-buffer diary-file)))
-    (if (or (not diary-buffer)
-            (not (buffer-modified-p diary-buffer))
-            (yes-or-no-p
-             "Diary modified; do you really want to exit the calendar? "))
-        ;; Need to do this multiple times because one time can replace some
-        ;; calendar-related buffers with other calendar-related buffers.
-        (mapc (lambda (x)
-                (mapc 'calendar-hide-window (calendar-window-list)))
-              (calendar-window-list)))))
+  (interactive "P")
+  (let ((diary-buffer (get-file-buffer diary-file))
+        (calendar-buffers (calendar-buffer-list)))
+    (when (or (not diary-buffer)
+              (not (buffer-modified-p diary-buffer))
+              (yes-or-no-p
+               "Diary modified; do you really want to exit the calendar? "))
+      (if (and calendar-setup (display-multi-frame-p))
+          ;; FIXME: replace this cruft with the `quit-restore' window property
+          (dolist (w (window-list-1 nil nil t))
+            (if (and (memq (window-buffer w) calendar-buffers)
+                     (window-dedicated-p w))
+                (if (eq (window-deletable-p w) 'frame)
+                   (if calendar-remove-frame-by-deleting
+                       (delete-frame (window-frame w))
+                     (iconify-frame (window-frame w)))
+                 (quit-window kill w))))
+        (dolist (b calendar-buffers)
+          (quit-windows-on b kill))))))
 
 (define-obsolete-function-alias 'exit-calendar 'calendar-exit "23.1")
 
-(defun calendar-hide-window (window)
-  "Hide WINDOW if it is calendar-related."
-  (let ((buffer (if (window-live-p window) (window-buffer window))))
-    (if (memq buffer (calendar-buffer-list))
-        (cond
-         ((and (display-multi-frame-p)
-               (eq 'icon (cdr (assoc 'visibility
-                                     (frame-parameters
-                                      (window-frame window))))))
-          nil)
-         ((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 (&optional offset)
   "Return the current date in a list (month day year).
 Optional integer OFFSET is a number of days from the current date."
@@ -1880,7 +1864,7 @@ use instead of point."
         ;; or on or before the digit of a 1-digit date.
         (if (not (and (looking-at "[ 0-9]?[0-9][^0-9]")
                       (get-text-property (point) 'date)))
-            (if error (error "Not on a date!"))
+            (if error (user-error "Not on a date!"))
           ;; Convert segment to real month and year.
           (if (zerop month) (setq month 12))
           ;; Go back to before the first date digit.
@@ -1895,8 +1879,6 @@ use instead of point."
                  ((and (= 1 month) (= segment 2)) (1+ displayed-year))
                  (t displayed-year))))))))
 
-(add-to-list 'debug-ignored-errors "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.
 
@@ -2552,7 +2534,7 @@ DATE is (month day year).  Calendars that do not apply are omitted."
            (unless (string-equal
                     (setq odate (calendar-bahai-date-string date))
                     "")
-             (format "Baha'i date: %s" odate))
+             (format "Bahá'í date: %s" odate))
            (format "Chinese date: %s"
                    (calendar-chinese-date-string date))
            (unless (string-equal
@@ -2602,7 +2584,7 @@ If called by a mouse-event, pops up a menu with the result."
     ;; If no frame exists yet, we have no idea what width to use.
     (and (= width 10)
          (not window-system)
-         (setq width (or (getenv "COLUMNS") 80)))
+         (setq width (string-to-number (or (getenv "COLUMNS") "80"))))
     (setq mode-line-format
           (if buffer-file-name
               `("-" mode-line-modified
@@ -2624,6 +2606,7 @@ If called by a mouse-event, pops up a menu with the result."
 
 ;; Local variables:
 ;; byte-compile-dynamic: t
+;; coding: utf-8
 ;; End:
 
 ;;; calendar.el ends here