[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[mhc:02157] mhc-goto-date



C-c.g (mhc-goto-month) だと指定した日付にはとべないのと
日付のguessををしてほしかったのでmhc-goto-dateをつくってみました。
#mhc-goto-dayはmhc-goto-todayのパクリです。

--
KOIE Hidetaka <hide@xxxxxxxx>
(defun mhc-goto-date (&optional hide-private)
  "*Show schedules of specified date.
If HIDE-PRIVATE, private schedules are suppressed."
  (interactive
   (list
    (if mhc-default-hide-private-schedules
	(not current-prefix-arg)
      current-prefix-arg)))
  (let* ((owin (get-buffer-window (current-buffer)))
         (buf (mhc-summary-get-import-buffer))
          (win (if buf (get-buffer-window buf) nil))
          date daten)
    (save-excursion
      (when win (select-window win))
      (let* ((current-date (or (mhc-current-date) (mhc-calendar-get-date))))
        (setq date (car (mhc-input-day "Date: " current-date (mhc-guess-date))))
        (setq daten (mhc-date-let date
                      (mhc-date-new yy mm dd))))
      (select-window owin)
    (mhc-goto-month daten hide-private)
    (mhc-goto-day date))))
(defun mhc-goto-day (now)
  "*Go to to the line of specified date schedule.
"
  (let (;;(now (mhc-date-now))  ;; mhc-goto-todayからの変更点はここだけ
	(buf-date (mhc-current-date-month)))
    (when buf-date
      (goto-char (point-min))
      (mhc-date-let now
	(if (and (= yy (mhc-date-yy buf-date))
		 (= mm (mhc-date-mm buf-date)))
	    (when (mhc-summary-search-date now)
	      (forward-line 0)
	      (or (pos-visible-in-window-p (point))
		  (recenter))
	      (or no-display
		  (mhc-summary-display-article)))
	  (when (and mhc-use-wide-scope
		     (mhc-summary-search-date (mhc-date-mm-first buf-date)))
	    (forward-line 0)
	    (or (pos-visible-in-window-p (point))
		(recenter))
	    (or no-display
		(mhc-summary-display-article)))))
      ;; Emacs-21.3.50 something wrong
      (beginning-of-line))))
(add-hook 'mhc-setup-hook
          (function
           (lambda ()
             (define-key global-map "\C-cg" 'mhc-goto-date))))