Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 146 lines (124 sloc) 5.112 kb
d577cd6 @cinsk intermediate change
authored
1 ;;; gencache.el ---
2
3 ;; Copyright (C) 2011 Seong-Kook Shin
4
5 ;; Author: Seong-Kook Shin <cinsky@gmail.com>
6 ;; Keywords:
7
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
12
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
17
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
20
21 ;;; Commentary:
22
55afdf2 @cinsk First working (it would seem) implementation
authored
23 ;; In my first implementation, I used to generate "lunar-ko-cache.el"
24 ;; using a Ruby script, since Ruby does have support for sqlite3
25 ;; database. In that implementation, I generate (julian . kld) pair
26 ;; where JULIAN is the Astronomical Julian Day(AJD) number, and KLD is
27 ;; the numerical representation of Korean lunar date.
28 ;;
29 ;; Unfortunately, the Emacs algorithm that convert Gregorian date to
30 ;; julian day number is different from that of Ruby. For example,
31 ;;
32 ;; Gregorian Emacs AJD Ruby AJD
33 ;; ---------- --------- ---------
34 ;; 1582-10-04 2299149.5 2299159.5
35 ;; 1582-10-05 2299150.5 N/A
36 ;; ... ... N/A
37 ;; 1582-10-14 2299159.5 N/A
38 ;; 1582-10-15 2299160.5 2299160.5
39 ;;
40 ;; (Note that Gregorian calendar starts from 1582-10-15.)
41 ;;
42 ;; Thus, I first create intermediate file using Ruby to read sqlite3
43 ;; database, then using Emacs lisp to generate "lunar-ko-cache.el".
d577cd6 @cinsk intermediate change
authored
44
45 ;;; Code:
46
47 (require 'calendar)
48
55afdf2 @cinsk First working (it would seem) implementation
authored
49 ;; To run:
d577cd6 @cinsk intermediate change
authored
50 ;;
55afdf2 @cinsk First working (it would seem) implementation
authored
51 ;; $ emacs -q -L . -l gencache --batch \
52 ;; -f lunar-ko-generate-cache "./script/cache.dat" "cache.el"
d577cd6 @cinsk intermediate change
authored
53 ;;
55afdf2 @cinsk First working (it would seem) implementation
authored
54 ;; See "Rakefile" for more.
d577cd6 @cinsk intermediate change
authored
55
56 ;
57 ; TODO: consult `batch-byte-compile' and modify
58 ; `lunar-ko-generate-cache' so that it can get the arguments from
59 ; command line.
60 ;
61
62 (defun gregorian-to-julian (date)
63 "Convert gregorian date in the form of (MONTH DAY YEAR) to
64 Julian day number. See also `calendar-astro-date-string'."
65 (calendar-astro-from-absolute
66 (calendar-absolute-from-gregorian date)))
67
55afdf2 @cinsk First working (it would seem) implementation
authored
68 (defvar cache-header
69 (format ";;; lunar-ko-cache.el --- cache data for Korean lunar calendar
70
71 ;; Automatically generated by gencache.el in %s
72
73 (defconst korean-lunar-cache
74 [" (current-time-string))
75 "cache header")
76
77 (defvar cache-tail
78 "]
79 \"Solar to Korean lunar cache\")
80
81 (provide 'lunar-ko-cache)"
82 "cache tail")
83
84 (defun lunar-ko-generate-cache (&optional srcfile outfile)
d577cd6 @cinsk intermediate change
authored
85 (let ((coding-system-for-read 'utf-8)
86 (coding-system-for-write 'utf-8))
55afdf2 @cinsk First working (it would seem) implementation
authored
87 (if (and noninteractive
88 (consp command-line-args-left)
89 (> (length command-line-args-left) 0))
90 (setq srcfile (car command-line-args-left)
91 outfile (cadr command-line-args-left)))
d577cd6 @cinsk intermediate change
authored
92 (let* ((srcpath (expand-file-name srcfile))
93 (outpath (expand-file-name
94 (or outfile
55afdf2 @cinsk First working (it would seem) implementation
authored
95 (replace-regexp-in-string
96 "\\.[^.]*$" ".el" srcfile)))))
97 ;;(message "srcpath: %s" srcpath)
98 ;;(message "outpath: %s" outpath)
99 ;;(message "args: %S" command-line-args-left)
100
101 (if (not (file-readable-p srcpath))
102 (error "error: cannot find %s" srcpath))
103 (let ((srcbuf (find-file-noselect srcpath t))
d577cd6 @cinsk intermediate change
authored
104 (outbuf (create-file-buffer outpath)))
105 (save-current-buffer
106 (set-buffer outbuf)
107 (setq buffer-file-name outpath)
108 ;;(setq buffer-file-coding-system 'utf-8)
55afdf2 @cinsk First working (it would seem) implementation
authored
109 ;;(set-buffer-multibyte t)
110 (emacs-lisp-mode)
111 (insert cache-header))
d577cd6 @cinsk intermediate change
authored
112 (save-current-buffer
113 (set-buffer srcbuf)
114 (goto-char (point-min))
115 (while (search-forward-regexp
116 "^\\([0-9]*\\)-\\([0-9]*\\)-\\([0-9]*\\) \\([0-9]*\\) \\(.*\\)$"
117 nil t)
118 (let ((year (string-to-number (match-string-no-properties 1)))
119 (month (string-to-number (match-string-no-properties 2)))
120 (day (string-to-number (match-string-no-properties 3)))
121 (lunar (match-string-no-properties 4))
55afdf2 @cinsk First working (it would seem) implementation
authored
122 (text (string-to-multibyte (match-string-no-properties 5))))
123 (if (string-match "???001001$" lunar)
124 (message "Generating cache for ..%d.." year))
d577cd6 @cinsk intermediate change
authored
125 (save-current-buffer
126 (set-buffer outbuf)
127 (goto-char (point-max))
128 (let ((date (list month day year)))
129 (indent-according-to-mode)
130 (insert (format "(%.1f . %s) ; %s\n"
131 (gregorian-to-julian date)
132 lunar text)))))))
133 (save-current-buffer
134 (set-buffer outbuf)
55afdf2 @cinsk First working (it would seem) implementation
authored
135 (goto-char (point-max))
136 (insert cache-tail)
d577cd6 @cinsk intermediate change
authored
137 (save-buffer))
55afdf2 @cinsk First working (it would seem) implementation
authored
138 (when nil
139 (kill-buffer srcbuf)
140 (kill-buffer outbuf))
141 ))))
d577cd6 @cinsk intermediate change
authored
142
143
144 (provide 'gencache)
145 ;;; gencache.el ends here
Something went wrong with that request. Please try again.