mhc 1.1.1 → 1.2.4

checksums.yaml

@@ -1,7 +1,7 @@
 ---
-SHA1:
-  metadata.gz: 7c9ab546227bfcd6c56b48af0bd308d2219214c3
-  data.tar.gz: 0ec52f413f4e033d96032450fcc07c75d7fa2d60
+SHA256:
+  metadata.gz: 4522630272ecdc9d44c9b994b2b31f8e36278abb0004708ec0e39d63e5d16792
+  data.tar.gz: cbcd079db569d336eec4eb87f21e5598cd3735b04f0fef6ffbbc8b7fdb583067
 SHA512:
-  metadata.gz: 70dbddc76e2f44969dc11cd233d402bc4de639ff1e5870c7044c6c8cad813149d342706f5040cce6ec642666828fdbe104d8dc50e76fb30f9bab57a00790ab5a
-  data.tar.gz: ce91e6cbca1ca392399d259a21c5bab7247846fbe22611c1242fe5ee85f61439c5dcca8940bcfbf3651f34021146bdba669bfd0a700e606e3aac53bae3a53ed5
+  metadata.gz: 1f052c78047e59e8638248ef56928f2ee3e85ae544b959d294c6900afb06868cb305a4a23b1ae85a35d963b870dbb0ec950c4c1d5cd9ea25d9ffe07334be5cd8
+  data.tar.gz: 874b007618cfd8be8a49ba0fab497ba38f6a36edfedbedf0ec72bb983c6c5ceff67a52c2b6138a62ced23fb0586e5f644eca018e2d9b963a8d79666100b94b9a

data/.gitignore

@@ -5,7 +5,7 @@
 .bundle
 .config
 .yardoc
-Gemfile.lock
+Gemfile.lock*
 InstalledFiles
 _yardoc
 attic/

data/bin/mhc

@@ -110,9 +110,48 @@ 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
+    todos = []
+    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]
+      todos << task.occurrences(range: search_range).first
+    end
+    todos.each.sort{|a, b| a.dtstart <=> b.dtstart}.each do |t|
+      deadline = t.dtstart
+      deadline_string = ""
+      remaining = (deadline - Mhc::PropertyValue::Date.today).to_i
+      if remaining == 0
+        deadline_string = " (due this date)"
+      elsif remaining > 0
+        deadline_string = format(" (%d days to go)", remaining)
+      else
+        deadline_string = format(" (%d days overdue)", -remaining)
+      end
+      location_string = " [#{t.location}]" if !t.location.empty?
+      puts format("%s %-11s %s%s%s",
+                  deadline.strftime("%Y/%m/%d %a"),
+                  t.time_range.to_mhc_string,
+                  t.subject, location_string, deadline_string)
+    end
+  end # todo
+
   ################################################################
   # Command: completions
   ################################################################
@@ -185,7 +224,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 +275,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 +385,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.4" "Message Harmonized Calendaring system") ;; MHC_VERSION
 
 (files "mhc.el" "mhc-*.el")
 

data/emacs/mhc-calendar.el

@@ -1071,11 +1071,13 @@ The keys that are defined for mhc-calendar-mode are:
   (format "%4d" yy))
 
 (defun mhc-calendar/inserter-nengo ()
-  (if (> yy 1987)
-      (format "平成%2d年" (- yy 1988))
-    (if (> yy 1924)
-        (format "昭和%2d年" (- yy 1925))
-      "昔々")))
+  (if (or (> yy 2019) (and (= yy 2019) (> mm 4)))
+      (format "令和%2d年" (- yy 2018))
+    (if (> yy 1987)
+        (format "平成%2d年" (- yy 1988))
+      (if (> yy 1924)
+          (format "昭和%2d年" (- yy 1925))
+        "昔々"))))
 
 (defun mhc-calendar/inserter-mm ()
   (format "%d" mm))

data/emacs/mhc-date.el

@@ -411,17 +411,10 @@
   `(/ (1- (mhc-date-dd ,date)) 7))
 
 (defsubst mhc-date-cw (date)
-  (mhc-date-let date
-    (let* ((yday (mhc-date/day-number yy mm dd))
-           (days (mhc-date/iso-week-days yday ww))
-           (d))
-      (if (< days 0)
-          (setq days (mhc-date/iso-week-days
-                      (+ yday 365 (if (mhc-date/leap-year-p (1- yy)) 1 0)) ww))
-        (setq d (mhc-date/iso-week-days
-                 (- yday 365 (if (mhc-date/leap-year-p yy) 1 0)) ww))
-        (if (<= 0 d) (setq days d)))
-      (1+ (/ days 7)))))
+  (string-to-number
+   (format-time-string
+    (if (= mhc-start-day-of-week 1) "%V" "%U")
+    (mhc-date-to-second date))))
 
 ;;
 ;; compare.
@@ -646,4 +639,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