mhc 1.0.0 → 1.0.1

data/emacs/mhc-message.el

@@ -35,7 +35,7 @@
   "MHC-Msg"
   "Major mode for viewing schdule files of MHC."
   (save-excursion
-    (mhc-decode-header)
+    (mhc-header-decode-ewords)
     (goto-char (point-max))
     (unless (re-search-backward
              (regexp-quote mhc-message-end-of-messge-marker)

data/emacs/mhc-misc.el

@@ -212,6 +212,10 @@
         (sit-for 0)
         pass))))
 
+(eval-and-compile
+  (autoload 'rfc2047-decode-string "rfc2047"))
+(defalias 'mhc-misc-decode-eword-string 'rfc2047-decode-string)
+
 (provide 'mhc-misc)
 
 ;;; Copyright Notice:

data/emacs/mhc-parse.el

@@ -17,6 +17,7 @@
 (require 'mhc-logic)
 (require 'mhc-record)
 (require 'mhc-header)
+(require 'mhc-misc)
 
 (defvar mhc-parse/strict nil)
 
@@ -65,13 +66,13 @@
 (defun mhc-parse/subject (record schedule)
   (mhc-schedule/set-subject
    schedule
-   (mhc-eword-decode-string (mhc-parse/continuous-lines)))
+   (mhc-misc-decode-eword-string (mhc-parse/continuous-lines)))
   schedule)
 
 (defun mhc-parse/location (record schedule)
   (mhc-schedule/set-location
    schedule
-   (mhc-eword-decode-string (mhc-parse/continuous-lines)))
+   (mhc-misc-decode-eword-string (mhc-parse/continuous-lines)))
   schedule)
 
 (defconst mhc-parse/time-regexp "\\([012][0-9]\\):\\([0-5][0-9]\\)")
@@ -121,7 +122,7 @@
                    (lambda (str)
                      (and (stringp str) (downcase str)))
                    (mhc-misc-split
-                    (mhc-eword-decode-string category)
+                    (mhc-misc-decode-eword-string category)
                     "[ \t]+")))
             (mhc-schedule-categories schedule))))
   (mhc-logic/set-todo (mhc-schedule-condition schedule)
@@ -132,7 +133,7 @@
 (defun mhc-parse/recurrence-tag (record schedule)
   (mhc-schedule/set-recurrence-tag
    schedule
-   (mhc-eword-decode-string (mhc-parse/continuous-lines)))
+   (mhc-misc-decode-eword-string (mhc-parse/continuous-lines)))
   schedule)
 
 (defun mhc-parse/sequence (record schedule)

data/emacs/mhc-summary.el

@@ -24,47 +24,10 @@
 ;;         Return the file name of the article on the current line in
 ;;         this summary buffer.
 ;;
-;;     (mhc-foo-summary-display-article)
-;;         Display the article on the current line in this buffer.
-;;
-;;     (mhc-foo-get-import-buffer GET-ORIGINAL)
-;;         Return buffer visiting import article.  If GET-ORIGINAL,
-;;         return it without MIME decode.
-;;
-;;     (mhc-foo-generate-summary-buffer DATE)
-;;         Generate summary buffer of mailer, and change current
-;;         buffer to it.  This function will be called at the top of
-;;         mhc-scan-month.
-;;
-;;     (mhc-foo-insert-summary-contents INSERTER)
-;;         Insert schedule with INSERTER.
-;;
-;;     (mhc-foo-summary-mode-setup DATE)
-;;         Setup buffer as summary of mailer.  This function will be
-;;         called at the end of mhc-scan-month.
-;;
-;;     (mhc-foo-highlight-message FOR-DRAFT)
-;;         Hilight message in the current buffer.
-;;         If FOR-DRAFT is non-nil, Hilight message as draft message."
-;;
-;;     (mhc-foo-eword-decode-string STRING)
-;;         Decode encoded STRING.
-;;
-;;     (mhc-foo-decode-header)
-;;         Decode encoded header.
-;;
 ;; Define these methods appropriately, and put definitions as follows:
 ;;
 ;;    (provide 'mhc-foo)
 ;;    (put 'mhc-foo 'summary-filename        'mhc-foo-summary-filename)
-;;    (put 'mhc-foo 'summary-display-article 'mhc-foo-summary-display-article)
-;;    (put 'mhc-foo 'get-import-buffer       'mhc-foo-get-import-buffer)
-;;    (put 'mhc-foo 'generate-summary-buffer 'mhc-foo-generate-summary-buffer)
-;;    (put 'mhc-foo 'insert-summary-contents 'mhc-foo-insert-summary-contents)
-;;    (put 'mhc-foo 'summary-mode-setup      'mhc-foo-summary-mode-setup)
-;;    (put 'mhc-foo 'highlight-message       'mhc-foo-highlight-message)
-;;    (put 'mhc-foo 'eword-decode-string     'mhc-foo-eword-decode-string)
-;;    (put 'mhc-foo 'decode-header           'mhc-foo-decode-header)
 
 ;;; Code:
 
@@ -285,67 +248,101 @@ PROP-VALUE is the property value correspond to PROP-TYPE.
 
 ;;; MUA Backend Functions:
 
-;; (defun mhc-summary-mailer-type ()
-;;   "Return mailer backend symbol using currently."
-;;   (or (cdr (assq major-mode mhc-summary-major-mode-alist))
-;;       (intern (concat "mhc-" (symbol-name mhc-mailer-package)))))
-
-(defun mhc-summary-mailer-type () 'mhc-mua)
-
 (defun mhc-summary/true (&rest args)
   "This is the dummy backend function, which always returns t."
   t)
 
-(defsubst mhc-summary-get-function (operation &optional mailer)
-  "Return appropriate function to do OPERATION for MAILER."
-  (or (get (require (or mailer (mhc-summary-mailer-type))) operation)
-      'mhc-summary/true))
-
-(defsubst mhc-get-function  (operation)
-  "Return appropriate function to do OPERATION."
-  (or (get (require (intern (concat "mhc-" (symbol-name mhc-mailer-package))))
-           operation)
-      'mhc-summary/true))
-
 (defsubst mhc-highlight-message (&optional for-draft)
   "Hilight message in the current buffer.
 If optional argument FOR-DRAFT is non-nil, Hilight message as draft message."
-  (funcall (mhc-get-function 'highlight-message) for-draft))
-
-(defsubst mhc-eword-decode-string (string)
-  "Decode encoded STRING."
-  (funcall (mhc-get-function 'eword-decode-string) string))
-
-(defsubst mhc-decode-header ()
-  "Decode encoded header."
-  (funcall (mhc-get-function 'decode-header)))
-
-(defsubst mhc-summary-filename (&optional mailer)
-  "Return file name of article on current line."
-  (funcall (mhc-summary-get-function 'summary-filename mailer)))
-
-(defsubst mhc-summary-display-article (&optional mailer)
-  "Display article on current line."
-  (funcall (mhc-summary-get-function 'summary-display-article mailer)))
-
-(defsubst mhc-summary-get-import-buffer (&optional get-original mailer)
-  "Return buffer to import article."
-  (funcall (mhc-summary-get-function 'get-import-buffer mailer) get-original))
-
-(defsubst mhc-summary-generate-buffer (date &optional mailer)
-  "Generate buffer with summary mode of MAILER."
-  (funcall (mhc-summary-get-function 'generate-summary-buffer mailer) date))
-
-(defsubst mhc-summary-insert-contents (mhc-tmp-schedule
+  (set (make-local-variable 'font-lock-defaults)
+       '(mhc-message-font-lock-keywords t)))
+
+(defun mhc-summary-filename ()
+  (let ((schedule) (filename))
+    (if (and (setq schedule (get-text-property (point) 'mhc-schedule))
+             (setq filename (mhc-record-name
+                             (mhc-schedule-record schedule)))
+             (file-exists-p filename)
+             (not (file-directory-p filename)))
+        filename
+      nil)))
+
+(defun mhc-summary-display-article ()
+  "Display the current article pointed in summary."
+  (let ((file (mhc-summary-filename)))
+    (if (not (and (stringp file) (file-exists-p file)))
+        (message "File does not exist.")
+      (mhc-window-push)
+      ;; (view-file-other-window file)
+      (pop-to-buffer (get-buffer-create "*MHC message*"))
+      ;; eword decode
+      (let ((buffer-read-only nil))
+        (goto-char (point-min))
+        (erase-buffer)
+        (insert-file-contents file)
+        (mhc-header-narrowing
+          (mhc-header-delete-header
+           "^\\(Content-.*\\|Mime-Version\\|User-Agent\\):" 'regexp))
+        (mhc-header-delete-empty-header
+         "^X-SC-.*:" 'regexp)
+        (mhc-message-mode)
+        (mhc-message-set-file-name file))
+      ;; (setq view-exit-action 'mhc-calendar-view-exit-action)
+      (set-visited-file-name nil)
+      ;; (rename-buffer (file-name-nondirectory file) 'unique)
+      ;; (run-hooks 'mhc-calendar-view-file-hook)
+      (set-buffer-modified-p nil)
+      (setq buffer-read-only t)
+      )))
+
+
+(defun mhc-summary-get-import-buffer (&optional get-original)
+  "Return a buffer visiting import article.
+If GET-ORIGINAL is non-nil, return a cons of buffer: car keeps a raw
+message and cdr keeps a visible message."
+  (let ((buffer
+         (or
+          (save-window-excursion
+            (let ((mode (progn (other-window 1) major-mode)))
+              (if (or
+                   (eq mode 'mew-message-mode)
+                   (eq mode 'mhc-message-mode))
+                  (current-buffer))))
+          (current-buffer))))
+    ;; XXX get-original is not effective now. gone soon.
+    (if get-original
+        (cons buffer buffer)
+      buffer)))
+
+
+(defun mhc-summary-generate-buffer (name-or-date)
+  "Generate a summary buffer for DATE-OR-DATE, and change current buffer to it."
+  (switch-to-buffer
+   (set-buffer
+    (mhc-get-buffer-create
+     (if (stringp name-or-date)
+         name-or-date
+       (mhc-date-format name-or-date "%04d-%02d" yy mm)))))
+  (setq inhibit-read-only t
+        buffer-read-only nil
+        indent-tabs-mode nil)
+  (widen)
+  (delete-region (point-min) (point-max)))
+
+(defun mhc-summary-insert-contents (mhc-tmp-schedule
                                        mhc-tmp-private
                                        inserter
                                        &optional mailer)
-  (if (eq 'direct mailer)
-      (let ((mhc-use-icon nil))
-        (mhc-summary-line-insert)
-        (insert "\n"))
-    (funcall (mhc-summary-get-function 'insert-summary-contents mailer)
-             inserter)))
+  (let ((beg (point)))
+    (if (eq 'direct mailer)
+        (let ((mhc-use-icon nil))
+          (mhc-summary-line-insert)
+          (insert "\n"))
+      (funcall inserter)
+      (put-text-property beg (point) 'mhc-schedule mhc-tmp-schedule)
+      (insert "\n")
+      )))
 
 (defsubst mhc-summary-search-date (date)
   "Search day in the current buffer."
@@ -357,13 +354,9 @@ If optional argument FOR-DRAFT is non-nil, Hilight message as draft message."
                     (not (eq (mhc-day-date dayinfo) date))))
       (goto-char (next-single-property-change (point) 'mhc-dayinfo)))))
 
-(defsubst mhc-summary-mode-setup (date &optional mailer)
-  "Setup buffer as summary mode of MAILER."
-  (funcall (mhc-summary-get-function 'summary-mode-setup mailer) date))
-
 (defun mhc-summary-record (&optional mailer)
   "Return record on current line."
-  (let ((filename (mhc-summary-filename mailer)))
+  (let ((filename (mhc-summary-filename)))
     (if filename
         (mhc-parse-file filename))))
 
@@ -634,6 +627,8 @@ If BANNER is set, it is printed on the horizontal line."
   (define-key mhc-summary-mode-map "t" 'mhc-calendar-toggle-insert-rectangle)
   (define-key mhc-summary-mode-map "E" 'mhc-edit)
   (define-key mhc-summary-mode-map "M" 'mhc-modify)
+  (define-key mhc-summary-mode-map "C" 'mhc-reuse-copy)
+  (define-key mhc-summary-mode-map "Y" 'mhc-reuse-create)
 
   (define-key mhc-summary-mode-map "n" 'mhc-summary-display-next)
   (define-key mhc-summary-mode-map "p" 'mhc-summary-display-previous)

data/emacs/mhc-vars.el

@@ -25,13 +25,6 @@
   "Various sorts of MH Calender."
   :group 'mail)
 
-(defcustom mhc-mailer-package 'mua
-  "*Variable to set your favorite mailer."
-  :group 'mhc
-  :type '(radio (const :tag "Mew" mew)
-                (const :tag "Wanderlust" wl)
-                (const :tag "Gnus" gnus)))
-
 (defcustom mhc-start-day-of-week 0
   "*Day of the week as the start of the week."
   :group 'mhc

data/emacs/mhc.el

@@ -9,22 +9,16 @@
 ;;; Commentary:
 ;;;
 
-;; Mhc is the personal schedule management package cooperating
-;;  with Mew, Wanderlust or Gnus.
+;; Mhc is the personal schedule management package.
+;; Please visit http://www.quickhack.net/mhc for details.
 ;;
 ;; Minimum setup:
 ;;
-;; for Mew user:
-;;   (autoload 'mhc-mew-setup "mhc-mew")
-;;   (add-hook 'mew-init-hook 'mhc-mew-setup)
+;;  (setq load-path
+;;        (cons "~/src/mhc/emacs" load-path))
+;;  (autoload 'mhc "mhc")
 ;;
-;; for Wanderlust user:
-;;   (autoload 'mhc-wl-setup "mhc-wl")
-;;   (add-hook 'wl-init-hook 'mhc-wl-setup)
-;;
-;; for Gnus user:
-;;   (autoload 'mhc-gnus-setup "mhc-gnus")
-;;   (add-hook 'gnus-startup-hook 'mhc-gnus-setup)
+;; and M-x mhc
 
 ;;; Code:
 
@@ -382,7 +376,7 @@ If HIDE-PRIVATE, priavate schedules are suppressed."
         (not current-prefix-arg)
       current-prefix-arg)))
   (mhc-scan-month date
-                  (mhc-summary-mailer-type)
+                  'mhc-mua
                   mhc-default-category-predicate-sexp
                   hide-private))
 
@@ -417,6 +411,7 @@ If HIDE-PRIVATE, private schedules are suppressed."
         (if (not (pos-visible-in-window-p (point)))
             (recenter)))))
 
+;;;###autoload
 (defun mhc-goto-this-month (&optional hide-private)
   "*Show schedules of this month.
 If HIDE-PRIVATE, private schedules are suppressed."
@@ -425,6 +420,7 @@ If HIDE-PRIVATE, private schedules are suppressed."
     (if mhc-default-hide-private-schedules
         (not current-prefix-arg)
       current-prefix-arg)))
+  (mhc-setup)
   (mhc-goto-month (mhc-date-now) hide-private))
 
 (defun mhc-goto-next-month (&optional arg)
@@ -484,7 +480,7 @@ If HIDE-PRIVATE, private schedules are suppressed."
   (let ((line (+ (count-lines (point-min) (point))
                  (if (= (current-column) 0) 1 0))))
     (mhc-scan-month (or (mhc-current-date-month) (mhc-date-now))
-                    (mhc-summary-mailer-type)
+                    'mhc-mua
                     mhc-default-category-predicate-sexp
                     hide-private)
     (goto-char (point-min))
@@ -550,7 +546,7 @@ listed in ``mhc-category-as-private''."
          ;; need three months for mini-calendar
          (dayinfo-list (mhc-db-scan (mhc-date-mm-- from) (mhc-date-mm++ to))))
     (unless (eq 'direct mailer)
-      (mhc-summary-generate-buffer date mailer)
+      (mhc-summary-generate-buffer date)
       (setq mhc-summary-buffer-current-date-month
             (mhc-date-mm-first date)))
     (when mhc-use-wide-scope
@@ -567,7 +563,7 @@ listed in ``mhc-category-as-private''."
          (- (mhc-misc-get-width) mhc-calendar-width)
          mhc-vertical-calendar-length
          dayinfo-list))
-      (mhc-summary-mode-setup date mailer)
+      (mhc-summary-mode)
       (mhc-mode 1)
       (setq mhc-summary-buffer-current-date-month
             (mhc-date-mm-first date))
@@ -861,6 +857,34 @@ the default action of this command is changed to the latter."
           (and (mhc-calendar-p) (mhc-calendar-rescan)))
       (run-hooks 'mhc-delete-file-hook))))
 
+(defun mhc-reuse-create ()
+  "Create new draft buffer using stored template."
+  (interactive)
+  (let ((date-list (mapconcat
+                    (lambda (day)
+                      (mhc-date-format day "%04d%02d%02d" yy mm dd))
+                    (mhc-input-day "Date: " (mhc-current-date))
+                    " ")))
+    (mhc-window-push)
+    (mhc-draft-new (mhc-draft-template)
+                   `(("x-sc-record-id" . ,(mhc-record-create-id))
+                     ("x-sc-sequence"  . 0)
+                     ("x-sc-day" . ,date-list)))))
+
+(defun mhc-reuse-copy ()
+  "Copy current schedule to template."
+  (interactive)
+  (let ((file (mhc-summary-filename))
+        (record (mhc-summary-record)))
+    (if (and (stringp file) (file-exists-p file))
+        (with-temp-buffer
+          (insert-file-contents file)
+          (mhc-header-decode-ewords)
+          (mhc-draft-store-template
+           (buffer-substring-no-properties (point-min) (point-max)))
+          (message "%s is copied." (mhc-record-subject-as-string record)))
+      (message "No file here."))))
+
 (defun mhc-modify ()
   "Modify the current schedule."
   (interactive)
@@ -1049,6 +1073,15 @@ the default action of this command is changed to the latter."
     (setq mhc-setup-p t)
     (run-hooks 'mhc-setup-hook)))
 
+;;;###autoload
+(defun mhc ()
+  "Show schedules of this month."
+  (interactive)
+  (mhc-setup)
+  (mhc-goto-this-month))
+
+(defalias 'mhc-mua-setup 'mhc-setup)
+
 (defun mhc-reset ()
   "Reset MHC."
   (interactive)

data/lib/mhc.rb

@@ -2,6 +2,65 @@ require 'tzinfo'
 require 'ri_cal'
 require "kconv"
 
+## Monkey patch to the original RiCal https://github.com/rubyredrick/ri_cal
+## delived from:
+##   git clone https://github.com/yoshinari-nomura/ri_cal.git
+##   git diff 369a4ee..dc740e7
+##
+module RiCal
+  class Component #:nodoc:
+
+    def method_missing(selector, *args, &b) #:nodoc:
+      xprop_candidate = selector.to_s
+      if (match = /^(x_[^=]+)(=?)$/.match(xprop_candidate))
+        x_property_key = match[1].gsub('_','-').upcase
+        if match[2] == "="
+          args.each do |val|
+            add_x_property(x_property_key, val)
+          end
+        else
+          x_properties[x_property_key].map {|property| property.ruby_value}
+        end
+      else
+        super
+      end
+    end # def method_missing
+
+    def export_x_properties_to(export_stream) #:nodoc:
+      x_properties.each do |name, props|
+        props.each do | prop |
+          export_stream.puts("#{name}#{prop.to_s}")
+        end
+      end
+    end # def export_x_properties_to
+
+  end # class Component
+
+  class PropertyValue
+    class OccurrenceList < Array
+
+      def visible_params # :nodoc:
+        result = params.dup
+
+        case @elements.first
+        when Date
+          result = {"VALUE" => "DATE"}.merge(params)
+        when DateTime
+          result = {"VALUE" => "DATE-TIME"}.merge(params)
+        end
+
+        if has_local_timezone?
+          result['TZID'] = tzid
+        else
+          result.delete('TZID')
+        end
+        result
+      end
+    end
+  end # class PropertyValue
+
+end # module RiCal
+
 module Mhc # :nodoc:
   def self.default_tzid=(tzid)
     @tzid = tzid