[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-90-9]+\\)[\n ]*月\\)[\n ]*の?[\n ]*\\([0-90-9]+\\)"
     gdate-make-date-from-mmdd 2 3)

    ("\\([0-90-9]+\\) *[//] *\\([0-90-9]+\\)"
     gdate-make-date-from-mmdd 1 2)

    throw

    ("\\(今度\\|[今来次]週\\|再来週\\)[\n ]*の?[\n ]*\\([月火水木金土日]\\)曜"
     gdate-make-date-from-relative-week 1 2)

    throw
    
    ("\\([0-90-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
    ))