bug#17393: 24.4.50; [PATCH] diary Chinese support

bug#17393: 24.4.50; [PATCH] diary Chinese support

[Leo Liu]

[-- Attachment #1: Type: text/plain, Size: 514 bytes --]


The patch adds support for Chinese dates in diary, in which the cycle
and year are concatenated as cycleyear i.e. cycle 78 and year 31 is
represented as 7831. The following commands are available in the
calendar window:

 KEY      COMMAND
 ======   ======================================
`i C a'   diary-chinese-insert-anniversary-entry
`i C d'   diary-chinese-insert-entry
`i C m'   diary-chinese-insert-monthly-entry
`i C y'   diary-chinese-insert-yearly-entry
 ======   ======================================


[-- Attachment #2: cal-china.patch --]
[-- Type: text/x-patch, Size: 8932 bytes --]

=== modified file 'lisp/calendar/cal-china.el'
--- lisp/calendar/cal-china.el	2014-01-01 07:43:34 +0000
+++ lisp/calendar/cal-china.el	2014-05-03 04:15:59 +0000
@@ -682,6 +682,124 @@
   "Chinese calendar equivalent of date diary entry."
   (format "Chinese date: %s" (calendar-chinese-date-string date)))
 
+;;;; diary support
+
+(declare-function calendar-mark-1         "diary-lib")
+(declare-function diary-mark-entries-1    "diary-lib")
+(declare-function diary-list-entries-1    "diary-lib")
+(declare-function diary-insert-entry-1    "diary-lib")
+(declare-function diary-date-display-form "diary-lib")
+(declare-function diary-anniversary       "diary-lib")
+(declare-function diary-make-date         "diary-lib")
+(declare-function diary-ordinal-suffix    "diary-lib")
+(defvar diary-sexp-entry-symbol)
+(defvar entry)                    ;used by `diary-chinese-anniversary'
+
+(defvar calendar-chinese-month-name-array
+  ["正月" "二月" "三月" "四月" "五月" "六月"
+   "七月" "八月" "九月" "十月" "冬月" "臘月"])
+
+;;; NOTE: In the diary the cycle and year of a Chinese date is
+;;; combined using this formula: (+ (* cycle 100) year).
+;;;
+;;; These two functions convert to and back from this representation.
+(defun calendar-chinese-from-absolute-for-diary (date)
+  (pcase-let ((`(,c ,y ,m ,d) (calendar-chinese-from-absolute date)))
+    (list m d (+ (* c 100) y))))
+
+(defun calendar-chinese-to-absolute-for-diary (date)
+  (pcase-let ((`(,m ,d ,y) date))
+    (calendar-chinese-to-absolute
+     (list (floor y 100) (mod y 100) m d))))
+
+(defun calendar-chinese-mark-date-pattern (month day year &optional color)
+  (calendar-mark-1 month day year
+                   #'calendar-chinese-from-absolute-for-diary
+                   #'calendar-chinese-to-absolute-for-diary
+                   color))
+
+;;;###cal-autoload
+(defun diary-chinese-mark-entries ()
+  "Mark days in the calendar window that have Chinese date diary entries.
+Marks each entry in `diary-file' (or included files) visible in the calendar
+window.  See `diary-chinese-list-entries' for more information.
+
+This function is provided for use with `diary-nongregorian-marking-hook'."
+  (diary-mark-entries-1 #'calendar-chinese-mark-date-pattern
+                        calendar-chinese-month-name-array
+                        diary-chinese-entry-symbol
+                        #'calendar-chinese-from-absolute-for-diary))
+
+;;;###cal-autoload
+(defun diary-chinese-list-entries ()
+  "Add any Chinese date entries from the diary file to `diary-entries-list'.
+Chinese date diary entries must be prefaced by `diary-chinese-entry-symbol'
+\(normally an `C').  The same `diary-date-forms' govern the style
+of the Chinese calendar entries.  If an Chinese date diary entry begins with
+`diary-nonmarking-symbol', the entry will appear in the diary listing,
+but will not be marked in the calendar.
+
+This function is provided for use with `diary-nongregorian-listing-hook'."
+  (diary-list-entries-1 calendar-chinese-month-name-array
+                        diary-chinese-entry-symbol
+                        #'calendar-chinese-from-absolute-for-diary))
+
+;;;###cal-autoload
+(defun diary-chinese-anniversary (month day &optional year mark)
+  (pcase-let* ((ddate (diary-make-date month day year))
+               (`(,dc ,dy ,dm ,dd)      ;diary chinese date
+                (if year
+                    (calendar-chinese-from-absolute
+                     (calendar-chinese-to-absolute-for-diary ddate))
+                  (list nil nil (calendar-extract-month ddate)
+                        (calendar-extract-day ddate))))
+               (`(,cc ,cy ,cm ,cd)      ;current chinese date
+                (calendar-chinese-from-absolute
+                 (calendar-absolute-from-gregorian date)))
+               (diff (if (and dc dy)
+                         (+ (* 60 (- cc dc)) (- cy dy))
+                       100)))
+    (and (> diff 0) (= dm cm) (= dd cd)
+         (cons mark (format entry diff (diary-ordinal-suffix diff))))))
+
+;;;###cal-autoload
+(defun diary-chinese-insert-anniversary-entry (&optional arg)
+  "Insert an anniversary diary entry for the Chinese date at point.
+Prefix argument ARG makes the entry nonmarking."
+  (interactive "P")
+  (let ((calendar-date-display-form (diary-date-display-form)))
+    (diary-make-entry
+     (format "%s(diary-chinese-anniversary %s)"
+             diary-sexp-entry-symbol
+             (calendar-date-string
+              (calendar-chinese-from-absolute-for-diary
+               (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))))
+     arg)))
+
+;;;###cal-autoload
+(defun diary-chinese-insert-entry (&optional arg)
+  "Insert a diary entry for the Chinese date at point."
+  (interactive "P")
+  (diary-insert-entry-1 nil arg calendar-chinese-month-name-array
+                        diary-chinese-entry-symbol
+                        #'calendar-chinese-from-absolute-for-diary))
+
+;;;###cal-autoload
+(defun diary-chinese-insert-monthly-entry (&optional arg)
+  "Insert a monthly diary entry for the Chinese date at point."
+  (interactive "P")
+  (diary-insert-entry-1 'monthly arg calendar-chinese-month-name-array
+                        diary-chinese-entry-symbol
+                        #'calendar-chinese-from-absolute-for-diary))
+
+;;;###cal-autoload
+(defun diary-chinese-insert-yearly-entry (&optional arg)
+  "Insert a yearly diary entry for the Chinese date at point."
+  (interactive "P")
+  (diary-insert-entry-1 'yearly arg calendar-chinese-month-name-array
+                        diary-chinese-entry-symbol
+                        #'calendar-chinese-from-absolute-for-diary))
+
 (provide 'cal-china)
 
 ;;; cal-china.el ends here

=== modified file 'lisp/calendar/cal-menu.el'
--- lisp/calendar/cal-menu.el	2014-01-01 07:43:34 +0000
+++ lisp/calendar/cal-menu.el	2014-05-03 04:15:59 +0000
@@ -56,6 +56,11 @@
      ["One time" diary-bahai-insert-entry]
      ["Monthly" diary-bahai-insert-monthly-entry]
      ["Yearly" diary-bahai-insert-yearly-entry])
+    ("Insert Chinese"
+     ["One time" diary-chinese-insert-entry]
+     ["Monthly" diary-chinese-insert-monthly-entry]
+     ["Yearly" diary-chinese-insert-yearly-entry]
+     ["Anniversary" diary-chinese-insert-anniversary-entry])
     ("Insert Islamic"
      ["One time" diary-islamic-insert-entry]
      ["Monthly" diary-islamic-insert-monthly-entry]

=== modified file 'lisp/calendar/calendar.el'
--- lisp/calendar/calendar.el	2014-03-17 16:04:32 +0000
+++ lisp/calendar/calendar.el	2014-05-03 04:15:59 +0000
@@ -689,6 +689,11 @@
   :type 'string
   :group 'diary)
 
+(defcustom diary-chinese-entry-symbol "C"
+  "Symbol indicating a diary entry according to the Chinese calendar."
+  :type 'string
+  :group 'diary)
+
 (define-obsolete-variable-alias 'hebrew-diary-entry-symbol
   'diary-hebrew-entry-symbol "23.1")
 
@@ -1709,6 +1714,10 @@
     (define-key map "iBd" 'diary-bahai-insert-entry)
     (define-key map "iBm" 'diary-bahai-insert-monthly-entry)
     (define-key map "iBy" 'diary-bahai-insert-yearly-entry)
+    (define-key map "iCd" 'diary-chinese-insert-entry)
+    (define-key map "iCm" 'diary-chinese-insert-monthly-entry)
+    (define-key map "iCy" 'diary-chinese-insert-yearly-entry)
+    (define-key map "iCa" 'diary-chinese-insert-anniversary-entry)
     (define-key map "?"   'calendar-goto-info-node)
     (define-key map "Hm" 'cal-html-cursor-month)
     (define-key map "Hy" 'cal-html-cursor-year)

=== modified file 'lisp/calendar/diary-lib.el'
--- lisp/calendar/diary-lib.el	2014-01-01 07:43:34 +0000
+++ lisp/calendar/diary-lib.el	2014-05-03 04:15:59 +0000
@@ -2396,6 +2396,11 @@
                                cal-bahai
                                calendar-bahai-month-name-array
                                diary-bahai-entry-symbol)
+   (diary-font-lock-keywords-1 diary-chinese-mark-entries
+                               diary-chinese-list-entries
+                               cal-china
+                               calendar-chinese-month-name-array
+                               diary-chinese-entry-symbol)
    (list
     (cons
      (format "^%s.*$" (regexp-quote diary-include-string))
@@ -2412,7 +2417,8 @@
              (regexp-opt (mapcar 'regexp-quote
                                  (list diary-hebrew-entry-symbol
                                        diary-islamic-entry-symbol
-                                       diary-bahai-entry-symbol))
+                                       diary-bahai-entry-symbol
+                                       diary-chinese-entry-symbol))
                          t))
      '(1 font-lock-constant-face))
     '(diary-font-lock-sexps . font-lock-keyword-face)

bug#17393: 24.4.50; [PATCH] diary Chinese support

[Glenn Morris]

Thanks. Please apply, with the necessary doc and NEWS updates.
Very minor comments below.

Leo Liu wrote:

> +(declare-function calendar-mark-1         "diary-lib")
> +(declare-function diary-mark-entries-1    "diary-lib")
> +(declare-function diary-list-entries-1    "diary-lib")
> +(declare-function diary-insert-entry-1    "diary-lib")
> +(declare-function diary-date-display-form "diary-lib")

The existing files use autoload.

> +(declare-function diary-anniversary       "diary-lib")

Unused?

> +Chinese date diary entries must be prefaced by `diary-chinese-entry-symbol'
> +\(normally an `C').

"a `C'".

> +;;;###cal-autoload
> +(defun diary-chinese-anniversary (month day &optional year mark)

Doc string please.

> +(defcustom diary-chinese-entry-symbol "C"
> +  "Symbol indicating a diary entry according to the Chinese calendar."
> +  :type 'string
> +  :group 'diary)

:version tag.

bug#17393: 24.4.50; [PATCH] diary Chinese support

[Leo Liu]

Fixed in 24.5

On 2014-05-03 14:39 -0400, Glenn Morris wrote:
> Thanks. Please apply, with the necessary doc and NEWS updates.
> Very minor comments below.

Thanks for the comments. Fixed accordingly and installed.

BTW, in diary-chinese-list-entries I also changed `prefaced' to
`prefixed'. The doc-string is adopted from similar entries in other
non-grepgorian calendars which still use `prefaced'. Any comments?

Leo

bug#17393: 24.4.50; [PATCH] diary Chinese support

[Stefan Monnier]

> non-grepgorian calendars which still use `prefaced'. Any comments?

Would those be the calendars before Unix?


        Stefan

bug#17393: 24.4.50; [PATCH] diary Chinese support

[Leo Liu]

On 2014-05-04 00:15 -0400, Stefan Monnier wrote:
> Would those be the calendars before Unix?
>
>
>         Stefan

I mean `diary-hebrew-list-entries' and the like. In its doc-string it
uses `prefaced' which I am not quite sure is the right word.

Leo

bug#17393: 24.4.50; [PATCH] diary Chinese support

[Glenn Morris]

Leo Liu wrote:

> I mean `diary-hebrew-list-entries' and the like. In its doc-string it
> uses `prefaced' which I am not quite sure is the right word.

Either word sounds fine to me.

bug#17393: 24.4.50; [PATCH] diary Chinese support

[Leo Liu]

On 2014-05-04 14:09 -0400, Glenn Morris wrote:
> Either word sounds fine to me.

Thanks.

Leo