insert japanese day of the week

insert-japanese-day-of-the-week.el

;; Copyright 2019 Jun Morimoto
;; This file 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 3, or (at your option)
;; any later version.
;; This file 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 this program.  If not, see <http://www.gnu.org/licenses/>.

(defun insert-japanese-day-of-the-week (arg)
  (interactive "p")
  (let ((tbl '((0 . "日") (1 . "月") (2 . "火") (3 . "水") (4 . "木") (5 . "金") (6 . "土")))
	(year) (month) (day)
	(hour 0) (minute 0) (second 0)
	(time))
    (save-excursion
      ;; まずはさかのぼってmm/ddを検索
      (if (re-search-forward "\\b\\([0-9][0-9]*\\)[/\\.]\\([0-9][0-9]*\\)" nil t -1)
	  (progn
	    (setq year (nth 5 (decode-time)))
	    (setq month (string-to-number (match-string 1)))
	    (setq day (string-to-number (match-string 2)))
	    ;; さらに手前に西暦もありそうなら
	    (if (string-match "[0/\\.]"
			      (buffer-substring
			       ((lambda (v) (if (> v 1) (- v 1) 1)) (point))
			       (point)))
		;; さかのぼってyyyy/があるかも検索
		(if (re-search-forward "\\([0-9]\\{4\\}\\)[/\\.]0*" nil t -1)
		    (setq year (string-to-number (match-string 1)))))
    	    (setq time (encode-time second minute hour day month year)))))
    (if time
	(insert (format "(%s)" (cdr (assoc (nth 6 (decode-time time)) tbl))))
      (message "Can't find date description"))))

(global-set-key "\C-x\C-d" 'insert-japanese-day-of-the-week)