;; cal-ivrit.el --- Hebraized Hebrew calendar and diary -*- coding: utf-8; -*-

;; ©2020 Boruch Baum <brouch_baum@gmx.com>, GPL3+, assignable to Free Software Foundation.

;;; Commentary:

;;   This extends the existing Hebrew support of the Emacs calendar
;;   (`cal-hebrew.el') and diary.
;;
;;   * Hebrew data is presented in Hebrew characters.
;;
;;   * Sunset awareness for Hebrew dates. Between sunset and midnight,
;;     the Hebrew date is incremented, and the dates Hebrew details
;;     displayed accordingy, without affecting the secular date.


;;; Installation:

;;   * Refer to the installation instructions for packages `calendar'
;;     and `diary'. Notably, variables `calendar-latitude' and
;;     `calendar-longitude' must be set to the user's location.

;;   * Without the following, when Hebrew text lines exist in the
;;     diary, they will appear not only left justified, but also out
;;     of sequence with LTR lines! Even, so the RTL lines themselves
;;     appear in reverse. (TODO: File a bug report for this. It may be
;;     related to a BIDI bug I reported years ago regarding org-mode
;;     headings).
;;
;;      (add-hook 'diary-fancy-display-mode-hook
;;        'cal-ivrit-diary-fancy-display-mode-hook-function)
;;
;;   Here's an example of how to create a template for
;;   entries to include Hebrew-related material
;;
;;      #+NAME: ~/.emacs.d/diary
;;      #+BEGIN_EXAMPLE
;;      &%%(cal-ivrit-diary-date)
;;      &%%(cal-ivrit-diary-parasha)
;;      &%%(cal-ivrit-diary-candles)
;;
;;      &%%(diary-hebrew-date)
;;      &%%(diary-hebrew-omer)
;;      &%%(diary-hebrew-parasha)
;;      &%%(diary-hebrew-rosh-hodesh)
;;      &%%(diary-hebrew-sabbath-candles)
;;      &%%(diary-lunar-phases)
;;      &%%(diary-sunrise-sunset)
;;      #+END_EXAMPLE


;;; Developer notes:

;;   Implementation options:

;;   1) Integrate these functions directly into the current
;;      `cal-hebrew.el' equivalents by modifying those functions to
;;      branch based upon the value of `calendar-hebrew-in-ivrit'.
;;
;;   2) Create a minor mode `calendar-hebrew-in-ivrit' that advises
;;      around the functions of `cal-hebrew.el'.
;;
;;   3) Keep the two packages totally separate. Easiest for the
;;      developers and most burdensome for a user intent on switching
;;      back and forth.
;;
;; (cond
;;   (calendar-hebrew-in-ivrit
;;    (advice-add 'calendar-hebrew-date-string :around #'cal-ivrit-date-string))
;;    (advice-add #'cal-ivrit-print-date
;;   (t
;;    (advice-remove 'calendar-hebrew-date-string #'cal-ivrit-date-string)))

;;   Code duplication:

;;     Variables `hebrew-numeric-regex' and `hebrew-numeric' are
;;     duplications of variables `footnote-hebrew-numeric-regex' and
;;     `footnote-hebrew-numeric', and function `hebrew-numeric' is
;;     basically a duplicate of function `Footnote-hebrew-numeric', the
;;     only difference being the option to add single/double
;;     apostrophes. Consider refactoring the footnote versions, and
;;     moving these to a generic hebrew support elisp file.

;;   Advised functions:

;;     The option to implement many/most/all/? of the features of this
;;     package as advices around existing functions was made in order
;;     to make it easy for the user to toggle between this Hebrew
;;     language version and the default native language version. The
;;     design is that the user need only change the boolean variable
;;     `calendar-hebrew-in-ivrit' for this morsel of instant
;;     gratification.
;;
;;       calendar-hebrew-date-string -> cal-ivrit-date-string
;;       diary-hebrew-parasha -> cal-ivrit-diary-parasha  (NOT DONE!!)


;;; Code:

; (require 'calendar) ; Redundant. Brought in by `cal-hebrew'
(require 'cal-hebrew)

;;; Defcustoms:

(defcustom calendar-hebrew-in-ivrit t
  "Whether to display Hebrew data in Hebrew."
  :type 'boolean)

;;; Constants:

(defconst cal-ivrit-month-name-array-for-common-year
  ["ניסן" "אייר" "סיון" "תמוז" "אב" "אלול"
  "תשרי" "חשון" "כסלו" "טבת"  "שבט" "אדר"])

(defconst cal-ivrit-month-name-array-for-leap-year
  ["ניסן" "אייר" "סיון" "תמוז" "אב" "אלול"
  "תשרי" "חשון" "כסלו"  "טבת"  "שבט" "אדר א" "אדר ב"])

(defconst cal-ivrit-day-name-array
  ["ראשון" "שני" "שלישי" "רביעי" "חמישי" "שישי" "שבת"])

(defconst cal-ivrit-day-name-array-ivrit
  ["יום א" "יום ב" "יום ג" "יום ד" "יום ה" "יום ו" "שבת"])

(defconst cal-ivrit-day-abbrev-array
  ["א'" "ב'" "ג'" "ד'" "ה'" "ו'" "ז'"])

(defconst cal-ivrit-day-header-array
  ["א" "ב" "ג" "ד" "ה" "ו" "ש"])

(defconst cal-ivrit-parashiot-names
  ["בראשית"   "נוח"      "לך לך" "וירא"    "חיי שרה" "תולדות"
   "ויצא"     "וישלח" "וישב"   "מקץ"   "ויגש"   "ויחי"
   "שמות"     "וארא"     "בא"         "בשלח" "יתרו"      "משפטים"
   "תרומה"     "תצוה" "כי תשא"   "ויקהל"  "פקודי"     "ויקרא"
   "צו"        "שמיני"   "תזריע"     "מצורע"   "אחרי מות" "קדושים"
   "אמור"        "בהר"     "בחקותי" "במדבר"  "נשא"      "בהעלתך"
   "שלח לך" "קרח"    "חקת"    "בלק"     "פנחס"      "מטות"
   "מסעי"       "דברים"   "ואתחנן"  "עקב"      "ראה"        "שופטים"
   "כי תצא"    "כי תבוא"   "נצבים"   "וילך"  "האזינו"]
  "The names of the parashiot in the Torah, in Hebrew.")

(defconst cal-ivrit--jm-lat 31.77
  "Lattitude for Jerusalem")

(defconst cal-ivrit--jm-long 35.22
  "Lattitude for Jerusalem")

;;; Generic Hebrew utility constants and functions

(defconst hebrew-numeric-regex "[אבגדהוזחטיכלמנסעפצקרשת']+")
; (defconst hebrew-numeric-regex "\\([אבגדהוזחט]'\\)?\\(ת\\)?\\(ת\\)?\\([קרשת]\\)?\\([טיכלמנסעפצ]\\)?\\([אבגדהוזחט]\\)?")

(defconst hebrew-numeric '(
  ("א" "ב" "ג" "ד" "ה" "ו" "ז" "ח" "ט")
  ("י" "כ" "ל" "מ" "נ" "ס" "ע" "פ" "צ")
  ("ק" "ר" "ש" "ת" "תק" "תר"" תש" "תת" "תתק")))

;;;###cal-autoload
(defun hebrew-numeric(n &optional quote)
  "Convert a base 10 Western number to it Hebrew character equivalent.
With QUOTE non-nil, include customary single or double quotes."
  (let*
    ((quote (if quote "'" ""))
     (n (+ (mod n 10000) (/ n 10000)))
     (thousands (/ n 1000))
     (hundreds (/ (mod n 1000) 100))
     (tens (/ (mod n 100) 10))
     (units (mod n 10))
     (special (if (not (= tens 1)) nil
               (or (when (= units 5) "טו")
               (when (= units 6) "טז"))))
     (result
       (concat
         (when (/= 0 thousands) (concat (nth (1- thousands) (nth 0 hebrew-numeric)) quote))
         (when (/= 0 hundreds) (nth (1- hundreds) (nth 2 hebrew-numeric)))
         (if special special
          (concat
            (when (/= 0 tens) (nth (1- tens) (nth 1 hebrew-numeric)))
            (when (/= 0 units) (nth (1- units) (nth 0 hebrew-numeric))))))))
   (cond
    ((= 1 (length result))
      (concat result quote))
    ((string-match "'" result -2)
      result)
    (t
     (concat (substring result 0 -1) (if quote "\"" "") (substring result -1))))))

;; Calendar functions

;; ;;;###cal-autoload
;; (defun cal-ivrit-location-checking ()
;;   "Use Jerusalem if the system coordinates are invalid."
;;   (message "Boruch 1")
;;   (when (or (not calendar-latitude)
;;             (> calendar-latitude 90)
;;             (< calendar-latitude -90)
;;             (not calendar-longitude)
;;             (> calendar-longitude 180)
;;             (< calendar-longitude -180))
;;     (lwarn 'calendar-hebrew ":warning"
;;        "Invalid calendar-lattitude/longitude %d/%d"
;;         calendar-latitude calendar-longitude)
;;     (message "Boruch 2")
;;     (make-local-variable 'calendar-latitude)
;;     (make-local-variable 'calendar-longitude)
;;     (make-local-variable 'calendar-location-name)
;;     (setq calendar-latitude cal-ivrit--jm-lat)
;;     (setq calendar-longitude cal-ivrit--jm-long)
;;     (setq calendar-location-name "ירושלים")))
;; ;; Um. This doesn't seem the right way to do this...
;; (add-hook 'calendar-mode-hook 'cal-ivrit-location-checking)
;; (add-hook 'diary-fancy-display-mode-hook 'cal-ivrit-location-checking)
;; ;; And, it doesn't work!
;; ;; + calendar calls solar.. before running the hook, so nil's cause an error/crash


;;;###cal-autoload
(defun cal-ivrit-date-string (&optional orig-fun date)
  "Display a Hebrew date in a native Hebrew format.
The ORIG-FUN argument exists to allow this function to be advised
around function `calendar-hebrew-date-string'.
If DATE is nil, the current date is assumed.

Note that the native Hebrew format will often differ from
`calendar-date-display-form'."
;; Programming note: The code here is an adaptation of functions
;; `calendar-hebrew-date-string' and `calendar-date-string'.
(if (not calendar-hebrew-in-ivrit)
  (apply orig-fun date)
 (let* ((this-date (copy-tree (or date (calendar-current-date))))
        (eve (if (not (equal this-date (calendar-current-date)))
               ""
              (let ((sunset (caadr (solar-sunrise-sunset (calendar-current-date))))
                    (hour (string-to-number(format-time-string "%H"))))
                (if (and sunset
                         (or (> hour (truncate sunset))
                             (and (= (truncate sunset) hour)
                                  (> (string-to-number (format-time-string "%M") )
                                     (truncate (* 60 (mod sunset 1)))))))
                  (and (incf (nth 1 this-date))
                       "ליל ") ; alternatively: "אור ליום " ; English: "eve of"
                 ""))))
        (hebrew-date (calendar-hebrew-from-absolute
                      (calendar-absolute-from-gregorian this-date)))
        (calendar-month-name-array
         (if (calendar-hebrew-leap-year-p (calendar-extract-year hebrew-date))
             cal-ivrit-month-name-array-for-leap-year
           cal-ivrit-month-name-array-for-common-year))
        (calendar-day-name-array   cal-ivrit-day-name-array-ivrit)
        (calendar-day-abbrev-array cal-ivrit-day-abbrev-array)
        (calendar-day-header-array cal-ivrit-day-header-array)
        ;; `abbreviate' and `nodayname' are optional args for function
        ;; `calendar-date-string'. Consider allowing those options
        ;; here, but for now hard-code defaults.
        (abbreviate nil)
        (nodayname t)
        (dayname (unless nodayname (calendar-day-name hebrew-date)))
        (month (calendar-extract-month hebrew-date))
        (monthname (calendar-month-name month abbreviate))
        (day (hebrew-numeric (calendar-extract-day hebrew-date) t))
        (month (hebrew-numeric month t))
        (year (substring (hebrew-numeric (calendar-extract-year hebrew-date) t) 2)))
   (concat eve (when dayname (concat dayname ", "))
           day " " monthname  ", " year))))

;;;###cal-autoload
(defun cal-ivrit-parasha-name (p)
  "Name(s) corresponding to parasha P."
  (if (arrayp p)                        ; combined parasha
      (format "%s/%s"
              (aref cal-ivrit-parashiot-names (aref p 0))
              (aref cal-ivrit-parashiot-names (aref p 1)))
    (aref cal-ivrit-parashiot-names p)))

;;;###cal-autoload
(defun cal-ivrit-print-date ()
  "Display in the echo area the Hebrew date at the cursor position."
  (interactive)
  (message "תאריך: %s"
           (cal-ivrit-date-string nil (calendar-cursor-to-date t))))

;;; Diary functions

;; To be called from diary-list-sexp-entries, where DATE is bound.
;;;###diary-autoload
(defun cal-ivrit-diary-date ()
  "Hebrew calendar equivalent of date diary entry, in Hebrew."
  ;; Note the leading space (See commentary/developer notes/RTL)
  (format " תאריך: %s" (cal-ivrit-date-string nil date)))

;; To be called from diary-list-sexp-entries, where DATE is bound.
;;;###diary-autoload
(defun cal-ivrit-diary-parasha (&optional mark)
  "Fancy diary entry for the Hebrew parasha, in Hebrew.
An optional parameter MARK specifies a face or single-character
string to use when highlighting the day in the calendar.

Note that unlike `diary-hebrew-parasha', this function displays a
Parasha name every day of the week."
  (let* ((d (calendar-absolute-from-gregorian (or date (calendar-current-date))))
         (shabbat (if (= (% d 7) 6)
                    ""
                   (setq d (+ d 7))
                   " שבת"))
         (h-year (calendar-extract-year
                  (calendar-hebrew-from-absolute d)))
         (rosh-hashanah
          (calendar-hebrew-to-absolute (list 7 1 h-year)))
         (passover
          (calendar-hebrew-to-absolute (list 1 15 h-year)))
         (rosh-hashanah-day
                (aref calendar-day-name-array (% rosh-hashanah 7)))
         (passover-day
                (aref calendar-day-name-array (% passover 7)))
         (long-h (calendar-hebrew-long-heshvan-p h-year))
         (short-k (calendar-hebrew-short-kislev-p h-year))
         (type (cond ((and long-h (not short-k)) "complete")
                     ((and (not long-h) short-k) "incomplete")
                     (t "regular")))
         (year-format
          (symbol-value
           (intern (format "calendar-hebrew-year-%s-%s-%s" ; keviah
                           rosh-hashanah-day type passover-day))))
         (first-saturday            ; of Hebrew year
          (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah)))
         (saturday             ; which Saturday of the Hebrew year
          (/ (- d first-saturday) 7))
         (parasha (aref year-format saturday)))
  (if parasha
      (cons mark
            (format
             ;; Note the leading space (See commentary/developer notes/RTL)
             "%s פרשת %s"
             shabbat
             (if (listp parasha) ; Israel differs from diaspora
                 (if (car parasha)
                     (format "%s (חו\"ל), %s (א\"י)"
                             (cal-ivrit-parasha-name
                              (car parasha))
                             (cal-ivrit-parasha-name
                              (cdr parasha)))
                   (format "%s (א\"י)"
                           (cal-ivrit-parasha-name
                            (cdr parasha))))
               (cal-ivrit-parasha-name parasha)))))))

;; To be called from diary-list-sexp-entries, where DATE is bound.
;;;###diary-autoload
(defun cal-ivrit-diary-candles (&optional mark)
  "Diary entry for candle lighting time on Sabbath and Holiday eves.
No diary entry if there is no sunset on that date.  Uses
`diary-hebrew-sabbath-candles-minutes'.

An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
  (require 'solar)
  (or (and calendar-latitude calendar-longitude calendar-time-zone)
      (solar-setup))
  (if (= (% (calendar-absolute-from-gregorian date) 7) 5) ; Friday
      (let ((sunset (cadr (solar-sunrise-sunset date))))
        (if sunset
            (cons mark (format
                        " הדלקת נרות: %s"
                        (apply 'solar-time-string
                               (cons (- (car sunset)
                                        (/ diary-hebrew-sabbath-candles-minutes
                                           60.0))
                                     (cdr sunset)))))))))

;;;###diary-autoload
(defun cal-ivrit-diary-fancy-display-mode-hook-function ()
  (setq bidi-paragraph-start-re "^")
  (setq bidi-paragraph-separate-re "^"))


;; TODO:
;;
;; + cal-ivrit-diary-candles
;;   + erev chag
;;   + second-day yom-tov / Sunday yom-tov


;;+ todo for hebraization:
;;    (diary-lunar-phases)
;;    (diary-hebrew-omer)
;;    (diary-hebrew-rosh-hodesh)
;;    (diary-sunrise-sunset)

(provide 'cal-ivrit)

;;; cal-ivrit.el ends here