[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[mhc:00593] Re: mhc-calendar.el
乃村です。実は現実逃避。。
# 僕って、つくづく文章書くの嫌いなんだな。。よく、この商売やってるな。
On Wed, 10 May 2000 20:01:49 +0900,
Hideyuki SHIRAI (白井秀行) <shirai@xxxxxxxxxxxxxxxxxxx> said:
> 1. いろんなところから M-x mhc-calendar をされると、どこから呼ば
> れたのか私の技術力ではわからなくなる。
なるほど。invoke されたときに、
(setq mhc-calendar-parent-buffer (current-buffer)) ;; 変数名適当
を実行するだけではダメなんでしたっけ。
> 2. そのかわりに、"/", "," を作ったから、まぁいいか。
はい。いろんな所に挿入できて、これも便利ですね。
> # 気に入らないのは "2000/05/12" じゃなくて、本当は "5/12/2000"
> # だぞ、ってところかな？
うーむ。世間の慣習としては 5/12/2000 なんでしょうか。
年月日の順に入れていく方が、省略した場合の規則がすっきりして素直だと
思うのは僕だけ?
> 乃村> あれ、日だけの場合も guess しないんでしたっけ。日だけのと、
> 乃村> 「来週の金曜日」 も guess するようにしてみましょう。
>
> よろしくお願いします。(_ _)
ちょっと実験してみました。後ろに付けます。
ただ、素直に、「金曜日」 や 「15日」 とかにも反応するようにすると、
guess の精度が落ちるんですよね。
なので、現状では、xx月xx日 や xx/xx がまったく見付けられなかったときだけ
「明日」 や 「来週の金曜日」 や 「15日」 も拾って来るようにしています。
もうちょっと考える必要がありそうです。
mhc がロードされている状態で、M-x eval-current-buffer して使って
みて下さい。
> 乃村> もちろん yyyy/mm/dd の dd 以外は省略できます。
>
> ### うぅ、知らなかった。2000 から打っていました。^^;;;
あら、白井さんが知らないということは、ほどんどの人は知らなのかも。
15 … 今月の 15日
5/15 18 … 5月 15日と 18日
19-21 … 今月の 19日から 21日
# こっそり、ドキュメントに書いてあるつもり。。
> とおっしゃって下さったので、mhc*.el にあたるパッチにした方がきれ
> いですね。
そうですね mhc-calendar は別ファイルにして、
mhc.el から mhc-calendar に関する部分を抜いて再構成しましょう。
来週は暇になる予定なので、0.25 リリースしたら、pserver 立てます。
--
nom
;;
;; regexp for rfc822 Date: field.
;;
(defvar date-field-regex
;; assuming ``Tue, 9 May 2000 12:15:12 -0700 (PDT)''
(concat
"\\([0-9]+\\)[ \t]+" ;; day
"\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|" ;;
"Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ \t]+" ;; month
"\\([0-9]+\\)[ \t]+" ;; year
"\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?[ \t]*" ;; hh:mm(:ss)?
"\\([A-Z][A-Z][A-Z]\\|[-+][0-9][0-9][0-9][0-9]\\)" ;; JST or +0900
))
;;
;; parse rfc822 Date: field.
;;
(defun ddate-new-from-rfc822-date (string)
(if (and (stringp string) (string-match date-field-regex string))
(let ((day (ddate-substring-to-int string 1))
(mon (substring string (match-beginning 2) (match-end 2)))
(year (ddate-substring-to-int string 3))
(min (+ (* 60 (ddate-substring-to-int string 4))
(ddate-substring-to-int string 5)))
(tz (substring string (match-beginning 8) (match-end 8)))
tz-offset)
(setq
year (cond
((< year 50) (+ year 2000))
((< year 100) (+ year 1900))
(t year))
mon (1+ (/ (string-match mon
"JanFebMarAprMayJunJulAugSepOctNovDec") 3))
tz-offset (time-zone-string-to-minute-offset tz)
min (+ min tz-offset))
(car (cond
((< min 0)
(setq min (+ min 1440))
(list (ddate-dec (ddate-new year mon day))
(dtime-new (/ min 60) (% min 60))
tz-offset))
((>= min 1440)
(setq min (- min 1440))
(list (ddate-inc (ddate-new year mon day))
(dtime-new (/ min 60) (% min 60))
tz-offset))
(t
(list (ddate-new year mon day)
(dtime-new (/ min 60) (% min 60))
tz-offset)))))))
;; according to our current time zone,
;; convert timezone string into offset minutes
;;
;; for example, if current time zone is in Japan,
;; convert "GMT" or "+0000" into 540.
(defun time-zone-string-to-minute-offset (timezone)
(let ((tz (or (cdr (assoc timezone
'(("PST" . "-0800") ("PDT" . "-0700")
("MST" . "-0700") ("MDT" . "-0600")
("CST" . "-0600") ("CDT" . "-0500")
("EST" . "-0500") ("EDT" . "-0400")
("AST" . "-0400") ("NST" . "-0300")
("UT" . "+0000") ("GMT" . "+0000")
("BST" . "+0100") ("MET" . "+0100")
("EET" . "+0200") ("JST" . "+0900"))))
timezone))
min
offset)
(if (string-match "\\([-+]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)" tz)
(progn
(setq min (* (+ (* 60 (ddate-substring-to-int tz 2))
(ddate-substring-to-int tz 3))
(if (string= "+"
(substring tz
(match-beginning 1)
(match-end 1)))
1 -1))
offset (- (/ (car (current-time-zone)) 60) min))))))
;;
;; regex for get date strings.
;;
(setq gdate-date-regex-list
'(
("\\(\\([来今０-９0-9]+\\)[\n ]*月\\)[\n ]*の?[\n ]*\\([０-９0-9]+\\)"
gdate-make-date-from-mmdd 2 3)
("\\([０-９0-9]+\\) *[／/] *\\([０-９0-9]+\\)"
gdate-make-date-from-mmdd 1 2)
throw
("\\(今度\\|[今来次]週\\|再来週\\)[\n ]*の?[\n ]*\\([月火水木金土日]\\)曜"
gdate-make-date-from-relative-week 1 2)
throw
("\\([０-９0-9]+\\)[\n ]*日"
gdate-make-date-from-mmdd nil 1)
("\\([月火水木金土日]\\)\n?曜"
gdate-make-date-from-relative-week nil 1)
("\\(本日\\|今日\\|あす\\|あした\\|あさって\\|明日\\|明後日\\)"
gdate-make-date-from-relative-day 1)
))
;;
;; returns (((ptr-begin . ptr-end) . ddate) ...)
;;
(defun gdate-gather-date-list (regexp-lst)
(let ((ret nil)
(now (or (ddate-new-from-rfc822-date (mhc-misc-hdr-value "Date:"))
(ddate-now)))
date-list)
(while regexp-lst
(cond
((listp (car regexp-lst))
(if (setq date-list
(gdate-gather-date-list2
(car (car regexp-lst)) ;; regexp
now ;; current date
(car (cdr (car regexp-lst))) ;; convfunc
(cdr (cdr (car regexp-lst))) ;; posision list
))
(setq ret (nconc ret date-list))))
((and (string= "throw" (symbol-name (car regexp-lst))) ret)
(setq regexp-lst nil)))
(setq regexp-lst (cdr regexp-lst)))
ret))
(defun gdate-gather-date-list2 (regexp now convfunc pos-list)
(let* (lst ddate param-list p)
(save-excursion
;; skip Header
(goto-char (point-min))
(re-search-forward "^-*$" nil t)
;; search candities.
(while (re-search-forward regexp nil t)
(setq p pos-list
param-list nil)
(while p
(setq param-list
(cons
(if (and (car p) (match-beginning (car p)))
(buffer-substring (match-beginning (car p))
(match-end (car p)))
nil)
param-list))
(setq p (cdr p)))
(if (setq ddate (apply 'funcall convfunc now (nreverse param-list)))
(setq lst (cons
(cons (cons (match-beginning 0)
(match-end 0)) ddate) lst)))))
(nreverse lst)))
(defun gdate-make-date-from-mmdd (now mm-str dd-str)
(let ((data (match-data))
(mm (if mm-str (gdate-string-to-int mm-str) 0))
(dd (if dd-str (gdate-string-to-int dd-str) 0))
(year-offset 0)
ddate)
(cond
((string= mm-str "来")
(setq mm (ddate-mm (ddate-mm-inc now))))
((string= mm-str "今")
(setq mm (ddate-mm now)))
((= mm 0)
(setq mm (ddate-mm now))))
(if (not (setq ddate (ddate-new (ddate-yy now) mm dd t))) ;; noerror is t
()
;; if ddate is past, assume the next year.
(if (ddate< ddate now)
(setq year-offset (1+ year-offset)))
;; if ddate is far future, assume the last year.
(if (< 300 (+ (ddate- ddate now) (* year-offset 365)))
(setq year-offset (1- year-offset)))
(setq ddate (ddate-yy-inc ddate year-offset)))
(store-match-data data)
ddate))
(defun gdate-make-date-from-relative-day (now rel-word)
(cond
((null rel-word)
nil)
((or (string= rel-word "今日") (string= rel-word "本日"))
now)
((or (string= rel-word "あす")
(string= rel-word "あした")
(string= rel-word "明日"))
(ddate-inc now))
((or (string= rel-word "あさって")
(string= rel-word "明後日"))
(ddate-inc (ddate-inc now)))))
(defun gdate-make-date-from-relative-week (now rel-word week)
(let ((data (match-data))
(ww (string-match week "日月火水木金土"))
off
(ddate (or now (ddate-now))))
(setq off (- ww (ddate-ww (or now (ddate-now)))))
(if (string= week "日") (setq off (+ 7 off)))
(setq off
(cond
((or (null rel-word)
(string= rel-word "今度")
(string= rel-word "次"))
(if (<= off 0) (+ 7 off) off))
((string= rel-word "今週") off)
((string= rel-word "来週")
(+ off 7))
((string= rel-word "再来週")
(+ off 14))))
(while (< off 0)
(setq ddate (ddate-dec ddate)
off (1+ off)))
(while (> off 0)
(setq ddate (ddate-inc ddate)
off (1- off)))
(store-match-data data)
ddate
))