mhc 1.1.1 → 1.2.0

checksums.yaml

@@ -1,7 +1,7 @@
 ---
-SHA1:
-  metadata.gz: 7c9ab546227bfcd6c56b48af0bd308d2219214c3
-  data.tar.gz: 0ec52f413f4e033d96032450fcc07c75d7fa2d60
+SHA256:
+  metadata.gz: 537f2bfe5826a0763c8c41fa53f6a035de6a796c7f515990b5cda8017b01e4ab
+  data.tar.gz: c264417ac39a7b1cdbf037378e2d67540861a48caeab5945a58adad350a24b00
 SHA512:
-  metadata.gz: 70dbddc76e2f44969dc11cd233d402bc4de639ff1e5870c7044c6c8cad813149d342706f5040cce6ec642666828fdbe104d8dc50e76fb30f9bab57a00790ab5a
-  data.tar.gz: ce91e6cbca1ca392399d259a21c5bab7247846fbe22611c1242fe5ee85f61439c5dcca8940bcfbf3651f34021146bdba669bfd0a700e606e3aac53bae3a53ed5
+  metadata.gz: 172010da102859b39e05ad9ba54f28c4faf8327e4a0c8cc30bed00599f1e8ba37bc36a7f752e24e959395066e3b32413f1b044f67cf00b4209dde455f79f783d
+  data.tar.gz: 0e6be200e4cd65828aba8a5e0216f3e641b3b351f430fe02de21cdd194248b66406fd859d97b82e0c590256687c7bf678091e49ec4b6da61e6b5f5f1ba981846

data/bin/mhc

@@ -110,9 +110,32 @@ class MhcCLI < Thor
   named_option :repository
 
   def cache
-    Mhc::Command::Cache.new(calendar)
+    Mhc::Command::Cache.new(builder.datastore)
   end
 
+  # Command: todo
+  desc "todo", "List Todo entries in MHC calendar"
+
+  named_option :repository
+  method_option :show_all, :desc => "Include all finished tasks."
+
+  def todo
+    calendar.tasks.each do |task|
+      if task.recurring?
+        # Yearly: today - 90days .. today + 365d - 90days ?
+        # Weekly: today - 7days .. today + 7days
+        search_range = Mhc::PropertyValue::Date.parse_range("today+365d")
+        # search_range = nil
+      else
+        search_range = nil
+      end
+      next if task.in_category?("done") && !options[:show_all]
+      occurrence = task.occurrences(range: search_range).first
+      deadline = occurrence.dtstart
+      puts format("%s %s", deadline.strftime("%Y/%m/%d %a"), task.subject)
+    end
+  end # todo
+
   ################################################################
   # Command: completions
   ################################################################
@@ -185,7 +208,7 @@ class MhcCLI < Thor
   def scan(range)
     begin
       Mhc::Command::Scan.new(calendar, range, **symbolize_keys(options))
-    rescue Mhc::PropertyValue::ParseError, Mhc::FormatterNameError, Mhc::Query::ParseError => e
+    rescue Mhc::PropertyValue::ParseError, Mhc::Formatter::NameError, Mhc::Query::ParseError => e
       STDERR.print "Error: " + e.message + "\n"
     end
     return self
@@ -236,6 +259,40 @@ class MhcCLI < Thor
     return self
   end
 
+  ################################################################
+  # Command: validate
+  ################################################################
+  desc "validate FILE", "Validate event FILE"
+
+  named_option :format
+
+  def validate(file)
+    full_path = File.expand_path(file)
+
+    unless File.exist?(full_path)
+      puts Mhc::Converter::Emacs.new.to_emacs("No such file #{file}.")
+      return 1
+    end
+
+    errors = Mhc::Event.validate(File.open(full_path) {|f| f.read})
+
+    string = ""
+    exit_on_error do
+      errors.each do |err, key|
+        string += "#{err.to_s.capitalize}"
+        string += " in X-SC-#{key.capitalize}" if key
+        string += ".\n"
+      end
+    end
+    if errors.empty?
+      puts Mhc::Converter::Emacs.new.to_emacs("OK")
+      return 0
+    end
+
+    puts Mhc::Converter::Emacs.new.to_emacs(string)
+    return 1
+  end
+
   ################################################################
   # add some hooks to Thor
 
@@ -312,4 +369,10 @@ class MhcCLI < Thor
   end
 end
 
-command = MhcCLI.start(ARGV)
+result = MhcCLI.start(ARGV)
+
+if result.is_a?(Numeric)
+  exit result
+else
+  exit 0
+end

data/emacs/Cask

@@ -5,7 +5,7 @@
 (source org)
 (source melpa)
 
-(package "mhc" "1.1.1" "Message Harmonized Calendaring system") ;; MHC_VERSION
+(package "mhc" "1.2.0" "Message Harmonized Calendaring system") ;; MHC_VERSION
 
 (files "mhc.el" "mhc-*.el")
 

data/emacs/mhc-date.el

@@ -646,4 +646,4 @@ If WKST is not specified, 0 (Sunday) is used."
 ;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
 ;; OF THE POSSIBILITY OF SUCH DAMAGE.
 
-;;; mhc-date.el ends here.
+;;; mhc-date.el ends here

data/emacs/mhc-day.el

@@ -146,4 +146,4 @@ This special form converts DAY, as the number of days since
 ;; 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.
+;;; mhc-day.el ends here

data/emacs/mhc-db.el

@@ -1,4 +1,4 @@
-;;; -*- mode: Emacs-Lisp; coding: utf-8 -*-
+;;; mhc-db.el --- Database Interface to MHC.
 
 ;; Author:  Yoshinari Nomura <nom@quickhack.net>,
 ;;          TSUCHIYA Masatoshi <tsuchiya@namazu.org>
@@ -18,18 +18,38 @@
 (require 'mhc-process)
 (require 'mhc-schedule)
 
-(defun mhc-db-scan (b e &optional nosort category search)
+(defun mhc-db-scan (begin-date end-date &optional nosort category search)
+  "Scan MHC database from BEGIN-DATE to END-DATE.
+If optional NOSORT is non-nil, returned value is not sort.
+If optional CATEGORY is non-nil, returned value is clipped by category.
+If optional SEARCH is non-nil returned value is clipped by search string."
   (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)
+           (mhc-date-yy begin-date)
+           (mhc-date-mm begin-date)
+           (mhc-date-dd begin-date)
+           (mhc-date-yy end-date)
+           (mhc-date-mm end-date)
+           (mhc-date-dd end-date)
            (if category  (format " --category=%s" category) "")
            (if search  (format " --search='%s'" search) ""))))
 
+(defun mhc-db-scan-flat (begin-date end-date &optional nosort category search)
+  "Scan MHC database from BEGIN-DATE to END-DATE.
+Unlike `mhc-db-scan`, returned value is not grouped by date.
+For example:
+ ((date . mhc-schedule) (date . mhc-schedule) ...)
+If optional NOSORT is non-nil, returned value is not sort.
+If optional CATEGORY is non-nil, returned value is clipped by category.
+If optional SEARCH is non-nil returned value is clipped by search string."
+  (let ((dayinfo-list (mhc-db-scan begin-date end-date nosort category search)))
+    (apply 'append
+           (mapcar (lambda (dayinfo)
+                     (let ((date (mhc-day-date dayinfo))
+                           (schedules (mhc-day-schedules dayinfo)))
+                       (mapcar (lambda (sch) (cons date sch)) schedules)))
+                   dayinfo-list))))
+
 (defun mhc-db-search (&rest query)
   (let ((b (mhc-date-new 1970 1 1))
         (e (mhc-date-yy+ (mhc-date-now) 10)))
@@ -60,32 +80,33 @@
                  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)))
+(defun mhc-db-record-path-from-buffer (buffer)
+  "Return file path in MHC spool bound to BUFFER.
+File path is taken from X-SC-Record-Id field."
+  (with-current-buffer buffer
+    (let ((spool-directory (file-name-as-directory
+                            (expand-file-name
+                             "spool" (mhc-config-base-directory))))
+          (record-id (mhc-draft-record-id)))
+      (expand-file-name (concat record-id ".mhc") spool-directory))))
+
+(defun mhc-db-add-record-from-buffer (buffer &optional allow-overwrite)
+  "Add current mhc-draft BUFFER to MHC db.
+If optional ALLOW-OVERWRITE is non-nil, do not ask overwrite."
+  (let* ((path (mhc-db-record-path-from-buffer buffer))
+         (directory (file-name-directory path))
+         (overwriting (file-exists-p path)))
+    (if (or (not overwriting)
+            allow-overwrite
+            (y-or-n-p (format "Overwrite existing %s? " path)))
+        (with-current-buffer buffer
+          (mhc-draft-increment-sequence)
+          (mhc-draft-translate)
+          (mhc-file-make-directory directory)
+          (mhc-write-region-as-coding-system
+           mhc-default-coding-system
+           (point-min) (point-max) path nil 'nomsg)
+          (set-buffer-modified-p nil)
           (mhc-misc-touch-directory directory)
           t))))
 
@@ -118,9 +139,7 @@
                                        (mhc-schedule-condition schedule))))
                         " "))))
         (mhc-record-set-name record (mhc-record-name original-record))
-        (mhc-db-add-record-from-buffer record (current-buffer))))))
-
-
+        (mhc-db-add-record-from-buffer (current-buffer) t)))))
 
 (provide 'mhc-db)
 
@@ -155,4 +174,4 @@
 ;; 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.
+;;; mhc-db.el ends here

data/emacs/mhc-draft.el

@@ -17,14 +17,10 @@
 
 (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."
+(defcustom mhc-draft-import-header-list
+  '("Subject:" "From:" "To:" "Cc:" "Date:" "Message-Id:"
+    "X-GM-THRID:" "X-GM-MSGID:" "X-GM-LABELS:")
+  "*These headers are used when article is imported."
   :group 'mhc
   :type '(repeat string))
 
@@ -199,7 +195,7 @@ If optional argument NO-CONFIRM is non-nil, kill without confirmation."
 (defun mhc-draft-delete-garbage-headers ()
   (mhc-header-narrowing
     (mhc-header-delete-header
-     (concat "^\\(" (mhc-regexp-opt mhc-draft-unuse-hdr-list) "\\)")
+     (concat "^\\(" (mhc-regexp-opt mhc-draft-import-header-list) "\\)")
      'regexp)))
 
 (defun mhc-draft-setup-headers (&optional headers-values)
@@ -217,22 +213,40 @@ HEADERS-VALUES is a list of cons-cell like: ((header-name . value) ...)."
              (mhc-header-put-value xsc ""))))
        xsc-headers))))
 
+(defun mhc-draft-record-id ()
+  "Get X-SC-Record-Id header value in draft buffer."
+  (mhc-header-narrowing
+    (mhc-header-get-value "x-sc-record-id")))
+
+(defun mhc-draft-validate-buffer (&optional buffer)
+  "Validate mhc draft BUFFER.
+If BUFFER is omitted, current buffer will be validated."
+  (interactive)
+  (let ((validation (mhc-process-send-command-with-buffer
+                     "validate --format=emacs"
+                     (or buffer (current-buffer)))))
+    (if (and (stringp validation)
+             (string-match "^OK" validation))
+        (message "Validation passed.")
+      ;; \\' means end of string (not end of each line)
+      (error "ERROR: %s" (replace-regexp-in-string "[.\r\n]+\\'" "" validation)))))
+
 (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)))))
+  (mhc-draft-validate-buffer)
+  (mhc-calendar-input-exit)
+  (if (mhc-db-add-record-from-buffer
+       (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)
+        (message "Successfully registered."))))
 
 (provide 'mhc-draft)
 

data/emacs/mhc-face.el

@@ -68,7 +68,7 @@ refer to mhc-calendar-hnf-face-alist-internal.")
      (1 font-lock-type-face)
      (2 font-lock-comment-face)
      (3 font-lock-builtin-face))
-    ("\\(X-SC-\\(Subject\\|Location\\|Day\\|Time\\|Category\\|Priority\\|Recurrence-Tag\\|Mission-Tag:\\|Cond\\|Duration\\|Alarm\\|Record-Id\\|Sequence\\):\\)"
+    ("\\(X-SC-\\(Subject\\|Location\\|Day\\|Time\\|Category\\|Priority\\|Recurrence-Tag\\|Mission-Tag\\|Cond\\|Duration\\|Alarm\\|Record-Id\\|Sequence\\):\\)"
      (1 font-lock-keyword-face))
     ("\\(\\[End of message\\]\\)"
      (1 mhc-message-face-eof-marker))

data/emacs/mhc-header.el

@@ -63,6 +63,25 @@
           (memq (following-char) '(?  ?\t)))))
 
 
+(defun mhc-header-distill-header (header &optional regexp)
+  "Remove all headers except X-SC-* and HEADER.
+If REGEXP is non-nil, HEADER is a regular expression."
+  (save-excursion
+    (let ((case-fold-search t)
+          (header-top)
+          (header-name)
+          (all-regexp "^[^:]+:")
+          (use-regexp (if regexp header (concat "^" (regexp-quote header) ":")))
+          (xsc-regexp (concat "^\\(" (mhc-regexp-opt (mhc-header-list)) "\\)")))
+      (goto-char (point-min))
+      (while (re-search-forward all-regexp nil t)
+        (setq header-top (match-beginning 0)
+              header-name (match-string 0))
+        (mhc-header-goto-end)
+        (unless (or (string-match use-regexp header-name)
+                    (string-match xsc-regexp header-name))
+          (delete-region header-top (point)))))))
+
 (defun mhc-header-delete-header (header &optional regexp) "\
 Remove HEADER in the narrowed buffer.
 If REGEXP, HEADER is a regular expression."
@@ -177,4 +196,4 @@ If REGEXP, HEADER is a regular expression."
 ;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
 ;; OF THE POSSIBILITY OF SUCH DAMAGE.
 
-;;; mhc-header.el ends here.
+;;; mhc-header.el ends here

data/emacs/mhc-minibuf.el

@@ -189,7 +189,7 @@
         (if (not (pos-visible-in-window-p b))
             (recenter))
         (if (not non-minibuf)
-            (pop-to-buffer (window-buffer (minibuffer-window))))
+            (select-window (minibuffer-window)))
         ;; in minibuffer
         (if non-minibuf
             ()
@@ -254,12 +254,17 @@
                  (mhc-date-format default
                                   "%04d/%02d/%02d" yy mm dd))
                 ((listp default)
-                 (mapconcat
-                  (lambda (date)
-                    (mhc-date-format date
-                                     "%04d/%02d/%02d" yy mm dd))
-                  default
-                  " "))
+                 (let ((sep " ") (datelist default))
+                   (if (null (cdr (last default)))
+                       ()
+                     (setq sep "-")
+                     (setq datelist (list (car default) (cdr default))))
+                   (mapconcat
+                    (lambda (date)
+                      (mhc-date-format date
+                                       "%04d/%02d/%02d" yy mm dd))
+                    datelist
+                    sep)))
                 (t
                  nil)))
              (current-buffer)

data/emacs/mhc-parse.el

@@ -291,4 +291,4 @@
 ;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
 ;; OF THE POSSIBILITY OF SUCH DAMAGE.
 
-;;; mhc-parse.el ends here.
+;;; mhc-parse.el ends here

data/emacs/mhc-process.el

@@ -1,34 +1,51 @@
-(defvar mhc-process nil)
+(require 'mhc-vars)
 
-(add-to-list 'process-coding-system-alist '("^mhc$" . utf-8))
+(defvar mhc-process nil)
 
 (defun mhc-process-send-command (command)
   (unless (and (processp mhc-process)
                (eq (process-status mhc-process) 'run))
     (mhc-start-process))
-  (message "COMMAND: %s" command)
   (with-current-buffer (process-buffer mhc-process)
     (delete-region (point-min) (point-max))
     (process-send-string mhc-process (concat command "\n"))
     (let ((i 1))
       (while (not (and (> (point-max) 1)
                        (eq (char-after (1- (point-max))) ?\n)))
-        (message (format "Waiting mhc process...%d" i))
+        (if (< 2 i) (message (format "Waiting mhc process...%d" i)))
         (setq i (1+ i))
         (accept-process-output mhc-process 0.5)))
     (read (buffer-substring (point-min) (1- (point-max))))))
 
+(defun mhc-process-send-command-with-buffer (command buffer)
+  "Send COMMAND to mhc process with BUFFER via temporal file."
+  (let ((temp-file (make-temp-file "mhc")))
+    (unwind-protect
+        (with-current-buffer buffer
+          (mhc-write-region-as-coding-system
+           mhc-default-coding-system
+           (point-min)
+           (point-max)
+           temp-file
+           nil 'nomsg)
+          (mhc-process-send-command
+           (format "%s %s" command temp-file)))
+      (delete-file temp-file))))
+
 (defun mhc-start-process ()
   (interactive)
   (let ((process-connection-type nil)) ;; use PIPE not tty
     (if (and (processp mhc-process)
              (eq (process-status mhc-process) 'run))
         (kill-process mhc-process))
-    (setq mhc-process (start-process
-                       "mhc"
-                       (get-buffer-create " *mhc-scan-process*")
-                       "mhc"
-                       "server"))
+    (setq mhc-process
+	  (apply 'start-process
+		 (delq nil `("mhc"
+			     ,(get-buffer-create " *mhc-scan-process*")
+			     ,mhc-ruby-program-name
+			     ,mhc-program-name
+			     "server"))))
+    (set-process-coding-system mhc-process 'utf-8 'utf-8)
     (set-process-query-on-exit-flag mhc-process nil)
     mhc-process))