mhc 1.0.0

data/emacs/mhc-day.el

@@ -0,0 +1,149 @@
+;;; -*- mode: Emacs-Lisp; coding: utf-8 -*-
+
+;; Author:  Yoshinari Nomura <nom@quickhack.net>,
+;;          TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+;; Created: 2000/05/04
+;; Reviesd: $Date$
+
+
+;;; Commentary:
+
+;; This file is a part of MHC, and includes functions to manipulate
+;; MHC-DAY structure.
+
+
+;;; About MHC-DAY structure:
+
+;; Each MHC-DAY structure is a cons cell has a construction as
+;; follows:
+;;
+;;     MHC-DAY      ::= ( KEY . VALUE )
+;;     KEY          ::= DATE
+;;     VALUE        ::= [ YEAR MONTH DAY-OF-MONTH DAY-OF-WEEK HOLIDAY SCHEDULES ]
+;;     YEAR         ::= integer, larger than 1900.
+;;     MONTH        ::= integer, between 1 and 12.
+;;     DAY-OF-MONTH ::= integer, between 1 and 31.
+;;     DAY-OF-WEEK  ::= integer, between 0 and 6.
+;;     HOLIDAY      ::= nil or t.  t stands for holiday.
+;;     SCHEDULES    ::= MHC-SCHEDULE*
+
+
+;;; Code:
+
+;; Function and macros to manipulate MHC-DAY structure:
+
+(defun mhc-day-new (date &optional year month day-of-month day-of-week holiday schedules)
+  "Constructor of MHC-DAY structure."
+  (cons date
+        (vector (or year (mhc-date-yy date))
+                (or month (mhc-date-mm date))
+                (or day-of-month (mhc-date-dd date))
+                (or day-of-week (mhc-date-ww date))
+                holiday
+                schedules)))
+
+(defmacro mhc-day/key (dayinfo)
+  `(car ,dayinfo))
+(defmacro mhc-day/value (dayinfo)
+  `(cdr ,dayinfo))
+
+(defmacro mhc-day-date (dayinfo)
+  `(mhc-day/key ,dayinfo))
+(defmacro mhc-day-year (dayinfo)
+  `(aref (mhc-day/value ,dayinfo) 0))
+(defmacro mhc-day-month (dayinfo)
+  `(aref (mhc-day/value ,dayinfo) 1))
+(defmacro mhc-day-day-of-month (dayinfo)
+  `(aref (mhc-day/value ,dayinfo) 2))
+(defmacro mhc-day-day-of-week (dayinfo)
+  `(aref (mhc-day/value ,dayinfo) 3))
+(defmacro mhc-day-holiday (dayinfo)
+  `(aref (mhc-day/value ,dayinfo) 4))
+(defmacro mhc-day-schedules (dayinfo)
+  `(aref (mhc-day/value ,dayinfo) 5))
+
+(defmacro mhc-day-set-holiday (dayinfo holiday)
+  `(aset (mhc-day/value ,dayinfo) 4 ,holiday))
+(defmacro mhc-day-set-schedules (dayinfo schedules)
+  `(aset (mhc-day/value ,dayinfo) 5 ,schedules))
+
+(defun mhc-day-day-of-week-as-string (dayinfo)
+  "Return three letter code of the day of week."
+  (aref ["Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"]
+        (mhc-day-day-of-week dayinfo)))
+
+(defun mhc-day-busy-p (dayinfo)
+  (let ((schedules (mhc-day-schedules dayinfo)))
+    (catch 'busy
+      (while schedules
+        (or (mhc-schedule-in-category-p (car schedules) "holiday")
+            (throw 'busy t))
+        (setq schedules (cdr schedules))))))
+
+
+
+;; Utility functions:
+
+(defmacro mhc-day-let (day &rest form) "\
+This special form converts DAY, as the number of days since
+1970/01/01, to following local variables, and evaluates FORM.
+
+     year
+          The year, an integer typically greater than 1900.
+
+     month
+          The month of the year, as an integer between 1 and 12.
+
+     day-of-month
+          The day of the month, as an integer between 1 and 31.
+
+     day-of-week
+          The day of week, as an integer between 0 and 6, where 0
+          stands for Sunday.
+"
+  (let ((tempvar (make-symbol "decode-time")))
+    `(let* ((,tempvar (mhc-date-to-list , day))
+            (day-of-month (nth 2 ,tempvar))
+            (month (nth 1 ,tempvar))
+            (year (nth 0 ,tempvar))
+            (day-of-week (nth 3 ,tempvar)))
+       ,@form)))
+(put 'mhc-day-let 'lisp-indent-function 1)
+(put 'mhc-day-let 'edebug-form-spec '(form body))
+
+
+
+(provide 'mhc-day)
+
+;;; Copyright Notice:
+
+;; Copyright (C) 1999, 2000 Yoshinari Nomura. All rights reserved.
+;; Copyright (C) 2000 MHC developing team. All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;;    notice, this list of conditions and the following disclaimer in the
+;;    documentation and/or other materials provided with the distribution.
+;; 3. Neither the name of the team nor the names of its contributors
+;;    may be used to endorse or promote products derived from this software
+;;    without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS''
+;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
+;; THE TEAM OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+;; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+;; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+;; OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; mhc-day.el ends here.

data/emacs/mhc-db.el

@@ -0,0 +1,158 @@
+;;; -*- mode: Emacs-Lisp; coding: utf-8 -*-
+
+;; Author:  Yoshinari Nomura <nom@quickhack.net>,
+;;          TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+;; Created: 2000/05/01
+;; Revised: $Date$
+
+
+;;; Commentary:
+
+;; This file is a part of MHC, and includes functions to manipulate
+;; database of schedules.
+
+
+;;; Code:
+
+(require 'mhc-day)
+(require 'mhc-process)
+(require 'mhc-schedule)
+
+(defun mhc-db-scan (b e &optional nosort category search)
+  (mhc-process-send-command
+   (format "scan --format=emacs %04d%02d%02d-%04d%02d%02d%s%s"
+           (mhc-date-yy b)
+           (mhc-date-mm b)
+           (mhc-date-dd b)
+           (mhc-date-yy e)
+           (mhc-date-mm e)
+           (mhc-date-dd e)
+           (if category  (format " --category=%s" category) "")
+           (if search  (format " --search='%s'" search) ""))))
+
+(defun mhc-db-search (&rest query)
+  (let ((b (mhc-date-new 1970 1 1))
+        (e (mhc-date-yy++ (mhc-date-now))))
+    (mhc-db-scan b e nil nil (mhc-db/query-to-search-string query))))
+
+(defun mhc-db/quote-string (string)
+  (format "\"%s\"" string))
+
+(defun mhc-db/keyword-to-string (keyword)
+  (format "%s" keyword))
+
+(defun mhc-db/query-to-search-string (query)
+  (let ((keywords '(:subject :body :category)) string)
+    (mapconcat 'identity
+               (delq nil
+                     (mapcar
+                      (lambda (keyword)
+                        (if (setq string (plist-get query keyword))
+                            (format "%s:%s" (substring (symbol-name keyword) 1)
+                                    (mhc-db/quote-string string))))
+                      keywords))
+               " | ")))
+
+(defun mhc-db-scan-month (year month &optional nosort category)
+  (let ((first-date (mhc-date-new year month 1)))
+    (mhc-db-scan first-date
+                 (mhc-date-mm-last first-date)
+                 nosort
+                 category)))
+
+(defun mhc-db-add-record-from-buffer (record buffer &optional force-refile)
+  (let* ((slot (mhc-logic-record-to-slot record))
+         (directory (and slot
+                         (file-name-as-directory
+                          (expand-file-name
+                           "spool" (mhc-config-base-directory)))))
+         (old-record))
+    (unless slot (error "Cannot get schedule slot"))
+    (if (mhc-record-name record)
+        ;; Modifying existing record
+        (setq old-record record)
+      ;; Creating new record
+      (mhc-record-set-name record (mhc-misc-get-new-path directory record)))
+    (if (or force-refile
+            (y-or-n-p (format
+                       "Refile %s to %s "
+                       (or (mhc-record-name old-record) "it")
+                       (mhc-record-name record))))
+        (progn
+          (mhc-record-write-buffer record buffer old-record)
+          (if (and old-record
+                   (not (eq record old-record)))
+              (let* ((dir (file-name-directory
+                           (directory-file-name
+                            (mhc-record-name old-record)))))
+                (mhc-misc-touch-directory dir)))
+          (mhc-misc-touch-directory directory)
+          t))))
+
+
+(defun mhc-db-delete-file (record)
+  (let* ((dir (file-name-directory (directory-file-name (mhc-record-name record)))))
+    (mhc-record-delete record)
+    (mhc-misc-touch-directory dir)))
+
+;; FIXME: X-SC-Schedule ヘッダによって指定された子スケジュールに対する
+;; 例外規則の追加が動作しない。
+(defun mhc-db-add-exception-rule (original-record except-day)
+  (let ((date-string (mhc-day-let except-day
+                       (format "%04d%02d%02d" year month day-of-month))))
+    (with-temp-buffer
+      (mhc-draft-reedit-file (mhc-record-name original-record))
+      (let (record dayinfo schedule)
+        (while (setq record (mhc-parse-buffer)
+                     dayinfo (mhc-logic-eval-for-date (list (mhc-record-sexp record)) except-day)
+                     schedule (car (mhc-day-schedules dayinfo)))
+          (save-restriction
+            (narrow-to-region (mhc-schedule-region-start schedule)
+                              (mhc-schedule-region-end schedule))
+            (mhc-header-put-value
+             "x-sc-day"
+             (mapconcat 'identity
+                        (cons (format "!%s" date-string)
+                              (delete date-string
+                                      (mhc-logic-day-as-string-list
+                                       (mhc-schedule-condition schedule))))
+                        " "))))
+        (mhc-record-set-name record (mhc-record-name original-record))
+        (mhc-db-add-record-from-buffer record (current-buffer))))))
+
+
+
+(provide 'mhc-db)
+
+;;; Copyright Notice:
+
+;; Copyright (C) 1999, 2000 Yoshinari Nomura. All rights reserved.
+;; Copyright (C) 2000 MHC developing team. All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;;    notice, this list of conditions and the following disclaimer in the
+;;    documentation and/or other materials provided with the distribution.
+;; 3. Neither the name of the team nor the names of its contributors
+;;    may be used to endorse or promote products derived from this software
+;;    without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS''
+;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
+;; THE TEAM OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+;; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+;; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+;; OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; mhc-db.el ends here.

data/emacs/mhc-draft.el

@@ -0,0 +1,211 @@
+;;; mhc-draft.el --- Draft modules for MHC.
+
+;; Author:  Yoshinari Nomura <nom@quickhack.net>,
+;;          Yuuichi Teranishi <teranisi@quickhack.net>
+;; Created: 2000/07/25
+;; Revised: $Date: 2008/07/04 06:01:20 $
+
+;;; Commentary:
+
+;; This file is a part of MHC, includes functions for draft.
+
+;;; About MUA Backend:
+
+;; In order to define new MUA backend, it is required to define these
+;; methods.
+;;
+;;     (mhc-foo-draft-setup-new)
+;;         Setup new draft (Insert header separator).
+;;
+;;     (mhc-foo-draft-reedit-buffer BUFFER ORIGINAL)
+;;         Restore content of BUFFER as draft in the current buffer.
+;;         If ORIGINAL is non-nil, use BUFFER as raw buffer.
+;;
+;;     (mhc-foo-draft-reedit-file FILENAME)
+;;         Restore contents of file FILENAME as draft in the current buffer.
+;;
+;;     (mhc-foo-draft-translate)
+;;         Translate current buffer to raw buffer.
+;;
+;; Define these methods appropriately, and put definitions as follows:
+;;
+;;    (put 'mhc-foo 'draft-setup-new 'mhc-foo-draft-setup-new)
+;;    (put 'mhc-foo 'draft-reedit-buffer 'mhc-foo-draft-reedit-buffer)
+;;    (put 'mhc-foo 'draft-reedit-file 'mhc-foo-draft-reedit-file)
+;;    (put 'mhc-foo 'draft-translate 'mhc-foo-draft-translate)
+
+;;; Code:
+
+(require 'mhc-summary)
+
+;; Global Variable:
+
+(defconst mhc-draft-buffer-name "*mhc draft*")
+
+(defcustom mhc-draft-unuse-hdr-list
+  '(">From " "From " "Delivered-To:" "Delivery-date:" "Envelope-to:"
+    "Errors-To:" "Gnus-Warning:" "Lines:" "Posted:" "Precedence:" "Received:"
+    "Replied:" "Return-Path:" "Sender:" "User-Agent:" "X-Bogosity:"
+    "X-Dispatcher:" "X-Filter:" "X-Gnus-Mail-Source:" "X-Mailer:" "X-Received:"
+    "X-Sender:" "X-Seqno:" "X-Spam-Flag:" "X-Spam-Probability:" "X-UIDL:"
+    "Xref:")
+  "*These headers are removed when article is imported."
+  :group 'mhc
+  :type '(repeat string))
+
+(defcustom mhc-draft-mode-hook nil
+  "*Hook run in mhc draft mode buffers."
+  :group 'mhc
+  :type 'hook)
+
+;; Avoid warning of byte-compiler.
+(defvar mhc-draft-buffer-file-name nil)
+
+(defvar mhc-draft-mode-map)
+
+(defsubst mhc-draft-setup-new ()
+  "Setup new draft (Insert header separator, etc)."
+  (funcall (mhc-get-function 'draft-setup-new)))
+
+
+(defsubst mhc-draft-reedit-buffer (buffer &optional original)
+  "Restore contents of BUFFER as draft in the current buffer.
+If optional argument ORIGINAL is non-nil, BUFFER is raw buffer."
+  (funcall (mhc-get-function 'draft-reedit-buffer) buffer original))
+
+
+(defsubst mhc-draft-reedit-file (filename)
+  "Restore contents of file FILENAME as draft in the current buffer."
+  (funcall (mhc-get-function 'draft-reedit-file) filename))
+
+
+(defsubst mhc-draft-translate ()
+  "Translate current buffer to raw buffer."
+  (funcall (mhc-get-function 'draft-translate)))
+
+
+(define-derived-mode mhc-draft-mode
+  text-mode
+  "MHC-Draft"
+  "Major mode for editing schdule files of MHC.
+Like Text Mode but with these additional commands:
+C-c C-c  mhc-draft-finish
+C-c C-k  mhc-draft-kill
+C-c C-q  mhc-draft-kill
+C-c ?    mhc-draft-insert-calendar
+.
+"
+  (define-key mhc-draft-mode-map "\C-c\C-c" 'mhc-draft-finish)
+  (define-key mhc-draft-mode-map "\C-c\C-q" 'mhc-draft-kill)
+  (define-key mhc-draft-mode-map "\C-c\C-k" 'mhc-draft-kill)
+  (define-key mhc-draft-mode-map "\C-c?" 'mhc-draft-insert-calendar)
+  (make-local-variable 'adaptive-fill-regexp)
+  (setq adaptive-fill-regexp
+        (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
+                adaptive-fill-regexp))
+  (unless (boundp 'adaptive-fill-first-line-regexp)
+    (setq adaptive-fill-first-line-regexp nil))
+  (make-local-variable 'adaptive-fill-first-line-regexp)
+  (setq adaptive-fill-first-line-regexp
+        (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
+                adaptive-fill-first-line-regexp))
+  (mhc-highlight-message t)
+  (set (make-local-variable 'indent-tabs-mode) nil))
+
+(defun mhc-draft-kill (&optional no-confirm)
+  "Kill current draft.
+If optional argument NO-CONFIRM is non-nil, kill without confirmation."
+  (interactive "P")
+  (if (or no-confirm (y-or-n-p "Kill draft buffer? "))
+      (progn
+        (message "")
+        (mhc-calendar-input-exit)
+        (kill-buffer (current-buffer))
+        (mhc-window-pop))))
+
+(defvar mhc-draft-finish-hook nil
+  "Hook run after `mhc-draft-finish'.")
+
+(defun mhc-draft-append-category (category)
+  "Append CATEGORY if it is not contained yet."
+  (mhc-header-narrowing
+    (let ((categories (mhc-header-get-value "x-sc-category")))
+      (unless (string-match category categories)
+        (mhc-header-put-value "x-sc-category"
+                              (concat categories " " category))))))
+
+(defun mhc-draft-in-category-p (category)
+  (mhc-header-narrowing
+    (string-match (concat "[ \t]*" category)
+                  (mhc-header-get-value "x-sc-category"))))
+
+(defun mhc-draft-delete-category (category)
+  "Delete CATEGORY if it is contained."
+  (mhc-header-narrowing
+    (let ((categories (mhc-header-get-value "x-sc-category")))
+      (when (string-match (concat "[ \t]*" category) categories)
+        (setq categories (concat
+                          (substring categories 0 (match-beginning 0))
+                          (substring categories (match-end 0))))
+        (when (string-match "[ \t]+$" categories)
+          (setq categories (substring categories 0 (match-beginning 0))))
+        (mhc-header-put-value "X-SC-Category" categories)))))
+
+(defun mhc-draft-increment-sequence ()
+  "Increment X-SC-Sequence in mhc-draft buffer."
+  (mhc-header-narrowing
+    (let ((sequence (or (mhc-header-get-value "x-sc-sequence") "0")))
+      (mhc-header-put-value "x-sc-sequence"
+                            (1+ (string-to-number sequence))))))
+
+(defun mhc-draft-finish ()
+  "Add current draft as a schedule."
+  (interactive)
+  (let ((record
+         (mhc-parse-buffer (mhc-record-new mhc-draft-buffer-file-name)
+                           'strict)))
+    (mhc-calendar-input-exit)
+    (if (mhc-db-add-record-from-buffer record (current-buffer)
+                                       (not (called-interactively-p 'interactive)))
+        (progn
+          (kill-buffer (current-buffer))
+          (mhc-window-pop)
+          (or (and (mhc-summary-buffer-p)
+                   (mhc-rescan-month mhc-default-hide-private-schedules))
+              (and (mhc-calendar-p) (mhc-calendar-rescan)))
+          (run-hooks 'mhc-draft-finish-hook)))))
+
+(provide 'mhc-draft)
+
+;;; Copyright Notice:
+
+;; Copyright (C) 1999, 2000 Yoshinari Nomura. All rights reserved.
+;; Copyright (C) 2000 MHC developing team. All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;;    notice, this list of conditions and the following disclaimer in the
+;;    documentation and/or other materials provided with the distribution.
+;; 3. Neither the name of the team nor the names of its contributors
+;;    may be used to endorse or promote products derived from this software
+;;    without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS''
+;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
+;; THE TEAM OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+;; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+;; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+;; OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; mhc-draft.el ends here