Commits

Anonymous committed 3ccc905

japanese calendar

  • Participants
  • Parent commits 7c8dd7c

Comments (0)

Files changed (5)

+1999-06-24  SL Baur  <steve@miho.m17n.org>
+
+	* appt.el (appt-add): Autoload.
+	(appt-delete): Ditto.
+
+1999-06-14  SL Baur  <steve@steve1.m17n.org>
+
+	* calendar.el (calendar-day-name): Day names can be 1 character.
+	(calendar-month-name): Ditto.
+	(calendar-english-day-name-array): Rename.
+	(calendar-day-name-array): Make the default.
+	(calendar-english-month-name-array): Rename.
+	(calendar-month-name-array): Make the default.
+	(calendar-english-year-name): New function.
+	(calendar-year-name-function): Use it.
+	(calendar-year-name): New function.
+	(generate-calendar-month): Use it.
+	(calendar-string-spread): Use Mule-aware functions so as not to
+	lose with wide characters.
+
+	* cal-japanese.el: New file.  Implement Japanese-style calendars.
+
 1999-02-08  Charles G Waldman  <cgw@pgt.com>
 
 	* calendar.el:  (holidays) add autoload cookie
 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 # Boston, MA 02111-1307, USA.
 
-VERSION = 1.10
+VERSION = 1.11
 AUTHOR_VERSION =
 MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
 PACKAGE = calendar
 
 include ../../XEmacs.rules
 
+ifeq ($(BUILD_MULE), t)
+ELCS += cal-japanese.elc
+endif
+
 GENERATED += custom-load.elc
 
 all:: $(ELCS) auto-autoloads.elc custom-load.elc
 
 
 ;;; 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.
 The time should be in either 24 hour format or am/pm format."
                                      (list time-msg)))
     (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)))) 
 
+;;;###autoload
 (defun appt-delete ()
   "Delete an appointment from the list of appointments."
   (interactive)
+;;; cal-japanese.el --- Japanese Calendar support
+
+;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+
+;; Author: SL Baur <steve@xemacs.org>
+;; Keywords: calendar
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; 
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+;; We're not ready for this, yet.
+;; (defvar calendar-japanese-day-names
+;;   ["$BF|MKF|(B" "$B7nMKF|(B" "$B2PMKF|(B" "$B?eMKF|(B" "$BLZMKF|(B" "$B6bMKF|(B" "$BEZMKF|(B"])
+
+(defvar calendar-japanese-day-names
+  ["$BF|(B" "$B7n(B" "$B2P(B" "$B?e(B" "$BLZ(B" "$B6b(B" "$BEZ(B"]
+  "Japanese shortened week day names.")
+
+;(setq calendar-month-name-array
+;      ["$BKS7n(B" "$BG!7n(B" "$BLo@8(B" "$B1,7n(B" "$B;)7n(B" "$B?eL57n(B"
+;       "$BJ87n(B" "$BMU7n(B" "$BD97n(B" "$B?@L57n(B" "$BAz7n(B" "$B;UAv(B"])
+
+(defvar calendar-japanese-month-names
+  ["1$B7n(B" "2$B7n(B" "3$B7n(B" "4$B7n(B" "5$B7n(B" "6$B7n(B"
+   "7$B7n(B" "8$B7n(B" "9$B7n(B" "10$B7n(B" "11$B7n(B" "12$B7n(B"]
+  "Japanese month names.")
+
+(defvar calendar-japanese-year-names
+  '((1989 1 8 "$BJ?@.(B")
+    (1926 12 25 "$B><OB(B")
+    (1912 7 30 "$BBg@5(B")
+    (1868 9 8 "$BL@<#(B")
+    (1865 4 7 "$B7D1~(B")
+    (1864 2 20 "$B85<#(B")
+    (1861 2 19 "$BJ85W(B")
+    (1860 3 18 "$BK|1d(B")
+    (1854 11 27 "$B0B@/(B")
+    (1848 2 28 "$B2E1J(B")
+    (1844 12 2 "$B902=(B")
+    (1830 12 19 "$BE7J](B")
+    (1818 4 22 "$BJ8@/(B")
+    (1804 2 11 "$BJ82=(B")
+    (1801 2 5 "$B5|OB(B"))
+  "Japanese year names.")
+
+(defun calendar-japanese-year-string (year month day)
+  (let ((year-alist calendar-japanese-year-names)
+	year-rec result)
+    (while (and (null result) (setq year-rec (pop year-alist)))
+      (cond
+       ((or (> year (car year-rec))
+	    (and (= year (car year-rec))
+		 (> month (cadr year-rec))))
+	(setq result (format "%d(%s%d)$BG/(B"
+			     year
+			     (cadddr year-rec)
+			     (1+ (- year (car year-rec))))))
+       ))
+    (if result
+	result
+      (format "%d" year))))
+
+(defun calendar-enable-japanese ()
+  "Enable Japanese day and month names in the calendar."
+  (interactive)
+  (setq calendar-day-name-array calendar-japanese-day-names)
+  (setq calendar-month-name-array calendar-japanese-month-names)
+  (setq calendar-year-name-function 'calendar-japanese-year-string))
+
+(provide 'cal-japanese)
+
+;;; cal-japanese.el ends here
    (goto-char (point-min))
    (calendar-insert-indented
     (calendar-string-spread
-     (list (format "%s %d" (calendar-month-name month) year)) ?  20)
+     (list (format "%s %s"
+		   (calendar-month-name month)
+		   (calendar-year-name year month 1))) ?  20)
     indent t)
    (calendar-insert-indented "" indent);; Go to proper spot
    (calendar-for-loop i from 0 to 6 do
                           (if (< (length strings) 2)
                               (append (list "") strings (list ""))
                             strings)))
-         (n (- length (length (apply 'concat strings))))
+         (n (- length (string-width (apply 'concat strings))))
          (m (1- (length strings)))
          (s (car strings))
          (strings (cdr strings))
                       (car strings)))
       (setq i (1+ i))
       (setq strings (cdr strings)))
-    (substring s 0 length)))
+    (truncate-string-to-width s length)))
 
 (defun update-calendar-mode-line ()
   "Update the calendar mode line with the current date and date style."
                      (if absolute date (calendar-day-of-week date)))))
     (if width
        (let ((i 0) (result "") (pos 0))
-         (while (< i width)
+         (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)))
          result)
       string)))
 
-(defvar calendar-day-name-array
+(defvar calendar-english-day-name-array
   ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"])
+(defvar calendar-day-name-array calendar-english-day-name-array)
 
-(defvar calendar-month-name-array
+(defvar calendar-english-month-name-array
   ["January" "February" "March"     "April"   "May"      "June"
    "July"    "August"   "September" "October" "November" "December"])
+(defvar calendar-month-name-array calendar-english-month-name-array)
 
 (defun calendar-make-alist (sequence &optional start-index filter)
   "Make an assoc list corresponding to SEQUENCE.
   (let ((string (aref calendar-month-name-array (1- month))))
     (if width
        (let ((i 0) (result "") (pos 0))
-         (while (< i width)
+         (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)))
          result)
       string)))
 
+(defun calendar-english-year-name (year month day)
+  (format "%d" year))
+(defvar calendar-year-name-function 'calendar-english-year-name)
+
+(defun calendar-year-name (year month day)
+  (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."
   (% (calendar-absolute-from-gregorian date) 7))