pax_global_header00006660000000000000000000000064126254623150014520gustar00rootroot0000000000000052 comment=46d2a983b77b3139c9694ffba16ae875edc7d5b0 mhc-1.1.1/000077500000000000000000000000001262546231500122675ustar00rootroot00000000000000mhc-1.1.1/.gitignore000066400000000000000000000003631262546231500142610ustar00rootroot00000000000000*.elc *.gem *.rbc .DS_Store .bundle .config .yardoc Gemfile.lock InstalledFiles _yardoc attic/ coverage doc/ lib/bundler/man pkg rdoc rdocs/ spec/reports test/tmp test/version_tmp tmp vendor/bundle .ruby-version .ruby-gemset .rvmrc dist .cask mhc-1.1.1/.rspec000066400000000000000000000000371262546231500134040ustar00rootroot00000000000000--format documentation --color mhc-1.1.1/.travis.yml000066400000000000000000000000361262546231500143770ustar00rootroot00000000000000language: ruby rvm: - 2.1.0 mhc-1.1.1/COPYRIGHT000066400000000000000000000030031262546231500135560ustar00rootroot00000000000000Copyright (C) 1999, 2000 Yoshinari Nomura. All rights reserved. Copyright (C) 2000-2015 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-1.1.1/Gemfile000066400000000000000000000001301262546231500135540ustar00rootroot00000000000000source 'https://rubygems.org' # Specify your gem's dependencies in mhc.gemspec gemspec mhc-1.1.1/README.org000066400000000000000000000337651262546231500137530ustar00rootroot00000000000000#+TITLE: MHC -- Message Harmonized Calendaring system. #+AUTHOR: Yoshinari Nomura #+EMAIL: #+DATE: 2015-03-16 #+OPTIONS: H:3 num:2 toc:nil #+OPTIONS: ^:nil @:t \n:nil ::t |:t f:t TeX:t #+OPTIONS: skip:nil #+OPTIONS: author:t #+OPTIONS: email:nil #+OPTIONS: creator:nil #+OPTIONS: timestamp:nil #+OPTIONS: timestamps:nil #+OPTIONS: d:nil #+OPTIONS: tags:t #+TEXT: #+DESCRIPTION: #+KEYWORDS: #+LANGUAGE: ja #+LATEX_CLASS: jsarticle #+LATEX_CLASS_OPTIONS: [a4j] # #+LATEX_HEADER: \usepackage{plain-article} # #+LATEX_HEADER: \renewcommand\maketitle{} # #+LATEX_HEADER: \pagestyle{empty} # #+LaTeX: \thispagestyle{empty} [[file:https://badge.fury.io/rb/mhc.svg]] [[http://melpa.org/#/mhc][file:http://melpa.org/packages/mhc-badge.svg]] * DESCRIPTION MHC is a simple and powerful calendar tool, which consists of a CLI tool written in Ruby (mhc) and a nifty Emacs frontend UI (mhc.el). You can get the latest version from: + https://github.com/yoshinari-nomura/mhc + http://www.quickhack.net/mhc MHC has following features: + Easy import from existing Emacs buffers + MHC will guess the title, date, time and description from the content of buffer. + Simple plain-text data format + MHC stores articles in similar format to MH (email); you can manipulate them by many other text-manipulation tools, editors, UNIX command-line tools or your own scripts. + Flexible output format + Currently plain-text, iCalendar, S-formula (mhc.el, calfw), org-table, howm, JSON: ([[http://fullcalendar.io/][full-calendar]]) are supported. + Selective export to Google Calendar with flexible filters and modifiers. + MHC can export custom-filtered calendars to Google Calendar via CalDaV. Check [[https://github.com/yoshinari-nomura/mhc/blob/master/samples/DOT.mhc-config.yml][mhc-config.yml]] for details. * SYSTEM REQUIREMENTS + Ruby 2.1 or newer + Emacs 24 or newer * INSTALL AND SETUP ** Ruby CLI (mhc) mhc CLI command can be installed from rubygems.org. #+BEGIN_SRC shell-script $ gem install mhc #+END_SRC Or, if you want to install mhc in a sandbox (recommended), Bunlder would help you: #+BEGIN_SRC shell-script $ gem install bundler $ mkdir /path/to/install/mhc $ cd /path/to/install/mhc $ bundle init $ echo 'gem "mhc"' >> Gemfile $ bundle install --path=vendor/bundle --binstubs=bin $ export PATH=/path/to/install/mhc/bin:$PATH #+END_SRC Then, initialize config file and spool directory: #+BEGIN_SRC shell-script $ mhc init ~/mhc # Read comments in config.yml carefully $ vi ~/.config/mhc/config.yml # Add Japanese Holidays if needed. $ cp samples/japanese-holidays.mhcc ~/mhc/presets/ #+END_SRC Check if mhc is working correctly: #+BEGIN_SRC shell-script $ mhc scan thismonth #+END_SRC ** Emacs UI (mhc.el) *You have to install Ruby CLI before install mhc.el* MHC is now available on [[http://melpa.org/][MELPA]]. If you set up packaging system correctly, You can install mhc with package.el (=M-x= =package-install= =mhc=). Check [[https://github.com/milkypostman/melpa#usage][MELPA usage]] for details. And then, =M-x mhc= will show up the monthly calendar. * USAGE ** Ruby CLI (mhc) : mhc help ** Emacs UI (mhc.el) *** Keybind 1) Jump and Show =n/p=, =h/j/k/l= would work as expected. | Key | Function | |-----------------+----------------------------| | =<= | Show previous month | | =P= | Show previous year | | =>= | Show next month | | =N= | Show next year | | =g= | Go to specific month | | =v= | Toggle message window | | =RET/SPC/./DEL= | Show/scroll message buffer | | =/= | Search by keyword | 2) Manipulate articles | Key | Function | |-----+------------------------------------------------| | =E= | Create a new article draft interactively | | =M= | Open pointed article to edit | | =D= | Delete pointed article | | =C= | Copy article temporally as a reusable template | | =Y= | Same as =E= but use the template stored by =C= | 3) Draft Buffer | Key | Function | |----------+----------------------------------------| | =C-cC-c= | Finish editing and register to DB | | =C-cC-q= | Discard editing buffer w/o touching DB | * Article format ** Example MHC stores every article in the form of RFC822-like format. Once you open a new article draft in Emacs by typing =E=, You may feel the draft is very similar to email's one. This is an example of MHC article: #+BEGIN_EXAMPLE X-SC-Subject: Home party X-SC-Location: my second house X-SC-Day: 20150715 X-SC-Time: 18:00-21:00 X-SC-Category: Private Party X-SC-Cond: X-SC-Duration: X-SC-Record-Id: C34D89F5-27FA-4243-AC6C-168D8D243D9A X-SC-Sequence: 0 This is a sample schedule article about a home party scheduled on 20150715 18:00-21:00. MHC schedule articles are similar to RFC822 style message like this. In the header part, you can place any extra headers you want. if you import an article from existing email, you may want to insert the original email headers such as Subject, From, Date. #+END_EXAMPLE ** Time related headers MHC has four types of headers to specify time/date-range or recurring conditions: + =X-SC-Day= + =X-SC-Time= + =X-SC-Cond= + =X-SC-Duration= *** X-SC-Day =X-SC-Day:= specifies an enumeration of occurrence dates separated by white space: #+BEGIN_EXAMPLE X-SC-Day: 20150704 ... all-day event X-SC-Day: 20150704-20150705 ... two-days long single event X-SC-Day: 20150704 20150705 ... two all-day events #+END_EXAMPLE If =X-SC-Time:= is specified with =X-SC-Day:=, =X-SC-Time:= acts on all enumerated dates in =X-SC-Day:=. So, you cannot set multiple-days value (=20150704-20150705=) with =X-SC-Time:=. You can also put =!= prefix to specify the exception days (See below about =X-SC-Cond:=) *** X-SC-Time =X-SC-Time:= specifies a time range in a day or a point of time like: #+BEGIN_EXAMPLE X-SC-Time: 10:00-12:00 X-SC-Time: 10:00 #+END_EXAMPLE You can leave it blank for all-day events. With the combination of =X-SC-Day:=, you can specify some particular time-range of a day. Currently, you cannot specify a time-range across the multiple days. *** X-SC-Cond =X-SC-Cond:= defines a rule of recurrence; weekly, monthly or yearly. You can place these keywords in =X-SC-Cond:= separating by white spaces: | Keyword | Purpose | |----------------------------+-----------------------| | =01/02/.../31= | Day of month | | =1st/2nd/3rd/4th/5th/Last= | Week order in a month | | =Sun/Mon/.../Sat= | Day of week | | =Jan/Feb/.../Dec= | Name of month | Example: #+BEGIN_EXAMPLE X-SC-Cond: Fri ... Every Friday X-SC-Cond: Tue Fri ... Every Tueday and Friday X-SC-Cond: 31 Aug ... August 31st every year X-SC-Cond: 1 ... First day on every month X-SC-Cond: 1st 3rd Fri ... First and Third Friday every month X-SC-Cond: Fri 13 ... 13th on every month or every Friday (not Friday 13th) #+END_EXAMPLE Sometimes you may want to set a particular date as exception. In such case, you can exclude a date by placing =!YYYYMMDD= in =X-SC-Day:=. For example: #+BEGIN_EXAMPLE X-SC-Day: !20150715 20150716 X-SC-Cond: Wed X-SC-Duration: 20150701-20150731 This article occurs every Wednesday in July 2015 with the exception of 2015-07-15 (Wed) and inclusion of 2015-07-16 (Thu). #+END_EXAMPLE *** X-SC-Duration =X-SC-Duration:= acts on =X-SC-Cond:= to bounds the recurrence rule in an inclusive manner. Note that, =X-SC-Duration:= itself does not define any concrete occurrences and does not act on =X-SC-Day:=. Example: #+BEGIN_EXAMPLE X-SC-Day: !20150715 20150801 X-SC-Cond: Wed X-SC-Duration: 20150701-20150731 Every Wednesday in July 2015 with the exception of 2015-07-15 (Wed) and inclusion of 2015-08-01 (Sat). #+END_EXAMPLE * INFORMATION FOR DEVELOPERS ** INSTALL for developers: 1) Install rbenv + ruby-build (see https://github.com/sstephenson/rbenv#basic-github-checkout for details) #+BEGIN_SRC shell-script $ git clone https://github.com/sstephenson/rbenv.git ~/.rbenv $ git clone https://github.com/sstephenson/ruby-build.git ~/.rbenv/plugins/ruby-build # Edit your shell dot files to add some path and environment variables. #+END_SRC 2) Install Latest Ruby and bundler #+BEGIN_SRC shell-script # Install ruby 2.1.2 $ rbenv install 2.1.2 # Installation check $ rbenv global 2.1.2 $ ruby -v # -> You will see: ruby 2.1.2... # Install bundler for your new Ruby $ gem install bundler # If you want to use Ruby in your sytem, say /usr/bin/ruby $ rbenv global system $ ruby -v #+END_SRC 3) Clone MHC from github #+BEGIN_SRC shell-script $ git clone git@github.com:yoshinari-nomura/mhc.git ~/src/mhc #+END_SRC 4) Set default ruby version in MHC project #+BEGIN_SRC shell-script $ cd ~/src/mhc $ echo '2.1.2' > .ruby-version $ ruby -v # -> You will see: ruby 2.1.2... #+END_SRC 5) Install requied gem packages in sandbox ~/src/mhc/vendor/bundle #+BEGIN_SRC shell-script $ cd ~/src/mhc $ bundle install --path vendor/bundle #+END_SRC 6) Initialize config file and spool directory #+BEGIN_SRC shell-script $ bin/mhc init ~/mhc Guessing current local timezone ... ok guess timezone ... Asia/Tokyo Making directries under ~/mhc ... create ~/mhc/draft create ~/mhc/inbox create ~/mhc/presets create ~/mhc/spool create ~/mhc/trash create ~/mhc/status/cache create ~/mhc/status/log create ~/mhc/status/sync_channels Copying config file(s) into ~/.config/mhc/config.yml ... ok copy ~/.config/mhc/config.yml Done. # Read comments in config.yml carefully $ vi ~/.config/mhc/config.yml # Add Japanese Holidays if needed. $ cp samples/japanese-holidays.mhcc ~/mhc/presets/ # Add ~/src/mhc/bin directory to your $PATH for dogfooding $ export PATH=$HOME/src/mhc/bin:$PATH #+END_SRC 7) Byte-compile Emacs client #+BEGIN_SRC shell-script $ cd emacs $ make #+END_SRC 8) Add setup in your =.emacs.d/init.el= #+BEGIN_SRC emacs-lisp (setq load-path (cons "~/src/mhc/emacs" load-path)) (autoload 'mhc "mhc" "Message Harmonized Calendar system." t) ;; M-x mhc #+END_SRC 9) Check if TODAY is good. #+BEGIN_SRC shell-script $ mhc scan today #+END_SRC You may add ~/src/mhc/bin directory to your $PATH for dogfooding ** DIRECTORY STRUCTURE *** Configuration Directory Default configuration directory is =~/.config/mhc=. If environment variable =MHC_CONFIG_HOME= or =XDG_CONFIG_HOME= is set, it is taken as =$MHC_CONFIG_HOME/mhc= or =$XDG_CONFIG_HOME/mhc=. Configuration directory =~/.config/mhc= has these stuffs: + config.yml :: Configuration file (mandatory). + plugins :: Your home-made Ruby functions. See [[file:samples][samples]] for details. *** Spool Directory Location of the spool directory should be set by =TOPDIR:= element in =config.yml=. For example, if you have =TOPDIR: ~/MHC= entry in your =config.yml=, you will have these directory structure under =~/MHC=: + spool/*.mhc :: MHC event database. All events are flatly located in this directory in the form of ={x-sc-message-id}.mhc= + draft/*.mhc :: Draft files of events. Opening a file in directory by Emacs, and Typing =C-cC-c= will move the file into =spool= directory. (Not implemented yet. Should be empty for now.) + inbox/*.mhc :: Mainly same as =spool=. You will have a chance to review these events in this directory afterwards. (Not implemented yet. Should be empty for now.) + presets/*.mhcc :: Database for fixed anniversary events such as birthdays or national holidays. + trash/*.mhc :: Removed events from =spool= directory. + status/ :: + cache/* :: Cache files for speed-up. You can remove these files without any damage to MHC Database. + log/* :: log files for debug. You can remove these files without any damage to MHC DB. + sync_channels/* :: Sync records of MHC DB. If you remove any files under this directory, MHC Sync will be DAMAGED. * HOW TO CONVERT FROM THE OLD MHC SPOOL [[https://gist.github.com/yoshinari-nomura/bb9a197e0e01ad81c883][update-uuid.sh]] would help you. New format is: + =X-SC-Record-Id= is now in UUID style. + Each filename is in the form of ={UUID}.mhc=, not =[0-9]+=. + UUID in =X-SC-Record-Id= is same as its file's base name. + All articles are flatly placed in TOP/spool/ directory. #+BEGIN_SRC shell-script $ ./update-uuid.sh ~/Mail/schedule ~/mhc Converting... logfile will be in /Users/nom/mhc/update-uuid.sh34485.log #+END_SRC For Japanese people, character-code conversion might be needed. #+BEGIN_SRC shell-script $ cd ~/mhc/spool $ find . -name '*.mhc' | xargs -n 10 nkf --overwrite #+END_SRC mhc-1.1.1/Rakefile000066400000000000000000000015261262546231500137400ustar00rootroot00000000000000require "bundler/gem_tasks" require "rspec/core/rake_task" RSpec::Core::RakeTask.new(:spec) task :default => :spec require 'rdoc/task' Rake::RDocTask.new do |rd| rd.rdoc_dir = 'rdocs' rd.rdoc_files = FileList["lib/**/*.rb"] rd.options << '-charset=UTF-8' end task :release => :check_version task :build => :check_version # Emacs stuffs must have the same version numbers # with Mhc::VERSION. task :check_version do for file in %w(mhc.el mhc-vars.el Cask) path = File.expand_path("../emacs/#{file}", __FILE__) raise "File not found #{path}" unless File.exists?(path) content = File.open(path).read unless (/^;; Version: (\d+\.\d+\.\d+)$/ =~ content || /(\d+\.\d+\.\d+).*MHC_VERSION$/ =~ content) && Mhc::VERSION == $1 raise "#{path} does not have valid version number (#{$1})." end end end mhc-1.1.1/bin/000077500000000000000000000000001262546231500130375ustar00rootroot00000000000000mhc-1.1.1/bin/mhc000077500000000000000000000215411262546231500135370ustar00rootroot00000000000000#!/usr/bin/env ruby ################################################################ # rbenv support: # If this file is a symlink, and bound to a specific ruby # version via rbenv (indicated by RBENV_VERSION), # I want to resolve the symlink and re-exec # the original executable respecting the .ruby_version # which should indicate the right version. # if File.symlink?(__FILE__) and ENV["RBENV_VERSION"] ENV["RBENV_VERSION"] = nil shims_path = File.expand_path("shims", ENV["RBENV_ROOT"]) ENV["PATH"] = shims_path + ":" + ENV["PATH"] exec(File.readlink(__FILE__), *ARGV) end gemfile = File.expand_path("../../Gemfile", __FILE__) if File.exists?(gemfile + ".lock") ENV["BUNDLE_GEMFILE"] = gemfile require "bundler/setup" end require "rubygems" require "thor" require "mhc" Encoding.default_external="UTF-8" class MhcCLI < Thor ################################################################ # constants DEFAULT_CONFIG_HOME = File.join((ENV["XDG_CONFIG_HOME"] || "~/.config"), "mhc") DEFAULT_CONFIG_FILE = "config.yml" DEFAULT_CONFIG_PATH = File.join(DEFAULT_CONFIG_HOME, DEFAULT_CONFIG_FILE) package_name 'MHC' ################################################################ # class methods class << self attr_accessor :calendar attr_accessor :popular_options end def self.register_option(name, options) @popular_options ||= {} @popular_options[name] = options end def self.named_option(*names) names.each do |name| method_option name, @popular_options[name] end end ################################################################ # global options class_option :debug, :desc => "Set debug flag", :type => :boolean class_option :profile, :desc => "Set profiler flag", :type => :boolean class_option :config, :desc => "Set config path (default: #{DEFAULT_CONFIG_PATH})", :banner => "FILE" check_unknown_options! :except => :completions ################################################################ # frequently used options register_option :repository, :desc => "Set MHC top directory", :banner => "DIRECTORY" register_option :calendar, :desc => "Set source CALENDAR" register_option :category, :desc => "Pick items only in CATEGORY" register_option :format, :desc => "Set printing format", :enum => %w(text mail orgtable emacs icalendar calfw howm json) register_option :search, :desc => "Search items by complex expression" register_option :dry_run, :desc => "Perform a trial run with no changes made", :type => :boolean ################################################################ # command name mappings map ["--version", "-v"] => :version map ["--help", "-h"] => :help default_command :help ################################################################ # Command: help ################################################################ desc "help [COMMAND]", "Describe available commands or one specific command" def help(command = nil) super(command) end ################################################################ # Command: version ################################################################ desc "version", "Show version" def version puts Mhc::VERSION end ################################################################ # Command: cache ################################################################ desc "cache", "Dump cache file" named_option :repository def cache Mhc::Command::Cache.new(calendar) end ################################################################ # Command: completions ################################################################ desc "completions [COMMAND]", "List available commands or options for COMMAND", :hide => true long_desc <<-LONGDESC List available commands or options for COMMAND This is supposed to be a zsh compsys helper" LONGDESC def completions(*command) help = self.class.commands global_options = self.class.class_options Mhc::Command::Completions.new(help, global_options, command, config) end ################################################################ # Command: config ################################################################ desc "configuration", "Show current configuration in various formats." named_option :format def configuration(name = nil) puts Mhc::Converter::Emacs.new.to_emacs(config.get_value(name)) end ################################################################ # Command: init ################################################################ desc "init DIRECTORY", "Initialize MHC repository and configuration template" def init(top_dir) Mhc::Command::Init.new(top_dir, options[:config] || DEFAULT_CONFIG_PATH, ENV["MHC_TZID"]) end ################################################################ # Command: scan ################################################################ desc "scan RANGE", "Scan events in date RANGE" long_desc <<-LONGDESC scan events in date RANGE. RANGE is one of: \x5 + START-YYYYMMDD \x5 + START[+LENGTH] START is one of: \x5 + today, tomorrow, sun ... sat, yyyymmdd \x5 + thismonth, nextmonth, yyyymm LENGTH is a number followed by a SUFFIX. SUFFIX is one of: \x5 + d (days) \x5 + w (weeks) \x5 + m (months) If LENGTH is omitted, it is treated as '1d' or '1m' depending on which type of START is set. Examples: \x5 mhc scan 20140101-20141231 \x5 mhc scan 2140101+3d \x5 mhc scan today --category 'Business' \x5 mhc scan thismonth --search 'category:Business & !subject:"Trip"' LONGDESC named_option :calendar, :category, :format, :repository, :search def scan(range) begin Mhc::Command::Scan.new(calendar, range, **symbolize_keys(options)) rescue Mhc::PropertyValue::ParseError, Mhc::FormatterNameError, Mhc::Query::ParseError => e STDERR.print "Error: " + e.message + "\n" end return self end ################################################################ # Command: server ################################################################ desc "server", "Invoked as server (backend of emacs)" named_option :repository def server require "shellwords" while line = STDIN.gets # STDIN.noecho(&:gets) argv = line.chomp.shellsplit self.class.start(argv) STDOUT.flush end end ################################################################ # Command: show ################################################################ desc "show MESSAGE_ID", "Show article found by MESSAGE_ID" named_option :calendar, :repository def show(message_id) event = exit_on_error do calendar.find(uid: message_id) end print event.dump if event end ################################################################ # Command: sync ################################################################ desc "sync SYNC_CHANNEL", "Synchronize DBs via SYNC_CHANNEL" named_option :dry_run def sync(channel_name) driver = exit_on_error do builder.sync_driver(channel_name) end driver.sync_all(options[:dry_run]) return self end ################################################################ # add some hooks to Thor no_commands do def invoke_command(command, *args) setup_global_options unless command.name == "init" result = super teardown result end end ################################################################ # private private def exit_on_error(&block) begin yield if block_given? rescue Mhc::ConfigurationError => e STDERR.print "ERROR: #{e.message}.\n" exit 1 end end attr_reader :builder, :config, :calendar def setup_global_options exit_on_error do @config = Mhc::Config.create_from_file(options[:config] || DEFAULT_CONFIG_PATH) @builder ||= Mhc::Builder.new(@config) if @config.general.tzid Mhc.default_tzid = @config.general.tzid end calname = options[:calendar] || @config.calendars.first.name @config.general.repository = options[:repository] if options[:repository] self.class.calendar ||= builder.calendar(calname) @calendar = self.class.calendar end load_plugins if options[:profile] require 'profiler' Profiler__.start_profile end if options[:debug] require "pp" $MHC_DEBUG = true $MHC_DEBUG_FOR_DEVELOPER = true if ENV["MHC_DEBUG_FOR_DEVELOPER"] end end def load_plugins config_path = options[:config] || DEFAULT_CONFIG_PATH plugin_dir = File.dirname(config_path) Dir.glob(File.expand_path("plugins/*.rb", plugin_dir)) do |rb| require rb end end def teardown if options[:profile] Profiler__.print_profile($stdout) end end def symbolize_keys(hash) Hash[hash.map {|k,v| [k.to_sym, v]}] end end command = MhcCLI.start(ARGV) mhc-1.1.1/emacs/000077500000000000000000000000001262546231500133575ustar00rootroot00000000000000mhc-1.1.1/emacs/Cask000066400000000000000000000007231262546231500141650ustar00rootroot00000000000000;; -*- coding:utf-8 mode:lisp-interaction -*- ;; see: http://cask.readthedocs.org/en/latest/ (source org) (source melpa) (package "mhc" "1.1.1" "Message Harmonized Calendaring system") ;; MHC_VERSION (files "mhc.el" "mhc-*.el") (depends-on "org-plus-contrib") (depends-on "htmlize") (depends-on "calfw") (development (depends-on "f") (depends-on "ecukes") (depends-on "ert-runner") (depends-on "el-mock")) ;; Local Variables: ;; flycheck-mode: nil ;; End: mhc-1.1.1/emacs/Makefile000066400000000000000000000025661262546231500150300ustar00rootroot00000000000000# -*- Makefile -*- ################################################################ ## Use Emacs.app if available and anothr EMACS is not specified by user COCOA_EMACS := /Applications/Emacs.app/Contents/MacOS/Emacs ifneq ("$(wildcard $(COCOA_EMACS))", "") EMACS ?= $(COCOA_EMACS) else EMACS ?= emacs endif ################################################################ ## Use cask if available and another CASK is not specified by user CASK_VERSION := $(shell EMACS="$(EMACS)" cask --version 2>/dev/null) ifdef CASK_VERSION CASK ?= cask endif ifdef CASK CASK_EXEC ?= exec CASK_INSTALL ?= install endif ################################################################ ## cask, emacs and flags COMPILER := $(CASK) $(CASK_EXEC) $(EMACS) #FLAGS := -Q -batch -L . -L .cask/24.3.1/elpa/org-plus-contrib-20140922 -L .cask/24.3.1/elpa/calfw-20140407.2212 -l mhc FLAGS := -Q -batch -L . -l mhc ELFILES := $(wildcard *.el) ELCFILES := $(ELFILES:el=elc) ################################################################ ## Suffix rules .SUFFIXES: .elc .el .el.elc: -rm -f $@ $(COMPILER) $(FLAGS) -f batch-byte-compile $< ################################################################ ### Targets all: setup build build: $(ELCFILES) # $(COMPILER) $(FLAGS) -f batch-byte-compile *.el clean: -rm -f *.elc auto-autoloads.el custom-load.el *~ setup: $(CASK) $(CASK_INSTALL) mhc-1.1.1/emacs/mhc-calendar.el000066400000000000000000002040511262546231500162210ustar00rootroot00000000000000;;; -*- emacs-lisp -*- ;; mhc-calendar.el -- MHC Mini calendar ;; ;; Author: Hideyuki SHIRAI ;; MIYOSHI Masanori ;; ;; Created: 05/12/2000 ;; Reviesd: $Date: 2008/03/06 09:40:12 $ ;;; Code: ;;; Configration Variables: (require 'mhc-date) (require 'mhc-misc) (require 'mhc-day) (require 'mhc-schedule) (require 'mhc-vars) (require 'mhc-face) (require 'mhc-e21) (defcustom mhc-calendar-language 'english "*Language of the calendar." :group 'mhc :type '(choice (const :tag "English" english) (const :tag "Japanese" japanese))) (defcustom mhc-calendar-separator ?| "*Character of the separator between Summary and Vertical calendar." :group 'mhc :type 'character) (defcustom mhc-calendar-use-cw nil "*Displayed style of `Calendar week number'." :group 'mhc :type '(choice (const :tag "No" nil) (const :tag "Month" month) (const :tag "Week" week))) (defcustom mhc-calendar-cw-indicator (if (eq mhc-calendar-language 'japanese) "週" "Cw") "*Indicator of Calendar week." :group 'mhc :type 'string) (defcustom mhc-calendar-day-strings (if (eq mhc-calendar-language 'japanese) '["日" "月" "火" "水" "木" "金" "土"] '["Su" "Mo" "Tu" "We" "Th" "Fr" "Sa"]) "*Vector of \"day of week\" for 3-month calendar header." :group 'mhc :type '(list string string string string string string string)) (defcustom mhc-calendar-header-function (if (eq mhc-calendar-language 'japanese) 'mhc-calendar-make-header-ja 'mhc-calendar-make-header) "*Function of \"make calendar header\" for 3-month calendar. Assigned function must have one option \"date\" and must return string like \" December 2000\"." :group 'mhc :type '(radio (function-item :tag "English" mhc-calendar-make-header) (function-item :tag "Japanese" mhc-calendar-make-header-ja) (function :tag "Other"))) (defvar mhc-calendar-inserter-date-list '(((yy mm02 dd02) . "-") ((yy "/" mm02 "/" dd02) . "-") ((mm02 "/" dd02 "/" yy "(" ww-string ")") . "-") ((yy "." mm02 "." dd02 "(" ww-string ")") . " - ") ((yy "-" mm02 "-" dd02 "(" ww-string ")") . " - ") ((dd02 "-" mm-string "-" yy "(" ww-string ")") . " - ") ((ww-string ", " dd02 " " mm-string " " yy) . " - ") ((yy "年" mm2 "月" dd2 "日(" ww-japanese ")") . ("〜" " - ")) ((mm "月" dd2 "日(" ww-japanese ")") . ("〜" " - ")) ((nengo mm2 "月" dd2 "日(" ww-japanese ")") . ("〜" " - "))) "*List of date inserters. Each cell has a cons cell, car slot has a format of 'date modifier funcitons' and cdr slot has a which 'concatenate string' or its list for the duration. E.g., if date equal \"Mon, 01 May 2000\", symbol return a string described below, yy => \"2000\" nengo => \"平成12年\" mm => \"7\" mm2 => \" 7\" mm02 => \"07\" mm-string => \"Jul\" mm-string-long => \"July\" dd => \"1\" dd2 => \" 1\" dd02 => \"01\" ww => \"6\" ww-string => \"Sat\" ww-string-long => \"Saturday\" ww-japanese => \"土\" ww-japanese-long => \"土曜日\" ") (defcustom mhc-calendar-mode-hook nil "*Hook called in mhc-calendar-mode." :group 'mhc :type 'hook) (defcustom mhc-calendar-create-buffer-hook nil "*Hook called in mhc-calendar-create-buffer." :group 'mhc :type 'hook) (defcustom mhc-calendar-start-column 2 "*Size of left margin." :group 'mhc :type 'integer) (defcustom mhc-calendar-height (cond ((and (featurep 'xemacs) window-system) 12) ((and (not (featurep 'xemacs)) (>= emacs-major-version 21)) 10) (t 9)) "*Height of next month start column (greater or equal 9)." :group 'mhc :type 'integer) (defcustom mhc-calendar-height-offset (cond ((and (featurep 'xemacs) window-system) 4) ((and (not (featurep 'xemacs)) (>= emacs-major-version 21)) 3) (t 1)) "*Offset of window height." :group 'mhc :type 'integer) (defcustom mhc-calendar-view-summary nil "*View day's summary if *non-nil*." :group 'mhc :type 'boolean) (defcustom mhc-calendar-link-hnf nil "*Support HNF(Hyper Nikki File) mode if *non-nil*." :group 'mhc :type 'boolean) (defcustom mhc-calendar-use-mouse-highlight t "*Highlight mouse pointer." :group 'mhc :type 'boolean) (defcustom mhc-calendar-use-help-echo t "*Display schedule within help-echo." :group 'mhc :type 'boolean) (defcustom mhc-calendar-use-duration-show (if window-system 'mixed 'modeline) "*Show 'duration' mode." :group 'mhc :type '(choice (const :tag "none" nil) (const :tag "modeline" modeline) (const :tag "face" face) (const :tag "mixed" mixed))) (defcustom mhc-calendar-view-file-hook nil "*Hook called in mhc-calendar-view-file." :group 'mhc :type 'hook) ;; internal variables. Don't modify. (defvar mhc-calendar/buffer "*mhc-calendar*") (defvar mhc-calendar-date nil) (defvar mhc-calendar-view-date nil) (defvar mhc-calendar-mode-map nil) (defvar mhc-calendar-mode-menu-spec nil) (defvar mhc-calendar/week-header nil) (defvar mhc-calendar/separator-str nil) (defvar mhc-calendar/inserter-call-buffer nil) (defvar mhc-calendar/inserter-type nil) (defvar mhc-calendar/inserter-for-minibuffer '(((yy "/" mm02 "/" dd02) . "-"))) (defvar mhc-calendar/inserter-for-draft '(((yy mm02 dd02) . "-"))) (defvar mhc-calendar/mark-date nil) ;; mhc-calendar functions ;; macros (defmacro mhc-calendar-p () `(eq major-mode 'mhc-calendar-mode)) (defmacro mhc-calendar/in-date-p () ;; return 'date from 01/01/1970' `(get-text-property (point) 'mhc-calendar/date-prop)) (defmacro mhc-calendar/in-summary-p () ;; return 'schedule filename' `(or (get-text-property (point) 'mhc-calendar/summary-prop) (save-excursion (beginning-of-line) (get-text-property (point) 'mhc-calendar/summary-prop)))) (defmacro mhc-calendar/in-summary-hnf-p () ;; return 'title count' `(or (get-text-property (point) 'mhc-calendar/summary-hnf-prop) (save-excursion (beginning-of-line) (get-text-property (point) 'mhc-calendar/summary-hnf-prop)))) (defmacro mhc-calendar/cw-week () `(and (or (eq mhc-calendar-use-cw 'week) (eq mhc-calendar-use-cw t)) (eq mhc-start-day-of-week 1))) (defcustom mhc-calendar-next-offset (if (mhc-calendar/cw-week) 27 23) "*Offset of next month start column (greater or equal 23)." :group 'mhc :type 'integer) (defvar mhc-calendar-width (if (mhc-calendar/cw-week) 28 24)) (defmacro mhc-calendar/cw-string (cw) `(let (ret) (if (stringp ,cw) (setq ret ,cw) (setq ret (format "%2d." ,cw))) (mhc-face-put ret 'mhc-calendar-face-cw) ret)) (defmacro mhc-calendar/get-date-colnum (col) `(cond ((< ,col (+ mhc-calendar-next-offset mhc-calendar-start-column)) -1) ((< ,col (+ (* mhc-calendar-next-offset 2) mhc-calendar-start-column)) 0) (t 1))) (defmacro mhc-calendar/buffer-substring-to-num (pos) `(string-to-number (buffer-substring (match-beginning ,pos) (match-end ,pos)))) ;; Avoid warning of byte-compiler. (eval-when-compile (defvar yy) (defvar mm) (defvar dd) (defvar ww) (defvar hnf-diary-dir) (defvar hnf-diary-year-directory-flag) (defvar view-exit-action) (defvar mhc-calendar-mode-menu)) (eval-and-compile (autoload 'easy-menu-add "easymenu") (autoload 'hnf-mode "hnf-mode")) ;; Compatibilities between emacsen (eval-and-compile (if (fboundp 'text-property-any) (defsubst mhc-calendar/tp-any (beg end prop value) (text-property-any beg end prop value)) (defsubst mhc-calendar/tp-any (beg end prop value) (while (and beg (< beg end) (not (eq value (get-text-property beg prop)))) (setq beg (next-single-property-change beg prop nil end))) (if (eq beg end) nil beg)))) (if (fboundp 'event-buffer) (defalias 'mhc-calendar/event-buffer 'event-buffer) (defun mhc-calendar/event-buffer (event) (window-buffer (posn-window (event-start event))))) (if (fboundp 'event-point) (defalias 'mhc-calendar/event-point 'event-point) (defun mhc-calendar/event-point (event) (posn-point (event-start event)))) ;; map/menu (unless mhc-calendar-mode-map (setq mhc-calendar-mode-map (make-sparse-keymap)) (define-key mhc-calendar-mode-map "." 'mhc-calendar-goto-today) (define-key mhc-calendar-mode-map "g" 'mhc-calendar-goto-month) (define-key mhc-calendar-mode-map "r" 'mhc-calendar-rescan) (define-key mhc-calendar-mode-map "R" 'mhc-reset) (define-key mhc-calendar-mode-map "=" 'mhc-calendar-get-day) (define-key mhc-calendar-mode-map " " 'mhc-calendar-get-day-insert) (define-key mhc-calendar-mode-map "\C-m" 'mhc-calendar-get-day-insert-quit) (define-key mhc-calendar-mode-map "-" 'mhc-calendar-count-days-region) (define-key mhc-calendar-mode-map "s" 'mhc-calendar-scan) (define-key mhc-calendar-mode-map "E" 'mhc-calendar-edit) (define-key mhc-calendar-mode-map "M" 'mhc-calendar-modify) (define-key mhc-calendar-mode-map "D" 'mhc-calendar-delete) (define-key mhc-calendar-mode-map "H" 'mhc-calendar-hnf-edit) (define-key mhc-calendar-mode-map "v" 'mhc-calendar-goto-view) (define-key mhc-calendar-mode-map "h" 'mhc-calendar-goto-home) (define-key mhc-calendar-mode-map "f" 'mhc-calendar-next-day) (define-key mhc-calendar-mode-map "b" 'mhc-calendar-prev-day) (define-key mhc-calendar-mode-map "n" 'mhc-calendar-next-week) (define-key mhc-calendar-mode-map "p" 'mhc-calendar-prev-week) (define-key mhc-calendar-mode-map "N" 'mhc-calendar-next-month) (define-key mhc-calendar-mode-map "P" 'mhc-calendar-prev-month) (define-key mhc-calendar-mode-map ">" 'mhc-calendar-inc-month) (define-key mhc-calendar-mode-map "<" 'mhc-calendar-dec-month) (define-key mhc-calendar-mode-map "\M-\C-n" 'mhc-calendar-next-year) (define-key mhc-calendar-mode-map "\M-\C-p" 'mhc-calendar-prev-year) (define-key mhc-calendar-mode-map "\C-@" 'mhc-calendar-set-mark-command) (cond ((featurep 'xemacs) (define-key mhc-calendar-mode-map "\C- " 'mhc-calendar-set-mark-command) (define-key mhc-calendar-mode-map [(button1)] 'mhc-calendar-day-at-mouse) (define-key mhc-calendar-mode-map [(button2)] 'mhc-calendar-day-at-mouse)) (t (define-key mhc-calendar-mode-map [?\C- ] 'mhc-calendar-set-mark-command) (define-key mhc-calendar-mode-map [mouse-1] 'mhc-calendar-day-at-mouse) (define-key mhc-calendar-mode-map [mouse-2] 'mhc-calendar-day-at-mouse))) (define-key mhc-calendar-mode-map "\C-x\C-x" 'mhc-calendar-exchange-point-and-mark) (define-key mhc-calendar-mode-map "q" 'mhc-calendar-quit) (define-key mhc-calendar-mode-map "Q" 'mhc-calendar-exit) (define-key mhc-calendar-mode-map "?" 'describe-mode)) (unless mhc-calendar-mode-menu-spec (setq mhc-calendar-mode-menu-spec '("Mhc-Calendar" ["Toggle view area" mhc-calendar-goto-home t] ["Goto today" mhc-calendar-goto-today t] ["Goto next month" mhc-calendar-inc-month t] ["Goto prev month" mhc-calendar-dec-month t] ["Goto month" mhc-calendar-goto-month t] ("Goto" ["Next day" mhc-calendar-next-day t] ["Prev day" mhc-calendar-prev-day t] ["Next week" mhc-calendar-next-week t] ["Prev week" mhc-calendar-prev-week t] ["Next month" mhc-calendar-next-month t] ["Prev month" mhc-calendar-prev-month t] ["Next year" mhc-calendar-next-year t] ["Prev year" mhc-calendar-prev-year t]) ["Rescan" mhc-calendar-rescan t] ["MHC summary scan" mhc-calendar-scan t] "----" ["Save to kill ring" mhc-calendar-get-day t] ["Insert" mhc-calendar-get-day-insert t] ["Insert/Quit" mhc-calendar-get-day-insert-quit t] ["Mark set" mhc-calendar-set-mark-command t] ["Exchange point & mark" mhc-calendar-exchange-point-and-mark mhc-calendar/mark-date t] ["Count days in region" mhc-calendar-count-days-region mhc-calendar/mark-date t] "----" ["Goto view area" mhc-calendar-goto-view (not (or (mhc-calendar/in-summary-p) (mhc-calendar/in-summary-hnf-p)))] ["Schedule view" mhc-calendar-goto-view (or (mhc-calendar/in-summary-p) (mhc-calendar/in-summary-hnf-p))] ("Schedule edit" ["Schedule addition" mhc-calendar-edit (or (mhc-calendar/in-date-p) (mhc-calendar/in-summary-p))] ["Schedule modify" mhc-calendar-modify (mhc-calendar/in-summary-p)] ["Schedule delete" mhc-calendar-delete (mhc-calendar/in-summary-p)] ["HNF file edit" mhc-calendar-hnf-edit (and mhc-calendar-link-hnf (or (mhc-calendar/in-date-p) (mhc-calendar/in-summary-p) (mhc-calendar/in-summary-hnf-p)))]) "----" ("Misc" ["Reset" mhc-reset t] ["Quit" mhc-calendar-quit t] ["Kill" mhc-calendar-exit t] ["Help" describe-mode t])))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; make rectangle like calendar.el (defun mhc-calendar-toggle-insert-rectangle (&optional hide-private) "Toggle 3 month calendar." (interactive "P") (setq mhc-insert-calendar (not mhc-insert-calendar)) (mhc-rescan-month hide-private)) (defun mhc-calendar-setup () (setq mhc-calendar/week-header nil) (setq mhc-calendar/separator-str (char-to-string mhc-calendar-separator)) (mhc-face-put mhc-calendar/separator-str 'mhc-summary-face-separator) (if (mhc-calendar/cw-week) (when (< mhc-calendar-next-offset 27) (setq mhc-calendar-next-offset 27)) (when (< mhc-calendar-next-offset 23) (setq mhc-calendar-next-offset 23))) (setq mhc-calendar-width (if (mhc-calendar/cw-week) 28 24)) (when (mhc-calendar/cw-week) (setq mhc-calendar/week-header (mhc-calendar/cw-string (format "%s " mhc-calendar-cw-indicator)))) (let ((days (copy-sequence (nthcdr mhc-start-day-of-week (append mhc-calendar-day-strings mhc-calendar-day-strings nil)))) (i 0) day) (while (< i 7) (setq day (car days)) (cond ((= (% (+ i mhc-start-day-of-week) 7) 0) (mhc-face-put day 'mhc-calendar-face-sunday)) ((= (% (+ i mhc-start-day-of-week) 7) 6) (mhc-face-put day 'mhc-calendar-face-saturday)) (t (mhc-face-put day 'mhc-calendar-face-default))) (setq mhc-calendar/week-header (concat mhc-calendar/week-header (if mhc-calendar/week-header " ") day)) (setq days (cdr days)) (setq i (1+ i))))) (defun mhc-calendar-insert-rectangle-at (date col &optional months dayinfo-list) (let ((m nil) (rect nil) (center nil)) (save-excursion (setq date (mhc-date-mm-first date)) (put-text-property (point-min) (point-max) 'rear-nonsticky t) (goto-char (point-min)) (when mhc-use-wide-scope (mhc-summary-search-date date)) (beginning-of-line) (mhc-misc-move-to-column col) (if (consp months) (setq m (car months) center (- m (cdr months))) (setq m (or months 3)) (setq center (/ (1+ m) 2))) (while (> m 0) (setq rect (nconc rect (mhc-calendar/make-rectangle (mhc-date-mm- date (- m center)) mhc-calendar/separator-str dayinfo-list) (if (> m 1) (list (concat mhc-calendar/separator-str " "))))) (setq m (1- m))) (mhc-misc-insert-rectangle rect)))) (defun mhc-calendar-make-header (date) (let ((ret (mhc-date-format date "%s %04d" (mhc-date-digit-to-mm-string mm t) yy)) cw) (when (eq mhc-calendar-use-cw 'month) (setq cw (mhc-calendar/cw-string (format "w%d" (mhc-date-cw (mhc-date-mm-first date))))) ;; (length "September 2002 w35") => 18 ;; (length "Mo Tu We Th Fr Sa Su") => 20 (setq cw (concat (make-string (- 18 (length ret) (length cw)) ? ) cw))) (if (mhc-date-yymm= (mhc-date-now) date) (mhc-face-put ret (mhc-face-get-today-face 'mhc-calendar-face-saturday)) (mhc-face-put ret 'mhc-calendar-face-saturday)) (concat " " (if (mhc-calendar/cw-week) " " "") ret cw))) (defun mhc-calendar-make-header-ja (date) (let ((ret (mhc-date-format date "%04d年%2d月" yy mm)) (cw "")) (when (eq mhc-calendar-use-cw 'month) (setq cw (mhc-calendar/cw-string (format " (%d)" (mhc-date-cw (mhc-date-mm-first date)))))) (if (mhc-date-yymm= (mhc-date-now) date) (mhc-face-put ret (mhc-face-get-today-face 'mhc-calendar-face-saturday)) (mhc-face-put ret 'mhc-calendar-face-saturday)) (concat " " (if (mhc-calendar/cw-week) " " "") ret cw))) (defun mhc-calendar/make-rectangle (&optional date separator dayinfo-list) (let* ((today (mhc-date-now)) (month (list (concat separator " " mhc-calendar/week-header) (concat separator " " (funcall mhc-calendar-header-function (or date today))))) (mm (mhc-date-mm (or date today))) (days (or dayinfo-list (mhc-db-scan-month (mhc-date-yy (or date today)) mm t))) (dayinfo-cache days) (separator (if separator separator mhc-calendar/separator-str)) (i 0) (from (mhc-date-mm-first date)) (to (mhc-date-mm-last date)) (start (mhc-date-ww from)) (cdate from) week color cw day map dayinfo) (when (mhc-calendar/cw-week) (setq cw (mhc-date-cw from)) (setq week (cons (mhc-calendar/cw-string cw) week))) (unless (= (mhc-end-day-of-week) 6) (setq start (+ start 6)) (when (> start 6) (setq start (- start 7)))) (while (< i start) (setq week (cons " " week)) (setq i (1+ i))) (while (mhc-date<= cdate to) (setq dayinfo (assoc cdate days)) (when (and (null week) (mhc-calendar/cw-week)) (if (or (eq mm 1) (eq mm 12)) (setq cw (mhc-date-cw cdate)) (setq cw (1+ cw))) (setq week (cons (mhc-calendar/cw-string cw) week))) (setq color (cond ((= 0 (mhc-date-ww cdate)) 'mhc-calendar-face-sunday) ((and dayinfo (mhc-day-holiday dayinfo)) (mhc-face-category-to-face "Holiday")) ((= 6 (mhc-date-ww cdate)) 'mhc-calendar-face-saturday) (t 'mhc-calendar-face-default))) (when (mhc-date= today cdate) (setq color (mhc-face-get-today-face color))) (when (and dayinfo (mhc-day-busy-p dayinfo)) (setq color (mhc-face-get-busy-face color))) (setq day (format "%2d" (mhc-date-dd cdate))) (when color (mhc-face-put day color)) (add-text-properties 0 (length day) `(mhc-calendar/date-prop ,cdate mouse-face ,(if mhc-calendar-use-mouse-highlight 'highlight nil) help-echo ,(if mhc-calendar-use-help-echo (and dayinfo (mhc-calendar/get-contents cdate dayinfo-cache)) nil)) day) (setq week (cons day week)) (when (= (mhc-end-day-of-week) (mhc-date-ww cdate)) (setq month (cons (mapconcat (function identity) (cons separator (nreverse week)) " ") month) week nil)) (setq cdate (mhc-date++ cdate))) (when week (setq month (cons (mapconcat (function identity) (cons separator (nreverse week)) " ") month))) (nreverse month))) (defun mhc-calendar-mouse-goto-date-view (event) (interactive "e") (mhc-calendar-mouse-goto-date event 'view)) (eval-and-compile (if (featurep 'xemacs) (defun mhc-calendar-mouse-icon-function (event) (mhc-xmas-icon-call-function event)) (defun mhc-calendar-mouse-icon-function (event) (mhc-e21-icon-call-function event)))) (defun mhc-calendar-mouse-goto-date (event &optional view) (interactive "e") (let (cdate dayinfo pos cpos func) (with-current-buffer (mhc-calendar/event-buffer event) (goto-char (mhc-calendar/event-point event)) (setq cdate (get-text-property (point) 'mhc-calendar/date-prop))) (cond (cdate (unless (= (mhc-current-date-month) (mhc-date-let cdate (mhc-date-new yy mm 1))) (mhc-goto-month cdate mhc-default-hide-private-schedules)) (setq pos (point)) (goto-char (point-min)) (setq cpos (point)) (catch 'detect (while (setq cpos (next-single-property-change cpos 'mhc-dayinfo)) (when (and (setq dayinfo (get-text-property cpos 'mhc-dayinfo)) (= cdate (mhc-day-date dayinfo))) (setq pos cpos) (throw 'detect t)))) (goto-char pos) (when view (mhc-summary-display))) (t (unless (mhc-calendar-mouse-icon-function event) (setq func (or (lookup-key (current-local-map) (this-command-keys)) (lookup-key (current-global-map) (this-command-keys)))) (when func (call-interactively func event))))))) ;; function (defun mhc-calendar-mode () "\\ MHC Calendar mode:: major mode to view calendar and select day. The keys that are defined for mhc-calendar-mode are: \\[mhc-calendar-goto-home] Recover positioning and toggle show 'view area'. \\[mhc-calendar-goto-today] Jump to today. \\[mhc-calendar-inc-month] Slide to the next month. \\[mhc-calendar-dec-month] Slide to the previous month. \\[mhc-calendar-goto-month] Jump to your prefer month. \\[mhc-calendar-rescan] Rescan current calendar. \\[mhc-calendar-scan] Scan the point day's schedule summary with MUA. If '\\[mhc-calendar-scan]' executed with 'prefix argument', hide private category. \\[mhc-calendar-next-day] Goto the next day. \\[mhc-calendar-prev-day] Goto the previous day. \\[mhc-calendar-next-week] Goto the next week or goto the next summary. \\[mhc-calendar-prev-week] Goto previous week or goto the previous summary. \\[mhc-calendar-next-month] Goto next month. \\[mhc-calendar-prev-month] Goto previous month. \\[mhc-calendar-next-year] Goto next year. \\[mhc-calendar-prev-year] Goto previous year. '\\[mhc-calendar-next-day]' '\\[mhc-calendar-prev-day]' '\\[mhc-calendar-next-week]' '\\[mhc-calendar-prev-week]' '\\[mhc-calendar-next-month]' '\\[mhc-calendar-prev-month]' '\\[mhc-calendar-inc-month]' '\\[mhc-calendar-dec-month]' '\\[mhc-calendar-next-year]' '\\[mhc-calendar-prev-year]' effected by 'prefix argument(integer number)'. \\[mhc-calendar-day-at-mouse] Day positioning or view schedule file. \\[mhc-calendar-set-mark-command] Duration start point set. \\[mhc-calendar-exchange-point-and-mark] Duration start point exchange. \\[mhc-calendar-count-days-region] Count days in region. \\[mhc-calendar-get-day] Get day at point to save kill ring. \\[mhc-calendar-get-day-insert] Get day at point to insert call buffer. \\[mhc-calendar-get-day-insert-quit] Get day at point to insert call buffer, quit. if '\\[mhc-calendar-get-day]' '\\[mhc-calendar-get-day-insert]' '\\[mhc-calendar-get-day-insert-quit]' executed with 'prefix argument', means to treat the duration. \\[mhc-calendar-goto-view] Goto summary view position or view schedule file. \\[mhc-calendar-edit] Create new schdule file. If optional argument IMPORT-BUFFER is specified, import its content. \\[mhc-calendar-modify] Edit the schdule on the cursor point. \\[mhc-calendar-delete] Delete the schdule on the cursor point. \\[mhc-calendar-hnf-edit] Edit the Hyper Nikki File. \\[mhc-reset] Reset MHC. \\[mhc-calendar-quit] Quit and calendar buffer bury. \\[mhc-calendar-exit] Quit and calendar buffer kill. \\[describe-mode] Show mode help. " (interactive) (kill-all-local-variables) (use-local-map mhc-calendar-mode-map) (make-local-variable 'mhc-calendar-date) (make-local-variable 'mhc-calendar-view-date) (make-local-variable 'mhc-calendar/mark-date) (make-local-variable 'indent-tabs-mode) (setq major-mode 'mhc-calendar-mode) (setq mode-name "mhc-calendar") (setq indent-tabs-mode nil) (setq truncate-lines t) (when (featurep 'xemacs) (easy-menu-add mhc-calendar-mode-menu)) (unless (memq 'mhc-calendar/duration-show post-command-hook) (add-hook 'post-command-hook 'mhc-calendar/duration-show)) (run-hooks 'mhc-calendar-mode-hook)) (defun mhc-calendar (&optional date) "Display 3-month mini calendar." (interactive) (setq date (or date (mhc-summary-current-date) (mhc-calendar-get-date))) (when (and (get-buffer mhc-calendar/buffer) (set-buffer mhc-calendar/buffer)) (setq date (or date mhc-calendar-view-date)) (unless (mhc-date-yymm= date mhc-calendar-date) (mhc-calendar/create-buffer date))) (mhc-calendar/goto-date (or date (mhc-date-now)))) (defun mhc-calendar-goto-today () (interactive) (mhc-calendar (mhc-date-now))) (defun mhc-calendar/goto-date (date) (let ((mhc-calendar-view-summary nil) pos) (unless (memq 'mhc-calendar/duration-show post-command-hook) (add-hook 'post-command-hook 'mhc-calendar/duration-show)) (unless (get-buffer mhc-calendar/buffer) (mhc-calendar/create-buffer date)) (set-buffer (get-buffer mhc-calendar/buffer)) (pop-to-buffer mhc-calendar/buffer) (while (not pos) (setq pos (mhc-calendar/tp-any (point-min) (point-max) 'mhc-calendar/date-prop date)) (or pos (mhc-calendar/create-buffer date))) (goto-char (1+ pos))) (setq mhc-calendar-view-date date) (save-excursion (mhc-calendar/view-summary-delete) (when mhc-calendar-view-summary (mhc-calendar/view-summary-insert) (and mhc-calendar-link-hnf (mhc-calendar/hnf-summary-insert)) (mhc-calendar/put-property-summary))) (mhc-calendar/shrink-window)) (defun mhc-calendar/view-summary-delete () (goto-char (point-min)) (when (re-search-forward "^--" nil t) (let ((buffer-read-only nil)) (beginning-of-line) (forward-char -1) (set-text-properties (point) (point-max) nil) (delete-region (point) (point-max)) (set-buffer-modified-p nil)))) (defun mhc-calendar/view-summary-insert () (let ((date mhc-calendar-view-date) (buffer-read-only nil) (mhc-use-week-separator nil)) (goto-char (point-max)) (insert "\n") (mhc-summary/insert-separator nil nil (min (1- (window-width)) (* mhc-calendar-next-offset 3))) (mhc-summary-make-contents (mhc-db-scan date date) date date 'mhc-calendar) (delete-char -1) (set-buffer-modified-p nil))) (defun mhc-calendar/put-property-summary () (condition-case nil (when mhc-calendar-use-mouse-highlight (let ((buffer-read-only nil) beg) (goto-char (point-min)) (when (re-search-forward "^--" nil t) (forward-line) (while (not (eobp)) (setq beg (point)) (end-of-line) (put-text-property beg (point) 'mouse-face 'highlight) (forward-line)))) (set-buffer-modified-p nil)) (error nil))) (defun mhc-calendar/shrink-window () (or (one-window-p t) (/= (frame-width) (window-width)) (let ((winh (+ (count-lines (point-min) (point-max)) mhc-calendar-height-offset))) (cond ((< winh mhc-calendar-height) (setq winh mhc-calendar-height)) ((< winh window-min-height) (setq winh window-min-height))) (shrink-window (- (window-height) winh))))) (defun mhc-calendar/create-buffer (date) (set-buffer (get-buffer-create mhc-calendar/buffer)) (setq buffer-read-only t) (unless (eq major-mode 'mhc-calendar-mode) (mhc-calendar-mode) (buffer-disable-undo)) (or (mhc-date-p date) (setq date (mhc-date-now))) (let ((buffer-read-only nil) (caldate (mhc-date-mm+ date -1)) (col mhc-calendar-start-column) (prefix " +|") (i 3) (string)) (mhc-calendar/delete-overlay) (set-text-properties (point-min) (point-max) nil) (erase-buffer) (message "mhc-calendar create...") (while (> i 0) (goto-char (point-min)) (mhc-misc-move-to-column col) (mhc-misc-insert-rectangle (mhc-calendar/make-rectangle caldate (if (= i 3) "" "|"))) (setq caldate (mhc-date-mm+ caldate 1)) (setq col (- (+ col mhc-calendar-next-offset) (if (= i 3) 1 0))) (setq i (1- i))) (goto-char (point-min)) (while (re-search-forward prefix nil t) (setq string (match-string 0)) (delete-region (match-end 0) (match-beginning 0)) (insert (make-string (length string) ?\ ))) (setq mhc-calendar-date date) ;; (mhc-calendar/put-property-date) (and mhc-calendar-link-hnf (mhc-calendar/hnf-mark-diary-entries)) (run-hooks 'mhc-calendar-create-buffer-hook) (set-buffer-modified-p nil) (message "mhc-calendar create...done"))) (defvar mhc-calendar/date-format nil) (defun mhc-calendar/get-contents (date dayinfo-alist) (unless mhc-calendar/date-format (setq mhc-calendar/date-format (if (eq mhc-calendar-language 'japanese) "%04d年%2d月%2d日(%s)\n" "%04d-%02d-%02d (%s)\n"))) (with-temp-buffer (let* ((dayinfo (assoc date dayinfo-alist)) (schedules (mhc-day-schedules dayinfo)) schedule begin end subject location) (mhc-date-let date (insert (format mhc-calendar/date-format yy mm dd (aref mhc-calendar-day-strings ww)))) (when schedules (insert "\n")) (while (setq schedule (car schedules)) (setq schedules (cdr schedules)) (setq begin (mhc-schedule-time-begin schedule)) (setq end (mhc-schedule-time-end schedule)) (setq subject (or (mhc-schedule-subject schedule) "")) (setq location (or (mhc-schedule-location schedule) "")) (when (> (length location) 0) (setq location (concat " [" location "]"))) (when (or begin end subject location) (insert (format "%s%s%s%s%s\n" (if begin (format "%02d:%02d" (/ begin 60) (% begin 60)) "") (if end (format "-%02d:%02d" (/ end 60) (% end 60)) "") (if (or begin end) " " "") subject location)))) (buffer-substring-no-properties (point-min) (point-max))))) (defun mhc-calendar-edit () (interactive) (if (or (mhc-calendar/in-date-p) (mhc-calendar/in-summary-p)) (progn (mhc-window-push) (mhc-edit nil) (delete-other-windows)) (message "Nothing to do in this point."))) (defun mhc-calendar-delete () (interactive) (let ((filename (mhc-calendar/in-summary-p)) key) (if (null filename) (message "Nothing to do in this point.") (mhc-delete-file (mhc-parse-file filename))))) (defun mhc-calendar-modify () (interactive) (if (mhc-calendar/in-summary-p) (mhc-modify-file (mhc-calendar/in-summary-p)) (message "Nothing to do in this point."))) (defun mhc-calendar-toggle-view () (interactive) (setq mhc-calendar-view-summary (not mhc-calendar-view-summary)) (mhc-calendar/goto-date (mhc-calendar-get-date))) (defun mhc-calendar-goto-view () (interactive) (cond ((mhc-calendar/in-summary-p) (mhc-calendar/view-file (mhc-calendar/in-summary-p))) ((mhc-calendar/in-summary-hnf-p) (mhc-calendar/hnf-view)) (t (setq mhc-calendar-view-summary t) (mhc-calendar/goto-date (mhc-calendar-get-date)) (goto-char (next-single-property-change (point) 'mhc-calendar/summary-prop))))) (defun mhc-calendar/view-file (file) (if (and (stringp file) (file-exists-p file)) (let ((newname (mhc-date-format mhc-calendar-view-date "+%04d/%02d/%02d" yy mm dd))) (mhc-window-push) (view-file-other-window file) ;; eword decode (mhc-calendar/view-file-decode-header) (setq view-exit-action 'mhc-calendar-view-exit-action) (set-visited-file-name nil) (rename-buffer newname 'unique) (run-hooks 'mhc-calendar-view-file-hook) (set-buffer-modified-p nil) (setq buffer-read-only t)) (message "File does not exist (%s)." file))) (defun mhc-calendar/view-file-decode-header () (let ((buffer-read-only nil)) (goto-char (point-min)) (mhc-header-decode-ewords) (mhc-highlight-message))) ;; insert function (defun mhc-calendar-get-day (&optional arg) (interactive "P") (let (str) (if (null arg) (setq str (mhc-calendar/get-day)) (setq str (mhc-calendar/get-day-region))) (kill-new str) (message "\"%s\" to the latest kill in the kill ring." str))) (defun mhc-calendar-get-day-insert-quit (&optional arg) (interactive "P") (when (mhc-calendar-get-day-insert arg) (mhc-calendar-quit))) (defun mhc-calendar-get-day-insert (&optional arg) (interactive "P") (let ((callbuf mhc-calendar/inserter-call-buffer) (type mhc-calendar/inserter-type) (defbuff (buffer-name (car (delete (get-buffer mhc-calendar/buffer) (buffer-list))))) str) ;; in mhc-calendar/buffer (if (null arg) (setq str (mhc-calendar/get-day type)) (setq str (mhc-calendar/get-day-region type))) (kill-new str) (unless (and callbuf (get-buffer callbuf) (buffer-name callbuf)) (setq callbuf (read-buffer "Insert buffer? " defbuff t))) ;; in mhc-clendar-call-buffer (if (not (get-buffer callbuf)) (message "No buffer detect \"%s\"" callbuf) (set-buffer (get-buffer callbuf)) (pop-to-buffer callbuf) (cond ((window-minibuffer-p) (insert str) t) (t (condition-case err (progn (insert str) (message "\"%s\" insert done." str) t) (error (pop-to-buffer (get-buffer mhc-calendar/buffer)) (message "\"%s\" insert failed." str) nil))))))) (defun mhc-calendar/get-day (&optional type) (let ((date (mhc-calendar-get-date)) datelst rlst) (cond ((eq type 'minibuffer) (setq datelst mhc-calendar/inserter-for-minibuffer)) ((or (eq type 'duration) (eq type 'day)) (setq datelst mhc-calendar/inserter-for-draft)) (t (setq datelst mhc-calendar-inserter-date-list))) (setq rlst (mhc-calendar/get-day-list date datelst)) (mhc-calendar/get-day-select rlst))) (defun mhc-calendar/get-day-region (&optional type) (let (cat datebeg dateend datetmp datelst rlst) (if (not (mhc-date-p mhc-calendar/mark-date)) (error "No mark set in this buffer") (setq dateend (mhc-calendar-get-date)) (setq datebeg mhc-calendar/mark-date) ;; swap (when (mhc-date> datebeg dateend) (setq datetmp dateend) (setq dateend datebeg) (setq datebeg datetmp)) (if (eq type 'day) ;; for X-SC-Day: (20000101 200000102 ... 20000131) (progn (setq datetmp nil) (while (mhc-date<= datebeg dateend) (setq datetmp (cons datebeg datetmp)) (setq datebeg (mhc-date++ datebeg))) (mapconcat (lambda (x) (mhc-date-format x "%04d%02d%02d" yy mm dd)) (nreverse datetmp) " ")) (cond ((eq type 'minibuffer) (setq datelst mhc-calendar/inserter-for-minibuffer)) ((eq type 'duration) (setq datelst mhc-calendar/inserter-for-draft)) (t (setq datelst mhc-calendar-inserter-date-list))) (setq rlst (mhc-calendar/get-day-list datebeg datelst dateend)) (mhc-calendar/get-day-select rlst))))) ;; selector (defvar mhc-calendar/select-alist nil) (defvar mhc-calendar/select-hist nil) (defvar mhc-calendar/select-map nil) (defvar mhc-calendar/select-buffer "*Completions*") (defun mhc-calendar/get-day-select (lst) (cond ((= (length lst) 0) (error "Something error occur.")) ((= (length lst) 1) (car lst)) (t (let ((i 0) (completion-ignore-case nil) alst hist cell input) (while lst (setq cell (format "%d: %s" i (car lst))) (setq hist (cons cell hist)) (setq alst (cons (cons cell (car lst)) alst)) (setq i (1+ i)) (setq lst (cdr lst))) (setq hist (nreverse hist)) (setq alst (nreverse alst)) (setq mhc-calendar/select-alist alst) ;; for completion (setq input (mhc-calendar/select-comp "Select format: " 'active)) (when (string= input "") (setq input (cdr (car alst)))) (when (string-match "^\\([0-9]+\\)$" input) (setq i (string-to-number input)) (when (> (length alst) i) (setq input (cdr (nth i alst))))) (when (string-match "^[0-9]+:[ \t]*" input) (setq input (substring input (match-end 0)))) input)))) (defun mhc-calendar-count-days-region () (interactive) (let ((mark mhc-calendar/mark-date) (date (mhc-calendar-get-date))) (if (null mark) (error "No mark set in this buffer") (setq date (mhc-date++ (mhc-date- (max mark date) (min mark date)))) (kill-new (int-to-string date)) (if (< date 7) (message "%d days in region." date) (if (= (% date 7) 0) (message "%d days (%d weeks) in region." date (/ date 7)) (message "%d days (%d weeks + %d days) in region." date (/ date 7) (% date 7))))))) (if mhc-calendar/select-map () (setq mhc-calendar/select-map (make-sparse-keymap)) (define-key mhc-calendar/select-map "\t" 'mhc-calendar/select-comp-window) (define-key mhc-calendar/select-map "\r" 'exit-minibuffer) (define-key mhc-calendar/select-map "\n" 'exit-minibuffer) (define-key mhc-calendar/select-map "\C-g" 'abort-recursive-edit) (define-key mhc-calendar/select-map "\M-s" 'next-matching-history-element) (define-key mhc-calendar/select-map "\M-p" 'previous-history-element) (define-key mhc-calendar/select-map "\M-n" 'next-history-element) (define-key mhc-calendar/select-map "\M-v" 'switch-to-completions)) (defun mhc-calendar/select-comp-setup () (mhc-calendar/select-comp-window "")) (defun mhc-calendar/select-comp-window (&optional word) (interactive) (let ((completion-ignore-case nil) outp pos) (when (not word) (setq word (buffer-substring-no-properties (save-excursion (beginning-of-line) (point)) (point-max))) (setq outp (try-completion word mhc-calendar/select-alist)) (when (and (stringp outp) (window-minibuffer-p (get-buffer-window (current-buffer)))) (beginning-of-line) (delete-region (point) (point-max)) (insert outp))) (with-output-to-temp-buffer mhc-calendar/select-buffer (display-completion-list (all-completions word mhc-calendar/select-alist))))) (defvar mhc-calendar/select-comp-active nil) (defadvice choose-completion-string (around mhc-calendar-select activate) ad-do-it (when mhc-calendar/select-comp-active (select-window (active-minibuffer-window)))) (defun mhc-calendar/select-comp (&optional prompt active) (let ((minibuffer-setup-hook minibuffer-setup-hook) (ret "")) (unless prompt (setq prompt "Select: ")) (unwind-protect (progn ;; Select minibuffer forcibly (setq mhc-calendar/select-comp-active t) ;; completion buffer setup (when active (add-hook 'minibuffer-setup-hook 'mhc-calendar/select-comp-setup)) (setq ret (read-from-minibuffer prompt nil mhc-calendar/select-map nil 'mhc-calendar/select-hist))) (setq mhc-calendar/select-comp-active nil) (remove-hook 'minibuffer-setup-hook 'mhc-calendar/select-comp-setup) (and (buffer-live-p (get-buffer mhc-calendar/select-buffer)) (kill-buffer mhc-calendar/select-buffer)) ret))) ;; inserter (defun mhc-calendar/get-day-list-func (form) (let (func) (cond ((stringp form) form) ((symbolp form) (setq func (intern-soft (concat "mhc-calendar/inserter-" (symbol-name form)))) (and func (funcall func)))))) (defun mhc-calendar/inserter-yy () (format "%4d" yy)) (defun mhc-calendar/inserter-nengo () (if (> yy 1987) (format "平成%2d年" (- yy 1988)) (if (> yy 1924) (format "昭和%2d年" (- yy 1925)) "昔々"))) (defun mhc-calendar/inserter-mm () (format "%d" mm)) (defun mhc-calendar/inserter-mm02 () (format "%02d" mm)) (defun mhc-calendar/inserter-mm2 () (format "%2d" mm)) (defun mhc-calendar/inserter-mm-string () (mhc-date-digit-to-mm-string mm)) (defun mhc-calendar/inserter-mm-string-long () (mhc-date-digit-to-mm-string mm t)) (defun mhc-calendar/inserter-dd () (format "%d" dd)) (defun mhc-calendar/inserter-dd02 () (format "%02d" dd)) (defun mhc-calendar/inserter-dd2 () (format "%2d" dd)) (defun mhc-calendar/inserter-ww () (format "%d" ww)) (defun mhc-calendar/inserter-ww-string () (mhc-date-digit-to-ww-string ww)) (defun mhc-calendar/inserter-ww-string-long () (mhc-date-digit-to-ww-string ww t)) (defun mhc-calendar/inserter-ww-japanese () (mhc-date-digit-to-ww-japanese-string ww)) (defun mhc-calendar/inserter-ww-japanese-long () (mhc-date-digit-to-ww-japanese-string ww t)) (defun mhc-calendar/get-day-list (date &optional datelst dateend) (let (lst-org formlst retlst retlst2 ret con) (setq lst-org (or datelst mhc-calendar-inserter-date-list)) (setq datelst lst-org) ;; begin (mhc-date-let date (while datelst (setq formlst (car (car datelst))) (setq ret nil) (while formlst (setq ret (concat ret (mhc-calendar/get-day-list-func (car formlst)))) (setq formlst (cdr formlst))) (setq retlst (cons ret retlst)) (setq datelst (cdr datelst)))) (setq retlst (nreverse retlst)) (if (not dateend) retlst ;; return ;; duration (setq datelst lst-org) (mhc-date-let dateend (while datelst (setq con (cdr (car datelst))) (if (listp con) ;; multiple connectoer (while con (setq formlst (car (car datelst))) (setq ret (car con)) (while formlst (setq ret (concat ret (mhc-calendar/get-day-list-func (car formlst)))) (setq formlst (cdr formlst))) (setq retlst2 (cons (concat (car retlst) ret) retlst2)) (setq con (cdr con))) (setq formlst (car (car datelst))) (setq ret (cdr (car datelst))) (while formlst (setq ret (concat ret (mhc-calendar/get-day-list-func (car formlst)))) (setq formlst (cdr formlst))) (setq retlst2 (cons (concat (car retlst) ret) retlst2))) (setq retlst (cdr retlst)) (setq datelst (cdr datelst)))) (nreverse retlst2)))) ;; scan & move functions (defun mhc-calendar-scan (&optional hide-private) (interactive "P") (let ((date (mhc-calendar-get-date))) (mhc-calendar-quit) (mhc-goto-month date hide-private) (goto-char (point-min)) (if (mhc-summary-search-date date) (progn (beginning-of-line) (if (not (pos-visible-in-window-p (point))) (recenter)))))) (defun mhc-calendar-quit () (interactive) (let ((win (get-buffer-window mhc-calendar/buffer)) (buf (get-buffer mhc-calendar/buffer))) (with-current-buffer buf (mhc-calendar/delete-overlay)) (if (null win) () (bury-buffer buf) (if (null (one-window-p)) (delete-windows-on buf) (set-window-buffer win (other-buffer)) (select-window (next-window)))))) (defun mhc-calendar-input-exit () (setq mhc-calendar/inserter-type nil) (setq mhc-calendar/inserter-call-buffer nil)) (defun mhc-calendar-exit () (interactive) (mhc-calendar-quit) (remove-hook 'post-command-hook 'mhc-calendar/duration-show) (kill-buffer (get-buffer mhc-calendar/buffer))) (defun mhc-calendar-goto-month (&optional date) (interactive) (mhc-calendar/goto-date (if (integerp date) date (mhc-input-month "Month ")))) (defun mhc-calendar-rescan () (interactive) (set-buffer (get-buffer mhc-calendar/buffer)) (let ((cdate mhc-calendar-date) (pdate (mhc-calendar-get-date))) (setq mhc-calendar-date nil) (mhc-calendar/create-buffer cdate) (mhc-calendar/goto-date pdate))) (defun mhc-calendar-goto-home () (interactive) (setq mhc-calendar-view-summary (not (and (eq last-command 'mhc-calendar-goto-home) mhc-calendar-view-summary))) (mhc-calendar/goto-date (mhc-calendar-get-date)) (set-window-start (selected-window) (point-min))) (defun mhc-calendar-next-day (&optional arg) (interactive "p") (let ((date (mhc-calendar-get-date))) (mhc-calendar/goto-date (+ date arg)))) (defun mhc-calendar-prev-day (&optional arg) (interactive "p") (mhc-calendar-next-day (- arg))) (defun mhc-calendar-next-week (&optional arg) (interactive "p") (if (or (mhc-calendar/in-summary-p) (mhc-calendar/in-summary-hnf-p)) (let ((pos (point))) (forward-line) (if (eobp) (goto-char pos))) (mhc-calendar-next-day (* arg 7)))) (defun mhc-calendar-prev-week (&optional arg) (interactive "p") (if (or (mhc-calendar/in-summary-p) (mhc-calendar/in-summary-hnf-p)) (let ((pos (point))) (forward-line -1) (if (or (mhc-calendar/in-summary-p) (mhc-calendar/in-summary-hnf-p)) () (goto-char pos))) (mhc-calendar-next-day (- (* arg 7))))) (defun mhc-calendar-next-month (&optional arg) (interactive "p") (mhc-calendar/goto-date (mhc-date-mm+ (mhc-calendar-get-date) arg))) (defun mhc-calendar-prev-month (&optional arg) (interactive "p") (mhc-calendar-next-month (- arg))) (defun mhc-calendar-next-year (&optional arg) (interactive "p") (mhc-calendar/goto-date (mhc-date-yy+ (mhc-calendar-get-date) arg))) (defun mhc-calendar-prev-year (&optional arg) (interactive "p") (mhc-calendar-next-year (- arg))) (defun mhc-calendar-inc-month (&optional arg) (interactive "p") (set-buffer (get-buffer mhc-calendar/buffer)) (let* ((dnew (mhc-date-mm+ mhc-calendar-date arg)) (ddold (mhc-date-dd (mhc-calendar-get-date))) (dnew2 (mhc-date-let dnew (if (mhc-date/check yy mm ddold) (mhc-date-new yy mm ddold) (mhc-date-new yy mm (mhc-date/last-day-of-month yy mm)))))) (mhc-calendar/create-buffer dnew) (mhc-calendar/goto-date dnew2))) (defun mhc-calendar-dec-month (&optional arg) (interactive "p") (mhc-calendar-inc-month (- arg))) (defun mhc-calendar-get-date () (when (mhc-calendar-p) (if (mhc-calendar/in-date-p) (mhc-calendar/in-date-p) (if (or (mhc-calendar/in-summary-p) (mhc-calendar/in-summary-hnf-p)) mhc-calendar-view-date (let* ((pos (point)) (col (current-column)) (colnum (mhc-calendar/get-date-colnum col)) (line (+ (count-lines (point-min) (point)) (if (= col 0) 1 0))) (date (mhc-date-mm+ mhc-calendar-date colnum)) (date1 (mhc-date-mm-first date)) (datelast (mhc-date-mm-last date)) daypos) (cond ((< line 3) date1) ((> line 9) datelast) (t (setq daypos (next-single-property-change (point) 'mhc-calendar/date-prop)) (if daypos (progn (goto-char daypos) (if (= colnum (mhc-calendar/get-date-colnum (current-column))) (mhc-calendar/in-date-p) (goto-char pos) (if (or (and (goto-char (previous-single-property-change (point) 'mhc-calendar/date-prop)) (mhc-calendar/in-date-p)) (and (goto-char (previous-single-property-change (point) 'mhc-calendar/date-prop)) (mhc-calendar/in-date-p))) (if (= colnum (mhc-calendar/get-date-colnum (current-column))) (mhc-calendar/in-date-p) datelast) datelast))) datelast)))))))) (defun mhc-calendar-view-date () (and (mhc-calendar-p) mhc-calendar-view-date)) ;; mouse function (defun mhc-calendar-day-at-mouse (event) (interactive "e") (set-buffer (mhc-calendar/event-buffer event)) (pop-to-buffer (mhc-calendar/event-buffer event)) (goto-char (mhc-calendar/event-point event)) (cond ((mhc-calendar/in-date-p) (mhc-calendar-goto-home)) ((mhc-calendar/in-summary-p) (mhc-calendar/view-file (mhc-calendar/in-summary-p))) ((mhc-calendar/in-summary-hnf-p) (mhc-calendar/hnf-view)) (t (message "Nothing to do in this point.")))) ;; mark (defun mhc-calendar-set-mark-command (arg) (interactive "P") (if (null arg) (progn (setq mhc-calendar/mark-date (mhc-calendar-get-date)) (message "Mark set")) (setq mhc-calendar/mark-date nil) (mhc-calendar/duration-show) (message "Mark unset"))) (defun mhc-calendar-exchange-point-and-mark () (interactive) (let ((mark mhc-calendar/mark-date) (date (mhc-calendar-get-date))) (if (null mark) (error "No mark set in this buffer") (setq mhc-calendar/mark-date date) (mhc-calendar/goto-date mark) (mhc-calendar/duration-show)))) ;; post-command-hook (defun mhc-calendar/duration-show () (when (eq this-command 'keyboard-quit) (setq mhc-calendar/mark-date nil)) (if (not (mhc-calendar-p)) (remove-hook 'post-command-hook 'mhc-calendar/duration-show) (when (mhc-calendar-p) (mhc-calendar/delete-overlay) (setq mode-name "mhc-calendar") (when (and mhc-calendar-use-duration-show mhc-calendar/mark-date) (let ((datebeg mhc-calendar/mark-date) (dateend (point)) datetmp pos) (save-excursion (goto-char dateend) (setq dateend (mhc-calendar-get-date)) (when (and datebeg dateend (not (mhc-date= datebeg dateend))) (when (mhc-date> datebeg dateend) (setq datetmp dateend) (setq dateend datebeg) (setq datebeg datetmp)) (when (or (eq mhc-calendar-use-duration-show 'modeline) (eq mhc-calendar-use-duration-show 'mixed)) (setq mode-name (format "mhc-calendar %s-%s" (mhc-date-format datebeg "%04d/%02d/%02d(%s)" yy mm dd (mhc-date-digit-to-ww-string ww)) (mhc-date-format dateend "%04d/%02d/%02d(%s)" yy mm dd (mhc-date-digit-to-ww-string ww))))) (when (or (eq mhc-calendar-use-duration-show 'face) (eq mhc-calendar-use-duration-show 'mixed)) (goto-char (point-min)) (setq datetmp (mhc-calendar-get-date)) (if (mhc-date< datebeg datetmp) (setq datebeg datetmp)) (setq pos t) (while (and pos (mhc-date<= datebeg dateend)) (setq pos (mhc-calendar/tp-any (point-min) (point-max) 'mhc-calendar/date-prop datebeg)) (when pos (overlay-put (make-overlay pos (+ pos 2)) 'face 'mhc-calendar-face-duration)) (setq datebeg (mhc-date++ datebeg))))))) (when (or (eq mhc-calendar-use-duration-show 'modeline) (eq mhc-calendar-use-duration-show 'mixed)) (force-mode-line-update)))))) ;; misc (defun mhc-calendar/delete-overlay () (when (or (eq mhc-calendar-use-duration-show 'face) (eq mhc-calendar-use-duration-show 'mixed)) (let ((ovlin (overlays-in (point-min) (point-max)))) (while ovlin (delete-overlay (car ovlin)) (setq ovlin (cdr ovlin)))))) (defun mhc-calendar/delete-region (yy mm dd pos) (condition-case err (if (mhc-date/check yy mm dd) (progn (delete-region (point) pos) (mhc-date-new yy mm dd)) nil) (error nil))) (defun mhc-calendar-view-exit-action (buff) (kill-buffer buff) (and (get-buffer mhc-calendar/buffer) (mhc-window-pop))) ;; mhc-minibuffer support (defun mhc-minibuf-insert-calendar () (interactive) (let ((yy 1) (mm 1) (dd 1) date pos) (setq mhc-calendar/inserter-type 'minibuffer) (setq mhc-calendar/inserter-call-buffer (current-buffer)) (save-excursion (setq pos (point)) (skip-chars-backward "0-9/") (cond ((looking-at "\\([12][0-9][0-9][0-9]\\)/\\([0-2][0-9]\\)/\\([0-3][0-9]\\)") (setq yy (mhc-calendar/buffer-substring-to-num 1)) (setq mm (mhc-calendar/buffer-substring-to-num 2)) (setq dd (mhc-calendar/buffer-substring-to-num 3)) (setq date (mhc-calendar/delete-region yy mm dd pos))) ((looking-at "\\([12][0-9][0-9][0-9]\\)/\\([0-2][0-9]\\)/?") (setq yy (mhc-calendar/buffer-substring-to-num 1)) (setq mm (mhc-calendar/buffer-substring-to-num 2)) (setq date (mhc-calendar/delete-region yy mm dd pos))) ((looking-at "\\([12][0-9][0-9][0-9]\\)/?") (setq yy (mhc-calendar/buffer-substring-to-num 1)) (setq date (mhc-calendar/delete-region yy mm dd pos))))) (mhc-calendar date))) ;; mhc-draft support (defun mhc-draft-insert-calendar () (interactive) (let ((yy 1) (mm 1) (dd 1) (case-fold-search t) date pos) (setq mhc-calendar/inserter-call-buffer (current-buffer)) (setq mhc-calendar/inserter-type nil) (save-excursion (setq pos (point)) (goto-char (point-min)) (if (and (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$\\|^$") nil t) (< pos (point))) (progn (setq mhc-calendar/inserter-type 'duration) (save-excursion (goto-char pos) (and (re-search-backward "x-[^:]+: " nil t) (looking-at "^x-sc-day: ") (setq mhc-calendar/inserter-type 'day))))) (goto-char pos) (skip-chars-backward "0-9") (cond ((looking-at "\\([12][0-9][0-9][0-9]\\)\\([0-2][0-9]\\)\\([0-3][0-9]\\)") (setq yy (mhc-calendar/buffer-substring-to-num 1)) (setq mm (mhc-calendar/buffer-substring-to-num 2)) (setq dd (mhc-calendar/buffer-substring-to-num 3)) (setq date (mhc-calendar/delete-region yy mm dd pos))) ((looking-at "\\([12][0-9][0-9][0-9]\\)\\([0-2][0-9]\\)") (setq yy (mhc-calendar/buffer-substring-to-num 1)) (setq mm (mhc-calendar/buffer-substring-to-num 2)) (setq date (mhc-calendar/delete-region yy mm dd pos))) ((looking-at "\\([12][0-9][0-9][0-9]\\)") (setq yy (mhc-calendar/buffer-substring-to-num 1)) (setq date (mhc-calendar/delete-region yy mm dd pos))))) (mhc-calendar date))) ;; hnf-mode interface (defun mhc-calendar/hnf-get-filename (date) (expand-file-name (mhc-date-format date "d%04d%02d%02d.hnf" yy mm dd) (if hnf-diary-year-directory-flag (expand-file-name (mhc-date-format date "%04d" yy) hnf-diary-dir) hnf-diary-dir))) (defun mhc-calendar/hnf-file-list (date) (let ((i -1) flst) (setq date (mhc-date-mm+ date -1)) (while (< i 2) (let* ((dir (if hnf-diary-year-directory-flag (expand-file-name (mhc-date-format date "%04d" yy) hnf-diary-dir) (expand-file-name hnf-diary-dir))) (fnexp (mhc-date-format date "d%04d%02d[0-3][0-9]\\.hnf" yy mm))) (if (file-directory-p dir) (setq flst (append (directory-files dir nil fnexp 'no-sort) flst)) (setq flst nil)) (setq date (mhc-date-mm+ date 1)) (setq i (1+ i)))) flst)) (defvar mhc-calendar/hnf-ignore-categories nil) (defun mhc-calendar-hnf-edit (&optional args) (interactive "P") (if (not mhc-calendar-link-hnf) (message "Nothing to do.") (let ((hnffile (mhc-calendar/hnf-get-filename (mhc-calendar-get-date))) (mhcfile (mhc-calendar/in-summary-p)) (count (mhc-calendar/in-summary-hnf-p)) cats subj uri lst) (save-excursion (when (and args mhcfile (file-readable-p mhcfile)) (unless mhc-calendar/hnf-ignore-categories (setq lst mhc-icon-function-alist) (while lst (setq mhc-calendar/hnf-ignore-categories (cons (downcase (car (car lst))) mhc-calendar/hnf-ignore-categories)) (setq lst (cdr lst)))) (with-temp-buffer (mhc-insert-file-contents-as-coding-system mhc-default-coding-system mhcfile) (mhc-header-decode-ewords) (mhc-header-narrowing (setq cats (mhc-header-get-value "x-sc-category")) (setq subj (mhc-header-get-value "x-sc-subject")) (setq lst (mhc-misc-split cats)) (when (member "Link" lst) (setq uri (or (mhc-header-get-value "x-uri") (mhc-header-get-value "x-url")))) (setq cats nil) (while lst (unless (member (downcase (car lst)) mhc-calendar/hnf-ignore-categories) (setq cats (cons (car lst) cats))) (setq lst (cdr lst))) (setq cats (nreverse cats)))))) (find-file-other-window hnffile) (hnf-mode) (and (integerp count) (mhc-calendar/hnf-search-title count)) (when subj (goto-char (point-max)) (insert "\n") (when cats (insert (format "CAT %s\n" (mapconcat 'identity cats " ")))) (if uri (insert (format "LNEW %s %s\n" uri subj)) (insert (format "NEW %s\n" subj))))))) ;; xxxxx (defun mhc-calendar/hnf-view () (interactive) (let ((fname (mhc-calendar/hnf-get-filename (mhc-calendar-get-date))) (count (mhc-calendar/in-summary-hnf-p))) (if (not (file-readable-p fname)) (message "File does not exist (%s)." fname) (mhc-window-push) (view-file-other-window fname) (setq view-exit-action 'mhc-calendar-view-exit-action) (and (integerp count) (mhc-calendar/hnf-search-title count))))) (defun mhc-calendar/hnf-search-title (count) (goto-char (point-min)) (while (and (> count 0) (not (eobp))) (re-search-forward "^\\(L?NEW\\|L?SUB\\)[ \t]+" nil t) (setq count (1- count))) (beginning-of-line) (recenter (/ (window-height) 4))) (defun mhc-calendar/hnf-mark-diary-entries () (let ((cdate (mhc-date-mm-first (mhc-date-mm+ mhc-calendar-date -1))) (edate (mhc-date-mm-last (mhc-date-mm+ mhc-calendar-date 1))) (flst (mhc-calendar/hnf-file-list mhc-calendar-date)) (mark "'")) (mhc-face-put mark 'mhc-calendar-hnf-face-mark) (while (<= cdate edate) (if (member (mhc-date-format cdate "d%04d%02d%02d.hnf" yy mm dd) flst) (progn (goto-char (+ 2 (mhc-calendar/tp-any (point-min) (point-max) 'mhc-calendar/date-prop cdate))) (insert mark) (if (eq (char-after (point)) ?\ ) (delete-char 1)))) (setq cdate (1+ cdate))))) (defun mhc-calendar/hnf-summary-insert () (let ((fname (mhc-calendar/hnf-get-filename mhc-calendar-view-date)) (buffer-read-only nil) (newmark "#") (sub "＠") (cat "") (count 1) (ncount 1) new summary str uri) (if (not (file-readable-p fname)) () (goto-char (point-max)) (with-temp-buffer ;; hnf-mode.el require APEL :-) (insert-file-contents fname) (goto-char (point-min)) (mhc-face-put sub 'mhc-calendar-hnf-face-subtag) (while (not (eobp)) (cond ;; CAT ((looking-at "^CAT[ \t]+\\(.*\\)$") (setq cat (buffer-substring (match-beginning 1) (match-end 1))) (while (string-match "[ \t]+" cat) (setq cat (concat (substring cat 0 (match-beginning 0)) "][" (substring cat (match-end 0))))) (setq cat (concat "[" cat "]")) (mhc-face-put cat 'mhc-calendar-hnf-face-cat) (setq cat (concat cat " "))) ;; NEW ((looking-at "^NEW[ \t]+\\(.*\\)$") (setq str (buffer-substring (match-beginning 1) (match-end 1))) (mhc-face-put str 'mhc-calendar-hnf-face-new) (setq new (format "%s%d" newmark ncount)) (mhc-face-put new 'mhc-calendar-hnf-face-newtag) (setq str (concat " " new " " cat str "\n")) (put-text-property 0 (length str) 'mhc-calendar/summary-hnf-prop count str) (setq summary (concat summary str) count (1+ count) ncount (1+ ncount) cat "")) ;; LNEW ((looking-at "^LNEW[ \t]+\\([^ \t]+\\)[ \t]+\\(.*\\)$") (setq uri (concat "<" (buffer-substring (match-beginning 1) (match-end 1)) ">")) (mhc-face-put uri 'mhc-calendar-hnf-face-uri) (setq str (buffer-substring (match-beginning 2) (match-end 2))) (mhc-face-put str 'mhc-calendar-hnf-face-new) (setq new (format "%s%d" newmark ncount)) (mhc-face-put new 'mhc-calendar-hnf-face-newtag) (setq str (concat " " new " " cat str " " uri "\n")) (put-text-property 0 (length str) 'mhc-calendar/summary-hnf-prop count str) (setq summary (concat summary str) count (1+ count) ncount (1+ ncount) cat "")) ;; SUB ((looking-at "^SUB[ \t]+\\(.*\\)$") (setq str (buffer-substring (match-beginning 1) (match-end 1))) (mhc-face-put str 'mhc-calendar-hnf-face-sub) (setq str (concat " " sub " " cat str "\n")) (put-text-property 0 (length str) 'mhc-calendar/summary-hnf-prop count str) (setq summary (concat summary str) count (1+ count) cat "")) ;; LSUB ((looking-at "^LSUB[ \t]+\\([^ \t]+\\)[ \t]+\\(.*\\)$") (setq uri (concat "<" (buffer-substring (match-beginning 1) (match-end 1)) ">")) (mhc-face-put uri 'mhc-calendar-hnf-face-uri) (setq str (buffer-substring (match-beginning 2) (match-end 2))) (mhc-face-put str 'mhc-calendar-hnf-face-sub) (setq str (concat " " sub " " cat str " " uri "\n")) (put-text-property 0 (length str) 'mhc-calendar/summary-hnf-prop count str) (setq summary (concat summary str) count (1+ count) cat ""))) (forward-line))) (if summary (insert "\n" summary)) (delete-char -1) (set-buffer-modified-p nil)))) (defun mhc-calendar-hnf-face-setup () (interactive) (let ((ow (called-interactively-p 'interactive))) (mhc-face-setup-internal mhc-calendar-hnf-face-alist ow) (mhc-face-setup-internal mhc-calendar-hnf-face-alist-internal nil))) ;;; Pseudo MUA Backend Methods: (defun mhc-calendar-insert-summary-contents (inserter) (let ((beg (point)) (name (or (mhc-record-name (mhc-schedule-record mhc-tmp-schedule)) "Dummy"))) (funcall inserter) (put-text-property beg (point) 'mhc-calendar/summary-prop name) (insert "\n"))) (provide 'mhc-calendar) (put 'mhc-calendar 'insert-summary-contents 'mhc-calendar-insert-summary-contents) ;;; 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-calendar.el ends here mhc-1.1.1/emacs/mhc-calfw.el000066400000000000000000000075371262546231500155560ustar00rootroot00000000000000;;; calfw-mhc.el --- calfw calendar view for mhc ;; Author: Yoshinari Nomura ;;; Commentary: ;; setting example: ;; ;; (require 'calfw) ;; (require 'calfw-mhc) ;; (require 'calfw-org) ;; ;; (defun open-calendar () ;; (interactive) ;; (cfw:open-calendar-buffer ;; :view 'month ;; :contents-sources ;; (list ;; (cfw:org-create-source "Seagreen4") ;; (cfw:mhc-create-source "all" "black" "!(Holiday || Birthday)") ;; (cfw:mhc-create-source "birthday" "yellow" "Birthday") ;; (cfw:mhc-create-source "holiday" "red" "Holiday")))) ;;; Code: (require 'mhc) (require 'calfw) (defvar cfw:mhc-text-keymap (let ((map (make-sparse-keymap))) (define-key map [mouse-1] 'cfw:mhc-open-article) (define-key map (kbd "") 'cfw:mhc-open-article) map) "key map on the calendar item text.") (defvar cfw:mhc-schedule-map (cfw:define-keymap '( ("q" . cfw:mhc-close-article) ("SPC" . cfw:mhc-open-article) )) "Key map for the mhc calendar mode.") (defun cfw:mhc-schedule-cache-clear ()) (defun cfw:to-mhc-date (date) (mhc-date-new (nth 2 date) (nth 0 date) (nth 1 date))) (defun cfw:mhc-to-calfw-date (mhc-date) (mhc-day-let mhc-date (list month day-of-month year))) (defun cfw:mhc-make-one-day-entry (day-info &optional category-predicate) (cons (cfw:mhc-to-calfw-date (mhc-day-date day-info)) (delq nil (mapcar (lambda (sch) (if (funcall category-predicate sch) (cfw:mhc-make-summary-string sch) nil)) (mhc-day-schedules day-info))))) (defun blank-p (s) (not (and s (not (string= s ""))))) ;; ;; Although mhc has its own formatting functions for this purpose, ;; they seems to require some modification to get along with calfw. ;; I'm in the mood for fixing the functions in mhc for the ;; first time almost in a decade :-) ;; (defun cfw:mhc-make-summary-string (schedule) (let ((line (format "%s %s %s" (mhc-schedule-time-as-string schedule) (mhc-schedule-subject-as-string schedule) (if (blank-p (mhc-schedule-location schedule)) "" (format "[%s]" (mhc-schedule-location schedule)))))) (propertize line 'keymap cfw:mhc-text-keymap 'mhc-schedule schedule))) (defun cfw:mhc-schedule-period-to-calendar (begin end &optional category) (let ((category-predicate (mhc-expr-compile category))) (mapcar (lambda (day-info) (cfw:mhc-make-one-day-entry day-info category-predicate)) (mhc-db-scan (cfw:to-mhc-date begin) (cfw:to-mhc-date end) 'nosort)))) (defun cfw:mhc-create-source (name &optional color category) (lexical-let ((category category)) (make-cfw:source :name (concat "mhc:" name) :color (or color "SteelBlue") :update 'cfw:mhc-schedule-cache-clear :data (lambda (begin end) (cfw:mhc-schedule-period-to-calendar begin end category))))) (defun cfw:mhc-close-article () (interactive) (mhc-window-pop) (kill-buffer)) (defun cfw:mhc-open-article () (interactive) (mhc-window-push) (let ((schedule (get-text-property (point) 'mhc-schedule))) (if schedule (cfw:details-popup (with-temp-buffer (mhc-insert-file-contents-as-coding-system mhc-default-coding-system (mhc-record-name (mhc-schedule-record schedule))) (mhc-calendar/view-file-decode-header) (buffer-string) )) (message "mhc schedule not found")))) (defun cfw:open-mhc-calendar () (interactive) (cfw:open-calendar-buffer :view 'month :contents-sources (list (cfw:mhc-create-source "all" "black" "!(Holiday | Birthday)") (cfw:mhc-create-source "birthday" "brown" "Birthday") (cfw:mhc-create-source "holiday" "red" "Holiday")))) (provide 'mhc-calfw) ;;; mhc-calfw.el ends here mhc-1.1.1/emacs/mhc-compat.el000066400000000000000000000073641262546231500157430ustar00rootroot00000000000000;;; -*- mode: Emacs-Lisp; coding: utf-8 -*- ;; Author: Yoshinari Nomura , ;; TSUCHIYA Masatoshi ;; Created: 2000/05/01 ;; Revised: $Date$ ;;; Commentary: ;; This file is a part of MHC, and includes definitions to absorb ;; incompatibilities between emacsen. ;;; Code: (if (fboundp 'insert-file-contents-as-coding-system) (defalias 'mhc-insert-file-contents-as-coding-system 'insert-file-contents-as-coding-system) (defun mhc-insert-file-contents-as-coding-system (coding-system filename &optional visit beg end replace) "Like `insert-file-contents', q.v., but CODING-SYSTEM the first arg will be applied to `coding-system-for-read'." (let ((coding-system-for-read coding-system) (file-coding-system-for-read coding-system)) (insert-file-contents filename visit beg end replace)))) (if (fboundp 'write-region-as-coding-system) (defalias 'mhc-write-region-as-coding-system 'write-region-as-coding-system) (defun mhc-write-region-as-coding-system (coding-system start end filename &optional append visit lockname) "Like `write-region', q.v., but CODING-SYSTEM the first arg will be applied to `coding-system-for-write'." (let ((coding-system-for-write coding-system) (file-coding-system coding-system)) (write-region start end filename append visit)))) (if (and (fboundp 'regexp-opt) (not (featurep 'xemacs))) (defalias 'mhc-regexp-opt 'regexp-opt) (defun mhc-regexp-opt (strings &optional paren) "Return a regexp to match a string in STRINGS. Each string should be unique in STRINGS and should not contain any regexps, quoted or not. If optional PAREN is non-nil, ensure that the returned regexp is enclosed by at least one regexp grouping construct." (let ((open-paren (if paren "\\(" "")) (close-paren (if paren "\\)" ""))) (concat open-paren (mapconcat 'regexp-quote strings "\\|") close-paren)))) (if (fboundp 'string-to-char-list) (defalias 'mhc-string-to-char-list 'string-to-char-list) (defun mhc-string-to-char-list (string) (string-to-list string))) (provide 'mhc-compat) ;;; 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-compat.el ends here mhc-1.1.1/emacs/mhc-date.el000066400000000000000000000522461262546231500153740ustar00rootroot00000000000000;;; mhc-date.el -- Digit style Date Calculation Lib. ;; Author: Yoshinari Nomura , ;; TSUCHIYA Masatoshi ;; ;; Created: 2000/06/14 ;; Revised: $Date: 2004/05/06 16:35:13 $ ;;; ;;; Commentary: ;;; ;; ;; mhc-date format is simple. It expresses a date by ;; days from 1970/1/1 ;; ;; for example: ;; ;; (mhc-date-new 1970 1 1) -> 0 ;; (mhc-date-new 2000 6 14) -> 11122 ;; ;; mhc-time is also simple. It expresses a time by minits from midnight. ;;; ;;; Code: ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; mhc-time (defsubst mhc-time/check (HH MM) (and (integerp HH) (>= HH 0) (<= HH 99) (integerp MM) (>= MM 0) (<= MM 59))) (defmacro mhc-time-HH (time) `(/ ,time 60)) (defmacro mhc-time-MM (time) `(% ,time 60)) ;; All constructors emit error signal if args are illegal. ;; In case called with noerror is t, return nil quietly. (defsubst mhc-time-new (HH MM &optional noerror) (if (mhc-time/check HH MM) (+ (* HH 60) MM) (if noerror nil (error "mhc-time-new: arg error (%s,%s)" HH MM)))) (defsubst mhc-time-new-from-string (str &optional noerror regexp) (let (ret (match (match-data))) (if (string-match (or regexp "^\\([0-9][0-9]\\):\\([0-9][0-9]\\)$") str) (setq ret (mhc-time-new (mhc-date/substring-to-int str 1) (mhc-date/substring-to-int str 2) t))) (store-match-data match) (if (or noerror ret) ret (error "mhc-time-new-from-string: format error (%s)" str)))) (defsubst mhc-time-now () (let* ((now (decode-time (current-time))) (HH (nth 2 now)) (MM (nth 1 now))) (mhc-time-new HH MM))) ;; xxx: use defmacro for speed !! (defalias 'mhc-time-max 'max) (defalias 'mhc-time-min 'min) (defalias 'mhc-time< '<) (defalias 'mhc-time= '=) (defalias 'mhc-time<= '<=) (defalias 'mhc-time> '>) (defalias 'mhc-time>= '>=) (defun mhc-time-sort (time-list) (sort time-list (function mhc-time<))) (defmacro mhc-time-let (time &rest form) (let ((tempvar (make-symbol "tempvar"))) `(let* ((,tempvar ,time) (hh (mhc-time-HH ,tempvar)) (mm (mhc-time-MM ,tempvar))) ,@form))) (put 'mhc-time-let 'lisp-indent-function 1) (put 'mhc-time-let 'edebug-form-spec '(form body)) (defmacro mhc-time-to-string (time) `(mhc-time-let ,time (format "%02d:%02d" hh mm))) (defun mhc-time-range-to-string (time-range) (let ((time1 (nth 0 time-range)) (time2 (nth 1 time-range))) (concat (if time1 (mhc-time-to-string time1)) (if time2 (concat "-" (mhc-time-to-string time2)))))) (defsubst mhc-time-to-list (time) (list (mhc-time-HH time) (mhc-time-MM time))) (defalias 'mhc-time+ '+) (defalias 'mhc-time- '-) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; mhc-date ;; ;; special form. ;; (defmacro mhc-date-let (date &rest form) "\ This special form converts DATE, as the number of days since 1970/01/01, to following local variables, and evaluates FORM. yy The year, an integer typically greater than 1900. mm The month of the year, as an integer between 1 and 12. dd The day of the month, as an integer between 1 and 31. ww The day of week, as an integer between 0 and 6, where 0 stands for Sunday. " (let ((tempvar (make-symbol "tempvar"))) `(let* ((,tempvar (mhc-date-to-list ,date)) (yy (nth 0 ,tempvar)) (mm (nth 1 ,tempvar)) (dd (nth 2 ,tempvar)) (ww (nth 3 ,tempvar))) ,@form))) (put 'mhc-date-let 'lisp-indent-function 1) (put 'mhc-date-let 'edebug-form-spec '(form body)) (defmacro mhc-date-let-for-month (date &rest form) "\ This special form converts DATE, as the number of days since 1970/01/01, to following local variables, and evaluates FORM. yy The year, an integer typically greater than 1900. mm The month of the year, as an integer between 1 and 12. dd The day of the month, as an integer between 1 and 31. ww The day of week, as an integer between 0 and 6, where 0 stands for Sunday. oo The order of week, as an integer between 0 and 4. last-p Predicate to check if the dd is in the last week. " (let ((tempvar (make-symbol "tempvar"))) `(let* ((,tempvar (mhc-date-to-list ,date)) (yy (nth 0 ,tempvar)) (mm (nth 1 ,tempvar)) (dd 1) (ww (nth 3 ,tempvar)) (end (mhc-date/last-day-of-month yy mm)) (days ,date) (last-p nil)) (while (<= dd end) ,@form (setq days (mhc-date++ days) dd (1+ dd) oo (/ (1- dd) 7) ww (% (1+ ww) 7) last-p (< (- end 7) dd)))))) (put 'mhc-date-let-for-month 'lisp-indent-function 1) (put 'mhc-date-let-for-month 'edebug-form-spec '(form body)) ;; ;; private ;; (defsubst mhc-date/leap-year-p (yy) (and (zerop (% yy 4)) (or (not (zerop (% yy 100))) (zerop (% yy 400))))) (defsubst mhc-date/last-day-of-month (yy mm) (if (and (= mm 2) (mhc-date/leap-year-p yy)) 29 (aref '[0 31 28 31 30 31 30 31 31 30 31 30 31] mm))) (defsubst mhc-date/check (yy mm dd) (and (integerp yy) (>= yy 1000) (integerp mm) (>= mm 1) (<= mm 12) (integerp dd) (>= dd 1) (<= dd (mhc-date/last-day-of-month yy mm)) t)) (defmacro mhc-date/day-number (yy mm dd) `(if (mhc-date/leap-year-p ,yy) (+ (aref '[0 0 31 60 91 121 152 182 213 244 274 305 335] ,mm) ,dd) (+ (aref '[0 0 31 59 90 120 151 181 212 243 273 304 334] ,mm) ,dd))) (defsubst mhc-date/absolute-from-epoch (yy mm dd) (let ((xx (1- yy))) (+ (mhc-date/day-number yy mm dd) (* xx 365) (/ xx 4) (/ xx -100) (/ xx 400) -719163))) (defsubst mhc-date/iso-week-days (yday wday) (- yday -3 (% (- yday wday -382) 7))) (defmacro mhc-date/substring-to-int (str pos) `(string-to-number (substring ,str (match-beginning ,pos) (match-end ,pos)))) ;; according to our current time zone, ;; convert timezone string into offset minutes ;; ;; for example, if current time zone is in Japan, ;; convert "GMT" or "+0000" into 540. (defun mhc-date/string-to-timezone-offset (timezone) (let ((tz (or (cdr (assoc timezone '(("PST" . "-0800") ("PDT" . "-0700") ("MST" . "-0700") ("MDT" . "-0600") ("CST" . "-0600") ("CDT" . "-0500") ("EST" . "-0500") ("EDT" . "-0400") ("AST" . "-0400") ("NST" . "-0300") ("UT" . "+0000") ("GMT" . "+0000") ("BST" . "+0100") ("MET" . "+0100") ("EET" . "+0200") ("JST" . "+0900")))) timezone)) min offset) (if (string-match "\\([-+]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)" tz) (progn (setq min (* (+ (* 60 (mhc-date/substring-to-int tz 2)) (mhc-date/substring-to-int tz 3)) (if (string= "+" (substring tz (match-beginning 1) (match-end 1))) 1 -1)) offset (- (/ (car (current-time-zone)) 60) min)))))) ;; ;; conversion. ;; (defsubst mhc-date-to-second (date) ;; It has workaround in case of 28 bit integer. (let (high low) (setq low (* (+ date (if (< (nth 0 (current-time-zone)) 0) 1 0)) 240) high (/ low 65536) low (* (% low 65536) 360) high (+ (* high 360) (/ low 65536)) low (% low 65536)) (list high low 0))) (defsubst mhc-date/to-list1 (date) (let ((lst (decode-time (mhc-date-to-second date)))) (list (nth 5 lst) (nth 4 lst) (nth 3 lst) (nth 6 lst)))) (defsubst mhc-date/to-list2 (date) (let (x b c d e w dom) (setq w (% (+ date 25568) 7) date (+ date 2440588) x (floor (/ (- date 1867216.25) 36524.25)) b (- (+ date 1525 x) (floor (/ x 4.0))) c (floor (/ (- b 122.1) 365.25)) d (floor (* 365.25 c)) e (floor (/ (- b d) 30.6001)) dom (- b d (floor (* 30.6001 e)))) (if (<= e 13) (list (- c 4716) (1- e) dom w) (list (- c 4715) (- e 13) dom w)))) (defsubst mhc-date-to-list (date) (if (and (<= 0 date) (<= date 24837)) (mhc-date/to-list1 date) (mhc-date/to-list2 date))) ;; ;; constructor. ;; ;; All constructors emit error signal if args are illegal. ;; In case called with noerror is t, return nil quietly. ;; new from 3 digits. (defsubst mhc-date-new (yy mm dd &optional noerror) (if (mhc-date/check yy mm dd) (mhc-date/absolute-from-epoch yy mm dd) (if noerror nil (error "mhc-date-new: arg error (%s,%s,%s)" yy mm dd)))) ;; new from emacs style time such as (14654 3252 689999). (defsubst mhc-date-new-from-second (&optional second) (let ((now (decode-time (or second (current-time))))) (mhc-date/absolute-from-epoch (nth 5 now) (nth 4 now) (nth 3 now)))) ;; new from current time. (defalias 'mhc-date-now 'mhc-date-new-from-second) ;; new from string. 19990101 (defsubst mhc-date-new-from-string (str &optional noerror) (let (ret (match (match-data))) (if (string-match "^\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)$" str) (setq ret (mhc-date-new (mhc-date/substring-to-int str 1) (mhc-date/substring-to-int str 2) (mhc-date/substring-to-int str 3) t))) (store-match-data match) (if (or noerror ret) ret (error "mhc-date-new-from-string: format error (%s)" str)))) ;; new from string. [[yyyy/]mm]/dd (defsubst mhc-date-new-from-string2 (str &optional base-date noerror) (mhc-date-let (or base-date (mhc-date-now)) (let ((match (match-data)) fail ret) (cond ((string-match "^\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)$" str) (setq yy (mhc-date/substring-to-int str 1) mm (mhc-date/substring-to-int str 2) dd (mhc-date/substring-to-int str 3))) ((string-match "^\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)$" str) (setq yy (mhc-date/substring-to-int str 1) mm (mhc-date/substring-to-int str 2) dd (mhc-date/substring-to-int str 3))) ((string-match "^\\([0-9]+\\)/\\([0-9]+\\)$" str) (setq mm (mhc-date/substring-to-int str 1) dd (mhc-date/substring-to-int str 2))) ((string-match "^\\([0-9]+\\)$" str) (setq dd (mhc-date/substring-to-int str 1))) (t (setq fail t))) (store-match-data match) (if (not fail) (setq ret (mhc-date-new yy mm dd t))) (if (or noerror ret) ret (error "mhc-date-new-from-string2: format error (%s)" str))))) ;; regexp for rfc822 Date: field. (defconst mhc-date/rfc822-date-regex ;; assuming ``Tue, 9 May 2000 12:15:12 -0700 (PDT)'' (concat "\\([0-9]+\\)[ \t]+" ;; day "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|" ;; "Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ \t]+" ;; month "\\([0-9]+\\)[ \t]+" ;; year "\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?[ \t]*" ;; hh:mm(:ss)? "\\([A-Z][A-Z][A-Z]\\|[-+][0-9][0-9][0-9][0-9]\\)" ;; JST or +0900 )) ;; new from rfc822 Date: field. (defun mhc-date-new-from-string3 (string) (if (and (stringp string) (string-match mhc-date/rfc822-date-regex string)) (let ((dd (mhc-date/substring-to-int string 1)) (mm nil) (mon (substring string (match-beginning 2) (match-end 2))) (yy (mhc-date/substring-to-int string 3)) (MM (+ (* 60 (mhc-date/substring-to-int string 4)) (mhc-date/substring-to-int string 5))) (tz (substring string (match-beginning 8) (match-end 8))) tz-offset) (setq yy (cond ((< yy 50) (+ yy 2000)) ((< yy 100) (+ yy 1900)) (t yy)) mm (1+ (/ (string-match mon "JanFebMarAprMayJunJulAugSepOctNovDec") 3)) tz-offset (mhc-date/string-to-timezone-offset tz) MM (+ MM tz-offset)) (car (cond ((< MM 0) (setq MM (+ MM 1440)) (list (mhc-date-- (mhc-date-new yy mm dd)) (mhc-time-new (/ MM 60) (% MM 60)) tz-offset)) ((>= MM 1440) (setq MM (- MM 1440)) (list (mhc-date++ (mhc-date-new yy mm dd)) (mhc-time-new (/ MM 60) (% MM 60)) tz-offset)) (t (list (mhc-date-new yy mm dd) (mhc-time-new (/ MM 60) (% MM 60)) tz-offset))))))) ;; ;; manipulate yy, mm, dd. ;; (defmacro mhc-date-yy (date) `(nth 0 (mhc-date-to-list ,date))) (defmacro mhc-date-mm (date) `(nth 1 (mhc-date-to-list ,date))) (defmacro mhc-date-dd (date) `(nth 2 (mhc-date-to-list ,date))) (defmacro mhc-date-ww (date) `(nth 3 (mhc-date-to-list ,date))) (defmacro mhc-date-oo (date) `(/ (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))))) ;; ;; compare. ;; (defalias 'mhc-date= '= ) (defalias 'mhc-date< '< ) (defalias 'mhc-date<= '<= ) (defalias 'mhc-date> '> ) (defalias 'mhc-date>= '>= ) (defalias 'mhc-date-max 'max) (defalias 'mhc-date-min 'min) (defmacro mhc-date-sort (date-list) `(sort ,date-list (function mhc-date<))) (defsubst mhc-date-yy= (d1 d2) (= (mhc-date-yy d1) (mhc-date-yy d2))) (defsubst mhc-date-yy< (d1 d2) (< (mhc-date-yy d1) (mhc-date-yy d2))) (defsubst mhc-date-yy<= (d1 d2) (<= (mhc-date-yy d1) (mhc-date-yy d2))) (defsubst mhc-date-yy> (d1 d2) (mhc-date-yy< d2 d1)) (defsubst mhc-date-yy>= (d1 d2) (mhc-date-yy<= d2 d1)) (defsubst mhc-date-yymm= (d1 d2) (and (mhc-date-yy= d1 d2) (= (mhc-date-mm d1) (mhc-date-mm d2)))) (defsubst mhc-date-yymm< (d1 d2) (or (mhc-date-yy< d1 d2) (and (mhc-date-yy= d1 d2) (< (mhc-date-mm d1) (mhc-date-mm d2))))) (defmacro mhc-date-yymm> (d1 d2) `(mhc-date-yymm< ,d2 ,d1)) (defmacro mhc-date-yymm<= (d1 d2) `(not (mhc-date-yymm> ,d1 ,d2))) (defmacro mhc-date-yymm>= (d1 d2) `(mhc-date-yymm<= ,d2 ,d1)) ;; ;; increment, decrement. ;; (defalias 'mhc-date+ '+ ) (defalias 'mhc-date- '- ) (defalias 'mhc-date++ '1+) (defalias 'mhc-date-- '1-) (defsubst mhc-date-mm+ (date c) (mhc-date-let date (let (xx pp) (setq xx (+ mm c)) (setq pp (if (< 0 xx ) (/ (- xx 1) 12) (/ (- xx 12) 12))) (setq yy (+ yy pp) mm (- xx (* 12 pp))) (if (mhc-date/check yy mm dd) (mhc-date-new yy mm dd) (mhc-date-new yy mm (mhc-date/last-day-of-month yy mm)))))) (defmacro mhc-date-mm- (date c) `(mhc-date-mm+ ,date (- ,c))) (defmacro mhc-date-mm++ (date) `(mhc-date-mm+ ,date 1)) (defmacro mhc-date-mm-- (date) `(mhc-date-mm- ,date 1)) (defsubst mhc-date-yy+ (date c) (mhc-date-let date (setq yy (+ yy c)) (if (mhc-date/check yy mm dd) (mhc-date-new yy mm dd) (mhc-date-new yy mm (mhc-date/last-day-of-month yy mm))))) (defmacro mhc-date-yy- (date c) `(mhc-date-yy+ ,date (- ,c))) (defmacro mhc-date-yy++ (date) `(mhc-date-yy+ ,date 1)) (defmacro mhc-date-yy-- (date) `(mhc-date-yy- ,date 1)) ;; ;; get meaninful date. ;; (defmacro mhc-date-mm-first (date) "Return the number of days since 1970/01/01 to the first day of month, DATE." `(mhc-date-let ,date (mhc-date-new yy mm 1 t))) (defmacro mhc-date-mm-last (date) "Return the number of days since 1970/01/01 to the last day of month, DATE." `(mhc-date-let ,date (mhc-date-new yy mm (mhc-date/last-day-of-month yy mm) t))) (defun mhc-date-ww-first (date &optional wkst) "Return the first day of week immediate before DATE. WKST specifies start day of week (0:Sunday...6:Saturday). If WKST is not specified, 0 (Sunday) is used." (setq wkst (or wkst 0)) (mhc-date- date (mod (- (mhc-date-ww date) wkst) 7))) (defun mhc-date-ww-last (date &optional wkst) "Return the last day of week immediate after DATE. WKST specifies start day of week (0:Sunday...6:Saturday). If WKST is not specified, 0 (Sunday) is used." (mhc-date+ (mhc-date-ww-first date wkst) 6)) ;; ;; predicate ;; ;; check if the date is in the last week of a month. (defsubst mhc-date-oo-last-p (date) (< (- (mhc-date/last-day-of-month (mhc-date-yy date) (mhc-date-mm date)) 7) (mhc-date-dd date))) (defalias 'mhc-date-p 'integerp) ;; ;; miscellaneous. ;; (defmacro mhc-end-day-of-week () `(nth mhc-start-day-of-week '(6 0 1 2 3 4 5))) ;; ;; to string. ;; ;; (mhc-date-format date "%04d%02d%02d" yy mm dd) (defmacro mhc-date-format (date format &rest vars) `(mhc-date-let ,date (format ,format ,@vars))) (defun mhc-date-digit-to-mm-string (mm &optional long) (if long (aref '[nil "January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December"] mm) (aref [nil "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] mm))) (defun mhc-date-digit-to-ww-string (ww &optional long) (if long (aref ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"] ww) (aref ["Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"] ww))) (defun mhc-date-digit-to-ww-japanese-string (ww &optional long) (if long (aref ["日曜日" "月曜日" "火曜日" "水曜日" "木曜日" "金曜日" "土曜日"] ww) (aref ["日" "月" "火" "水" "木" "金" "土"] ww))) (defun mhc-date-digit-to-oo-string (oo &optional long) (aref ["1st" "2nd" "3rd" "4th" "5th"] oo)) ;; format-time-string subset (but has enough spec) (defun mhc-date-format-time-string (format date) (mhc-date-let date (let (head match (ret "") char) (while (string-match "%." format) (setq head (substring format 0 (match-beginning 0)) match (match-string 0 format) format (substring format (match-end 0)) char (aref match 1)) (cond ((eq char ?Y) ;; 100年単位の年 (setq match (format "%d" yy))) ((eq char ?y) ;; 年の下2桁 (00-99) (setq match (format "%02d" (% yy 100)))) ((or (eq char ?b) (eq char ?h)) ;; 月 略称 (setq match (mhc-date-digit-to-mm-string mm))) ((eq char ?B) ;; 月 名称 (setq match (mhc-date-digit-to-mm-string mm t))) ((eq char ?m) ;; 月 (01-12) (setq match (format "%02d" mm))) ((eq char ?d) ;; 日 (ゼロ padding) (setq match (format "%02d" dd))) ((eq char ?e) ;; 日 (空白 padding) (setq match (format "%2d" dd))) ((eq char ?a) ;; 曜日 略称 (setq match (mhc-date-digit-to-ww-string ww))) ((eq char ?A) ;; 曜日 名称 (setq match (mhc-date-digit-to-ww-string ww t)))) (setq ret (concat ret head match))) (concat ret format)))) (provide 'mhc-date) ;;; 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-date.el ends here. mhc-1.1.1/emacs/mhc-day.el000066400000000000000000000120621262546231500152240ustar00rootroot00000000000000;;; -*- mode: Emacs-Lisp; coding: utf-8 -*- ;; Author: Yoshinari Nomura , ;; TSUCHIYA Masatoshi ;; 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. mhc-1.1.1/emacs/mhc-db.el000066400000000000000000000142741262546231500150430ustar00rootroot00000000000000;;; -*- mode: Emacs-Lisp; coding: utf-8 -*- ;; Author: Yoshinari Nomura , ;; TSUCHIYA Masatoshi ;; 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) 10))) (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 :recurrence_tag)) 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. mhc-1.1.1/emacs/mhc-draft.el000066400000000000000000000237221262546231500155540ustar00rootroot00000000000000;;; mhc-draft.el --- Draft modules for MHC. ;; Author: Yoshinari Nomura , ;; Yuuichi Teranishi ;; Created: 2000/07/25 ;; Revised: $Date: 2008/07/04 06:01:20 $ ;;; Commentary: ;; This file is a part of MHC, includes functions for draft. ;;; 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) (defun mhc-draft-setup-new () "Setup new draft (Insert header separator, etc)." (let ((sep-regexp (format "\n\\(%s\\)?\n" (regexp-quote mail-header-separator))) (sep (concat "\n" mail-header-separator "\n"))) (save-excursion (goto-char (point-min)) (if (re-search-forward sep-regexp nil t) (replace-match sep) (goto-char (point-max)) (unless (bolp) (insert "\n")) (insert mail-header-separator "\n"))))) (defun mhc-draft-new (&optional template preset-fields) "Prepare new mhc-draft buffer. If TEMPLATE is a string or buffer, it is used for a new draft. If PRESET-FIELDS is a list of cons-cell like: ((header-name . value) ...), these fields are set to the draft after import TEMPLATE." (interactive) (let ((draft-buffer (generate-new-buffer mhc-draft-buffer-name))) (with-current-buffer draft-buffer ;; insert template (cond ((bufferp template) (insert-buffer-substring-no-properties template)) ((stringp template) (insert template))) ;; insert header separator (mhc-draft-setup-new) (mhc-draft-delete-garbage-headers) (mhc-draft-setup-headers preset-fields) (mhc-draft-mode) (switch-to-buffer draft-buffer t) (goto-char (point-min))))) (defvar mhc-draft-template) (defun mhc-draft-store-template (template) "Store common draft template to TEMPLATE." (setq mhc-draft-template template)) (defun mhc-draft-template () "Get common draft template." mhc-draft-template) (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." (unless (eq (current-buffer) buffer) (erase-buffer) (insert-buffer-substring buffer)) (mhc-header-narrowing (mhc-header-delete-header "^\\(Content-.*\\|Mime-Version\\|User-Agent\\):" 'regexp)) (mhc-header-decode-ewords) (goto-char (point-min)) (when (re-search-forward "^\r?$" nil t) (insert mail-header-separator))) (defsubst mhc-draft-reedit-file (filename) "Restore contents of file FILENAME as draft in the current buffer." (erase-buffer) (mhc-insert-file-contents-as-coding-system mhc-default-coding-system filename) (mhc-draft-reedit-buffer (current-buffer) 'original)) (defsubst mhc-draft-translate () "Convert an article in the current buffer to an ENCODED one. ENCODED article should be valid for storeing to a mhc file." (save-excursion (goto-char (point-min)) (when (search-forward (concat "\n" mail-header-separator "\n") nil t) (replace-match "\n\n")))) (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-remove-tailers () (save-excursion (goto-char (point-max)) (if (re-search-backward (regexp-quote mhc-message-end-of-messge-marker) (- (point) (length mhc-message-end-of-messge-marker)) t) (replace-match "")) (unless (bolp) (insert "\n")))) (defun mhc-draft-delete-garbage-headers () (mhc-header-narrowing (mhc-header-delete-header (concat "^\\(" (mhc-regexp-opt mhc-draft-unuse-hdr-list) "\\)") 'regexp))) (defun mhc-draft-setup-headers (&optional headers-values) "Put X-SC-* headers to draft. HEADERS-VALUES is a list of cons-cell like: ((header-name . value) ...)." (let ((xsc-headers (mapcar (lambda (v) (downcase (substring v 0 -1))) (mhc-header-list))) (item)) (mhc-header-narrowing (mapc (lambda (xsc) (if (setq item (assoc xsc headers-values)) (mhc-header-put-value xsc (or (cdr item) "")) (unless (mhc-header-get-value xsc) (mhc-header-put-value xsc "")))) xsc-headers)))) (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 mhc-1.1.1/emacs/mhc-e21.el000066400000000000000000000140741262546231500150430ustar00rootroot00000000000000;;; mhc-e21.el -- Emacs 21 stuff for MHC. ;; Author: Yuuichi Teranishi ;; ;; Created: 2000/11/21 ;; Revised: $Date: 2008/03/06 09:40:12 $ (defcustom mhc-e21-icon-alist '(("Conflict" . "Conflict.xpm") ("Recurrence" . "Recurrence.xpm") ("Private" . "Private.xpm") ("Holiday" . "Holiday.xpm") ("Todo" . "CheckBox.xpm") ("Done" . "CheckedBox.xpm") ("Link" . "Link.xpm")) "*Alist to define icons. Each element should have the form (NAME . ICON-FILE) It defines icon named NAME created from ICON-FILE. Example: '((\"Holiday\" . \"Holiday.xpm\") (\"Work\" . \"Business.xpm\") (\"Private\" . \"Private.xpm\") (\"Anniversary\" . \"Anniversary.xpm\") (\"Birthday\" . \"Birthday.xpm\") (\"Other\" . \"Other.xpm\") (\"Todo\" . \"CheckBox.xpm\") (\"Done\" . \"CheckedBox.xpm\") (\"Conflict\" . \"Conflict.xpm\"))" :group 'mhc :type '(repeat :inline t (cons (string :tag "Icon Name") (string :tag "XPM File Name")))) (defcustom mhc-icon-function-alist '(("Link" . mhc-browse-x-url)) "*Alist to define callback function for icons. Each element should have the form (NAME . FUNCTION) If the icon named NAME is clicked, then FUNCTION is invoked at icon line." :group 'mhc :type '(repeat :inline t (cons (string :tag "Icon Name") (function :tag "Function")))) (defvar mhc-e21-icon-keymap nil) (if (null mhc-e21-icon-keymap) (setq mhc-e21-icon-keymap (make-sparse-keymap))) (define-key mhc-e21-icon-keymap [mouse-1] 'mhc-e21-icon-call-function) (define-key mhc-e21-icon-keymap [mouse-2] 'mhc-e21-icon-call-function) (defun mhc-e21-icon-call-function (event) (interactive "e") (save-excursion (mouse-set-point event) (when (get-text-property (point) 'mhc-e21-icon-function) (call-interactively (get-text-property (point) 'mhc-e21-icon-function)) t))) ;; internal variable. (defvar mhc-e21/icon-glyph-alist nil) (defvar mhc-e21/icon-function-alist nil) (defsubst mhc-e21/setup-icons () (let ((alist mhc-e21-icon-alist) name image (load-path (cons mhc-icon-path load-path))) (setq mhc-e21/icon-glyph-alist nil) (while alist (setq image (find-image (list (list :type 'xpm :file (cdr (car alist)) :ascent 'center)))) (when image (setq mhc-e21/icon-glyph-alist (cons (cons (downcase (car (car alist))) image) mhc-e21/icon-glyph-alist))) (setq alist (cdr alist))) (setq mhc-e21/icon-function-alist (mapcar (lambda (pair) (cons (downcase (car pair)) (cdr pair))) mhc-icon-function-alist)))) ;; Icon interface (defun mhc-icon-setup () "Initialize MHC icons." (interactive) (if (called-interactively-p 'interactive) (setq mhc-e21/icon-glyph-alist nil)) (or mhc-e21/icon-glyph-alist (progn (message "Initializing MHC icons...") (mhc-e21/setup-icons) (run-hooks 'mhc-icon-setup-hook) (message "Initializing MHC icons...done")))) (defun mhc-use-icon-p () "Returns t if MHC displays icon." (and (display-graphic-p) (image-type-available-p 'xpm) mhc-use-icon)) (defun mhc-icon-exists-p (name) "Returns non-nil if icon with NAME exists." (cdr (assoc (downcase name) mhc-e21/icon-glyph-alist))) (defun mhc-put-icon (icons) "Put ICONS on current buffer. Icon is decided by `mhc-e21-icon-alist'." (let (icon pos func props) (while icons (when (setq icon (cdr (assoc (downcase (car icons)) mhc-e21/icon-glyph-alist))) (setq pos (point)) (insert (make-string (floor (car (image-size icon))) ? )) (setq props (list 'display icon 'invisible nil 'intangible icon)) (when (setq func (cdr (assoc (downcase (car icons)) mhc-e21/icon-function-alist))) (setq props (nconc props (list 'mouse-face 'highlight 'mhc-e21-icon-function func 'local-map mhc-e21-icon-keymap)))) (add-text-properties pos (point) props)) (setq icons (cdr icons))))) (provide 'mhc-e21) ;;; 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-e21.el ends here mhc-1.1.1/emacs/mhc-face.el000066400000000000000000000244251262546231500153530ustar00rootroot00000000000000;;; mhc-face.el ;; Author: Yoshinari Nomura ;; ;; Created: 2000/02/08 ;; Revised: $Date: 2004/05/04 13:48:31 $ ;;; ;;; Commentay: ;;; ;;; ;;; Code: ;;; (defvar mhc-symbol-face-alist nil "*Alist which is used in setup time to define required faces. Each element should have the form (FACE-SYMBOL . (PARENT FG BG UNDERLINED FONT STIPPLE)) If this variable does't have necessary face definitions for mhc, mhc will lookup them from mhc-symbol-face-alist-internal instead. So, this variable doesn't have to cover all the face definitions.") (defvar mhc-category-face-alist nil "*Alist to rule the catgegory-to-face conversion. Each element should have the form (CATEGORY-STRING . (PARENT FG BG UNDERLINED FONT STIPPLE)) mhc will define mhc-summary-category-face-(downcase CATEGORY-STRING) in setup time.") (defvar mhc-calendar-hnf-face-alist nil "*Alist of HNS faces. Each element should have the form (FACE-SYMBOL . (PARENT FG BG UNDERLINED FONT STIPPLE)). refer to mhc-calendar-hnf-face-alist-internal.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Message faces. (defvar mhc-message-face-eof-marker 'mhc-message-face-eof-marker) (defvar mhc-message-face-subject 'mhc-message-face-subject) (defface mhc-message-face-eof-marker '((((class color) (background dark)) (:background "aquamarine2")) (((class color) (background light)) (:background "aquamarine2")) (t ())) "*Face used by mhc-message-eof-marker." :group 'mhc-faces) (defface mhc-message-face-subject '((((class color) (background dark)) (:foreground "OrangeRed" :bold t)) (((class color) (background light)) (:foreground "Firebrick" :bold t)) (t ())) "*Face used by mhc-message-subject." :group 'mhc-faces) (defvar mhc-message-font-lock-keywords '(("\\([12][0-9][0-9][0-9]\\)\\([0-1][0-9]\\)\\([0-3][0-9]\\)" (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\\):\\)" (1 font-lock-keyword-face)) ("\\(\\[End of message\\]\\)" (1 mhc-message-face-eof-marker)) ("\\(X-SC-Subject:\\) *\\(.*\\)" (1 font-lock-keyword-face) (2 mhc-message-face-subject)) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; for necessary faces. (defconst mhc-symbol-face-alist-internal '((mhc-calendar-face-default . (nil nil nil)) (mhc-calendar-face-saturday . (nil "blue" nil)) (mhc-calendar-face-sunday . (nil "red" nil)) (mhc-calendar-face-duration . (nil nil "gray")) (mhc-calendar-face-cw . (nil "slate gray" nil)) ;; (mhc-summary-face-default . (nil nil nil)) (mhc-summary-face-saturday . (nil "blue" nil)) (mhc-summary-face-sunday . (nil "red" nil)) (mhc-summary-face-today . (nil "black" "chocolate")) (mhc-summary-face-cw . (nil "slate gray" nil)) ;; (mhc-summary-face-separator . (nil "gray" nil)) (mhc-summary-face-month-separator . (nil "DarkKhaki" nil)) (mhc-summary-face-time . (nil "yellowgreen" nil)) (mhc-summary-face-location . (nil "black" "paleturquoise")) (mhc-summary-face-conflict . (nil "white" "purple")) (mhc-summary-face-recurrence . (nil "black" "green")) (mhc-summary-face-secret . (nil "gray" nil)) ;; (mhc-minibuf-face-candidate . (nil nil "yellow")) ;; (mhc-category-face-holiday . (nil "red" nil)))) (defconst mhc-calendar-hnf-face-alist-internal '((mhc-calendar-hnf-face-mark . (nil "MediumSeaGreen" nil)) (mhc-calendar-hnf-face-newtag . (italic "red" "paleturquoise")) (mhc-calendar-hnf-face-subtag . (italic "blue" nil)) (mhc-calendar-hnf-face-cat . (nil "DarkGreen" nil)) (mhc-calendar-hnf-face-new . (bold "DarkGreen" nil)) (mhc-calendar-hnf-face-sub . (nil "DarkGreen" nil)) (mhc-calendar-hnf-face-uri . (italic "blue" nil)))) (defmacro mhc-face-put (symbol face) `(put-text-property 0 (length ,symbol) 'face ,face ,symbol)) (eval-when-compile (cond ((featurep 'xemacs) ;; XEmacs 21.2 (make-face-bold FACE &optional LOCALE TAGS) ;; XEmacs 21.1 (make-face-bold FACE &optional LOCALE) (defmacro mhc-face/make-face-bold (face) `(make-face-bold ,face)) (defmacro mhc-face/make-face-italic (face) `(make-face-italic ,face)) (defmacro mhc-face/make-face-bold-italic (face) `(make-face-bold-italic ,face))) (t ;; (make-face-bold FACE &optional FRAME NOERROR) (defmacro mhc-face/make-face-bold (face) `(make-face-bold ,face nil t)) (defmacro mhc-face/make-face-italic (face) `(make-face-italic ,face nil t)) (defmacro mhc-face/make-face-bold-italic (face) `(make-face-bold-italic ,face nil t))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; make faces from string/symbol (defun mhc-face-category-to-face (category) (if category (or (intern-soft (format "mhc-category-face-%s" (downcase category))) 'default) 'default)) (defun mhc-face-make-face-from-string (string prop &optional overwrite prefix) (let ((symbol-name (concat prefix (if prefix "-") string))) (mhc-face-make-face-from-symbol (intern symbol-name) prop overwrite))) (defun mhc-face-make-face-from-symbol (symbol prop &optional overwrite) (let ((parent (nth 0 prop)) (fg (nth 1 prop)) (bg (nth 2 prop)) (uline (nth 3 prop)) (font (nth 4 prop)) (stipple (nth 5 prop)) (face nil)) (if (and (facep symbol) (not overwrite)) symbol (setq face (if parent (copy-face parent symbol) (make-face symbol))) (if fg (set-face-foreground face fg)) (if bg (set-face-background face bg)) (set-face-underline face uline) (if font (set-face-font face font)) (if stipple (set-face-stipple face stipple)) face))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; make faces arrange. (defvar mhc-face-effect-alist ;; fg bg bold talic ul '((today . (nil "gray" nil nil nil)) (busy . (nil nil t nil nil)) (saturday . ("Blue" nil nil nil nil)) (sunday . ("Red" nil nil nil nil)))) ;; get decolated face from face and effect ;; ex. mhc-summary-face + today -> mhc-summary-face-today (defun mhc-face-get-effect (face effect) (let ((new-face (intern (concat (symbol-name face) "-" (symbol-name effect)))) effect-list) (if (facep new-face) () (copy-face face new-face) (if (setq effect-list (cdr (assq effect mhc-face-effect-alist))) (let ((fg (nth 0 effect-list)) (bg (nth 1 effect-list)) (bl (nth 2 effect-list)) (it (nth 3 effect-list)) (ul (nth 4 effect-list))) (if fg (set-face-foreground new-face fg)) (if bg (set-face-background new-face bg)) (if ul (set-face-underline new-face t)) ;; (if bl (or (mhc-face/make-face-bold new-face) (and (fboundp 'set-face-bold-p) (set-face-bold-p new-face t)))) ;; (if it (or (mhc-face/make-face-italic new-face) (and (fboundp 'set-face-italic-p) (set-face-italic-p new-face t))))))) new-face)) ;; ;; (make-face-italic new-face nil t)))) (defsubst mhc-face-get-today-face (face) (mhc-face-get-effect face 'today)) (defsubst mhc-face-get-busy-face (face) (mhc-face-get-effect face 'busy)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; setup faces. (defun mhc-face-setup () (interactive) (let ((ow (called-interactively-p 'interactive))) ;; (mhc-face-setup-internal mhc-symbol-face-alist ow) (mhc-face-setup-internal mhc-category-face-alist ow) ;; (mhc-face-setup-internal mhc-symbol-face-alist-internal nil) )) (defun mhc-face-setup-internal (alist &optional overwrite) (let (lst) (while (setq lst (car alist)) (cond ((stringp (car lst)) (mhc-face-make-face-from-string (format "mhc-category-face-%s" (downcase (car lst))) (cdr lst) overwrite)) ((symbolp (car lst)) (mhc-face-make-face-from-symbol (car lst) (cdr lst) overwrite))) (setq alist (cdr alist))))) (provide 'mhc-face) ;;; 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-face.el ends here mhc-1.1.1/emacs/mhc-file.el000066400000000000000000000200211262546231500153600ustar00rootroot00000000000000;;; -*- mode: Emacs-Lisp; coding: utf-8 -*- ;; Author: Yoshinari Nomura , ;; TSUCHIYA Masatoshi ;; Created: 2000/05/01 ;; Revised: $Date$ ;;; Comments: ;; This file is a part of MHC, and includes functions to manipulate ;; files of schedules. ;;; About Backend: ;; このライブラリは、実際にファイルを操作するバックエンドを呼び出すこ ;; とによって動作する。バックエンドは、以下のようなメソッドを提供する ;; ことが期待されている。 ;; ;; (mhc-foo/init) ;; ネットワークの状態に依存しない初期化処理を行う関数 ;; ;; (mhc-foo/exit) ;; ネットワークの状態に依存しない終了処理を行う関数 ;; ;; (mhc-foo/open &optional OFFLINE) ;; ネットワークの状態に依存する初期化処理を行う関数 ;; ;; (mhc-foo/close &optional OFFLINE) ;; ネットワークの状態に依存する終了処理を行う関数 ;; ;; (mhc-foo/sync) ;; スケジュールファイルの同期を取る関数 ;; ;; (mhc-foo/add FILENAME &optional OFFLINE) ;; ファイルを追加を通知する関数 ;; (ファイルの実体は追加された後に呼び出される) ;; ;; (mhc-foo/modify FILENAME &optional OFFLINE) ;; ファイルの変更を通知する関数 ;; (ファイルの実体が変更された後に呼び出される) ;; ;; (mhc-foo/remove FILENAME &optional OFFLINE) ;; ファイルを削除する関数 ;; (ファイルの実体は *削除されずに* 呼び出される) ;; ;; これらのメソッドを適切に定義し、更に以下のような宣言を付け加える。 ;; ;; (provide 'mhc-foo) ;; (put 'mhc-foo 'init 'mhc-foo/init) ;; (put 'mhc-foo 'exit 'mhc-foo/exit) ;; (put 'mhc-foo 'open 'mhc-foo/open) ;; (put 'mhc-foo 'close 'mhc-foo/close) ;; (put 'mhc-foo 'sync 'mhc-foo/sync) ;; (put 'mhc-foo 'add 'mhc-foo/add) ;; (put 'mhc-foo 'modify 'mhc-foo/modify) ;; (put 'mhc-foo 'remove 'mhc-foo/remove) ;; ;; メソッドの関数名は任意に選ぶことができる。 ;; ;; また、メソッドの定義は省略することができる。省略されたメソッドは、 ;; 関数 mhc-file/true によって置換され、その処理は常に成功したものと見 ;; なされる。 ;;; Definition (require 'mhc-compat) (require 'mhc-vars) ;;; Code: ;;; Global Variables (defcustom mhc-file-method 'mhc-sync "*Variable to specify the method to control schdule files." :group 'mhc :type '(radio (const :tag "Backup and remove" mhc-sync) (symbol :tag "Other"))) (defcustom mhc-file-sync-enable-offline nil "*If non-nil, enable mhc-file-sync when status is offline." :group 'mhc :type '(radio (const :tag "Disable when offline" nil) (const :tag "Enable when offline" t))) ;;; Internal Variables (defvar mhc-file/offline (not mhc-default-network-status) "Keep current line status.") ;;; Codes (defun mhc-file/true (&rest arguments) "Dummy function for undefind backend functions." t) (defconst mhc-file/backend-method-list '(init exit open close sync add modify remove)) ;; To suprress byte compile warnings. (eval-when-compile (mapcar (lambda (s) (let ((f (intern (concat "mhc-file/" (symbol-name s))))) (or (fboundp f) (fset f 'mhc-file/true)))) mhc-file/backend-method-list)) (defun mhc-file-setup (&optional method) "Initialize backend to manipulate files." (require (or method mhc-file-method)) (mapc (lambda (s) (fset (intern (concat "mhc-file/" (symbol-name s))) (or (get mhc-file-method s) 'mhc-file/true))) mhc-file/backend-method-list) (and (mhc-file/init) (mhc-file/open mhc-file/offline))) (defun mhc-file-exit () "Exit backend to manipulate files." (and (mhc-file/close mhc-file/offline) (mhc-file/exit))) (defmacro mhc-file-add (file) `(mhc-file/add ,file mhc-file/offline)) (defmacro mhc-file-modify (file) `(mhc-file/modify ,file mhc-file/offline)) (defmacro mhc-file-remove (file) `(mhc-file/remove ,file mhc-file/offline)) (defcustom mhc-file-line-status-strings '(" mhc[offline]" . " mhc[ONLINE]") "Strings to describe MHC network status." :group 'mhc :type '(choice (const :tag "Long format" (" mhc[offline]" . " mhc[ONLINE]")) (const :tag "Short format" (" Mhc" . " MHC")) (cons :tag "User definition" (string :tag "String for offline") (string :tag "String for online"))) :set (lambda (symbol value) (set-default symbol value) (if (assq 'mhc-mode minor-mode-alist) (setcdr (assq 'mhc-mode minor-mode-alist) (list (mhc-file-line-status)))) (force-mode-line-update))) (defun mhc-file-line-status () "Return status string for mode line." (if mhc-show-network-status (if mhc-file/offline (car mhc-file-line-status-strings) (cdr mhc-file-line-status-strings)))) (defun mhc-file-toggle-offline (&optional full set-to no-sync) "*Toggle line status of file manipulation backend." (interactive (list current-prefix-arg (not mhc-file/offline))) (let ((previous mhc-file/offline)) (setq mhc-file/offline set-to) (if (assq 'mhc-mode minor-mode-alist) (setcdr (assq 'mhc-mode minor-mode-alist) (list (mhc-file-line-status)))) (if mhc-file/offline (message "mhc-file is offline.") (if (and (not no-sync) previous (y-or-n-p "Sync schedule files right now ? ")) (mhc-file-sync full)) (message "mhc-file is online.")))) (defun mhc-file-sync (&optional full) "*Sync schedule files." (interactive "P") (if (and mhc-file/offline (not mhc-file-sync-enable-offline)) (message "\"M-x mhc-file-toggle-offline\" first.") (message "mhc file sync...") (when (mhc-file/sync full) (message "mhc file sync...done")))) ;; almost same as (make-directory dirname t) (defun mhc-file-make-directory (dirname) (if (file-directory-p dirname) t (if (mhc-file-make-directory (directory-file-name (file-name-directory (directory-file-name dirname)))) (progn (make-directory (directory-file-name dirname)) (mhc-file-add (file-name-as-directory dirname)) t)))) (provide 'mhc-file) ;;; 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-file.el ends here mhc-1.1.1/emacs/mhc-guess.el000066400000000000000000000577751262546231500156210ustar00rootroot00000000000000;;; mhc-guess.el -- Guess the important date from a Japanese mail article. ;; Author: Yoshinari Nomura ;; ;; Created: 1999/04/13 ;; Revised: $Date: 2007/12/05 04:59:35 $ ;; ;;; ;;; Commentary: ;;; ;; ;; バッファから mhc-guess-{time,date}: 日付、時間を集めて、 ;; 予定の日付けを表わしていると思われる可能性の高い順に並べて ;; 返す。 ;; ;; 以下のような GUESS-CANDIDATE のリストを返す ;; ([mhc-{date,time} mhc-{date,time}-end point-begin point-end score]..) ;; ;; mhc-{date,time}: 予定の開始 {日, 時間} ;; mhc-{date,time}-end 予定の終了 {日, 時間} or nil ;; ;; 日付推測の手順 ;; ;; 1. 日付/時刻を表すキーワード見付けて、発見個所リストを作る。 ;; ;; (mhc-guess/gather-candidate mhc-guess-date-regexp-list now) ;; (mhc-guess/gather-candidate mhc-guess-time-regexp-list now) ;; ;; の 2つの関数で、 ;; ;; ([found-date found-date-end found-point-begin found-point-end nil] ...) ;; ([found-time found-time-end found-point-begin found-point-end nil] ...) ;; ;; のような candidate-list を得る。 ;; ;; 2. みつかった日付時刻に点数をつける。 ;; ;; (mhc-guess/score candidate-list mhc-guess-keyword-score-alist) ;; ;; ([found-date found-date-end found-point-begin found-point-end score] ...) ;; ;; キーワードが引用行中にある ;; 同一行に特定の文字列がある ;; ある範囲の前方/後方に特定の文字列がある ;; ;; のような条件と加点/減点を表す mhc-guess-keyword-score-alist に基 ;; づいて採点をする。 ;; ;; 3. 得点順 (得点が同じ場合は，日付や時間を表わす文字列が長い順) ;; に sort して返す ;;; ;;; Code: ;;; (require 'mhc-date) (provide 'mhc-guess) ;;; Customize variables: (defcustom mhc-guess-ignore-english-date nil "*Ignore English dates." :group 'mhc :type '(choice (const :tag "Ignore" t) (const :tag "Don't Ignore" nil))) (defcustom mhc-guess-english-date-format '(usa) "*English date formats. You can specify following symbols as a list. usa: Suppose the USA style date formats. (e.g. Feb 25, 2004) british: Suppose British style date formats. (e.g. 25 Feb, 2004)" :group 'mhc :type '(repeat (choice (const :tag "USA" usa) (const :tag "British" british)))) ;; ;; regexp for get date strings. ;; (defvar mhc-guess-date-regexp-list `( (,(concat "\\([０-９0-9][０-９0-9][０-９0-9][０-９0-9]\\)[-−/／]" "\\([０-９0-9][０-９0-9]\\)[-−/／]" "\\([０-９0-9][０-９0-9]\\)") mhc-guess/make-date-from-yyyymmdd 1 2 3) (,(concat "\\([０-９0-9]+年\\)?" "\\([来今０-９0-9]+\\)[\n　 ]*月[\n 　]*の?[\n 　]*" "\\([０-９0-9]+\\)日?" "\\([（）()月火水木金土日曜\n 　 ]*" "\\([〜−，,、-]\\|から\\|より\\)[\n 　]*" "\\([０-９0-9]+年\\)?" "\\(\\([来今０-９0-9]+\\)[\n　 ]*月\\)?[\n 　]*の?[\n 　]*" "\\([０-９0-9]+\\)日?\\(間\\)?" "\\)?") mhc-guess/make-date-from-mmdd 2 3 8 9 10) (,(concat "\\([０-９0-9]+[　 ]*[／/][　 ]*\\)?" "\\([０-９0-9]+\\)[　 ]*[／/][　 ]*\\([０-９0-9]+\\)" "\\([（）()月火水木金土日曜\n 　 ]*" "\\([〜−，,、-]\\|から\\|より\\)[\n 　]*" "\\([０-９0-9]+[　 ]*[／/][　 ]*\\)?" "\\(\\([０-９0-9]+\\)[　 ]*[／/][　 ]*\\)" "\\([０-９0-9]+\\)日?\\(間\\)?" "\\)?") mhc-guess/make-date-from-mmdd 2 3 8 9 10) ;; USA style date format (,(concat "\\(Jan\\(uary\\)?\\|Feb\\(ruary\\)?\\|Mar\\(ch\\)?\\|" "Apr\\(il\\)?\\|May\\|June?\\|July?\\|Aug\\(ust\\)?\\|" "Sep\\(tember\\)?\\|Oct\\(ober\\)?\\|" "Nov\\(ember\\)?\\|Dec\\(ember\\)?\\)" "\.?,? +" "\\([0-9][0-9]?\\)\\(st\\|nd\\rd\\|th\\)?,?[ \n]+" ;; day "\\(\\('\\|[1-9][0-9]\\)?[0-9][0-9]\\)?") ;; year mhc-guess/make-date-from-usa-style-date 1 11 13) ;; British style date format (,(concat "\\([0-9][0-9]?\\)\\(st\\|nd\\rd\\|th\\)?,? " ;; day "\\(Jan\\(uary\\)?\\|Feb\\(ruary\\)?\\|Mar\\(ch\\)?\\|" "Apr\\(il\\)?\\|May\\|June?\\|July?\\|Aug\\(ust\\)?\\|" "Sep\\(tember\\)?\\|Oct\\(ober\\)?\\|" "Nov\\(ember\\)?\\|Dec\\(ember\\)?\\)" "\.?,?[ \n]+" "\\(\\('\\|[1-9][0-9]\\)?[0-9][0-9]\\)?") ;; year mhc-guess/make-date-from-british-style-date 1 3 13) throw (,(concat "\\(今度\\|[今来次]週\\|再来週\\)[\n 　]*の?[\n 　]*" "\\([月火水木金土日]\\)曜") mhc-guess/make-date-from-relative-week 1 2) (,(concat "\\([Tt]his\\|[Nn]ext\\)[\n ]+" "\\(Monday\\|Tuesday\\|Wednesday\\|Thursday\\|Friday\\|" "Saturday\\|Sunday\\)") mhc-guess/make-date-from-english-relative-week 2 1 nil) (,(concat "\\(Monday\\|Tuesday\\|Wednesday\\|Thursday\\|Friday\\|" "Saturday\\|Sunday\\)[\n ]+" "\\([Tt]his\\|[Nn]ext\\)[ \n]+\\([Ww]eek\\)") mhc-guess/make-date-from-english-relative-week 1 2 3) throw ("\\([０-９0-9]+\\)[\n 　]*日" mhc-guess/make-date-from-mmdd nil 1) ("\\([０-９0-9]+\\)[ 　]*[(（][月火水木金土日]" mhc-guess/make-date-from-mmdd nil 1) ("[^\(（]\\([月火水木金土日]\\)\n?曜" mhc-guess/make-date-from-relative-week nil 1) (,(concat "\\(Monday\\|Tuesday\\|Wednesday\\|Thursday\\|Friday\\|" "Saturday\\|Sunday\\)") mhc-guess/make-date-from-english-relative-week 1 nil nil) ("\\(本日\\|今日\\|あす\\|あした\\|あさって\\|明日\\|明後日\\)" mhc-guess/make-date-from-relative-day 1) (,(concat "\\([Tt]oday\\|[Tt]omorrow\\|" "[Tt]he[ \n]+[Dd]ay[ \n]+[Aa]fter[ \n]+[Tt]omorrow\\)") mhc-guess/make-date-from-english-relative-day 1) )) (defvar mhc-guess-time-regexp-list `( (,(concat "\\([０-９0-9]+\\) *[時] *\\([０-９0-9]+\\|半\\)?分?" "\\([\n 　]*\\([〜−-]\\|から\\|より\\)[\n 　午前後]*" "\\([０-９0-9]+\\) *[時]\\(間\\)? *\\([０-９0-9]+\\|半\\)?\\)?") mhc-guess/make-time-from-hhmm 1 2 5 7 6) (,(concat "\\([０-９0-9]+\\)[：:]\\([０-９0-9]+\\)" "\\([\n 　]*\\([〜−-]\\|から\\|より\\)[\n 　午前後]*" "\\([０-９0-9]+\\) *[：:時]\\(間\\)? *\\([０-９0-9]+\\|半\\)?\\)?") mhc-guess/make-time-from-hhmm 1 2 5 7 6) )) (defvar mhc-guess-location-list '() "*List of the regexps of the location, like this '(\"第?[0-9０-９〇-九]+応接室?\" \"第?[0-9０-９〇-九]+会議室[0-9０-９〇-九]?\"))") (defvar mhc-guess-location-regexp-list `( (,(concat "場[ 　]*所[ 　]*[：:]*[\n 　]*\\([^\n 　]+\\)") mhc-guess/make-location-from-string 1) (,(concat "於[ 　]*\\([^\n 　]+\\)") mhc-guess/make-location-from-string 1) (,(concat "[@＠][　 ]*\\([^\n　 .]+\\)[　 \n]") mhc-guess/make-location-from-string 1))) ;; keyword to score-alist: ;; each element consists of (regexp relative-boundary sameline? score) (defvar mhc-guess-keyword-score-alist '( ;; positive factor ("^[\t ]+" -200 t +5) ("次回" -200 nil +10) ("\\(期間\\|月日\\|日程\\|時間帯\\|日時\\|開始時間\\)" -150 nil +5) ("\\(期間\\|月日\\|日程\\|時間帯\\|日時\\|開始時間\\)[:：]" -150 t +5) ("\\(から\\|〜\\|変更\\|延期\\|順延\\|開始\\)" +80 nil +4) ;; negative factor ("\\(休み\\|除く\\|中止\\|までに\\)" +80 t -10) ("出欠" -80 nil -5) ("^\\(On\\|At\\|Date:\\) " -200 t -20) ("\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\)" -200 t -20) ("\\(Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)" -200 t -20) ("^\\([ a-zA-Z]*>\\)+ *" -200 t -15) )) (defvar mhc-guess/location-regexp-list nil) ;; ;; manipulate guess-candidate structure. ;; (defmacro mhc-guess-get-date (obj) `(aref ,obj 0)) (defmacro mhc-guess-get-time (obj) `(aref ,obj 0)) (defmacro mhc-guess-get-date-or-time (obj) `(aref ,obj 0)) (defmacro mhc-guess-get-date-end (obj) `(aref ,obj 1)) (defmacro mhc-guess-get-time-end (obj) `(aref ,obj 1)) (defmacro mhc-guess-get-date-or-time-end (obj) `(aref ,obj 1)) (defmacro mhc-guess-get-begin (obj) `(aref ,obj 2)) (defmacro mhc-guess-get-end (obj) `(aref ,obj 3)) (defmacro mhc-guess-get-score (obj) `(aref ,obj 4)) (defmacro mhc-guess-get-debug (obj) `(aref ,obj 5)) (defmacro mhc-guess-set-date (obj val) `(aset ,obj 0 ,val)) (defmacro mhc-guess-set-time (obj val) `(aset ,obj 0 ,val)) (defmacro mhc-guess-set-date-end (obj val) `(aset ,obj 1 ,val)) (defmacro mhc-guess-set-time-end (obj val) `(aset ,obj 1 ,val)) (defmacro mhc-guess-set-begin (obj val) `(aset ,obj 2 ,val)) (defmacro mhc-guess-set-end (obj val) `(aset ,obj 3 ,val)) (defmacro mhc-guess-set-score (obj val) `(aset ,obj 4 ,val)) (defmacro mhc-guess-set-debug (obj val) `(aset ,obj 5 ,val)) (defun mhc-guess/new (&optional date-or-time date-or-time-end begin end score debug) (vector date-or-time date-or-time-end begin end score debug)) ;; ;; pulic entry ;; (defun mhc-guess-date (&optional hint1) (let ((now (or (mhc-date-new-from-string3 (mhc-header-get-value "Date")) (mhc-date-now)))) (mhc-guess/guess mhc-guess-date-regexp-list hint1 now))) (defun mhc-guess-time (&optional hint1) (mhc-guess/guess mhc-guess-time-regexp-list hint1)) (defun mhc-guess-location-setup () (if mhc-guess-location-list (let ((list mhc-guess-location-list) regex) (while list (setq regex (concat regex "\\(" (car list) "\\)")) (setq list (cdr list)) (when list (setq regex (concat regex "\\|")))) (setq mhc-guess/location-regexp-list (cons `(,regex mhc-guess/make-location-from-string 0) mhc-guess-location-regexp-list))) (setq mhc-guess/location-regexp-list mhc-guess-location-regexp-list))) (defun mhc-guess-location (&optional hint1) (mhc-guess/guess mhc-guess/location-regexp-list hint1)) (defun mhc-guess/guess (control-regexp-lst &optional hint1 now) (let ((score-list (mhc-guess/score (mhc-guess/gather-candidate control-regexp-lst now) mhc-guess-keyword-score-alist hint1 now))) (sort score-list (function (lambda (a b) (if (= (mhc-guess-get-score a) (mhc-guess-get-score b)) (< (- (mhc-guess-get-end b) (mhc-guess-get-begin b)) (- (mhc-guess-get-end a) (mhc-guess-get-begin a))) (< (mhc-guess-get-score b) (mhc-guess-get-score a)))))))) ;; ;; gather date/time. ;; (defun mhc-guess/gather-candidate (control-regexp-lst &optional now) (let ((ret nil) cand-lst) (while control-regexp-lst (cond ((listp (car control-regexp-lst)) (if (setq cand-lst (mhc-guess/gather-candidate2 (car (car control-regexp-lst)) ;; regexp (car (cdr (car control-regexp-lst))) ;; convfunc (cdr (cdr (car control-regexp-lst))) ;; posision list now ;; current date )) (setq ret (nconc ret cand-lst)))) ((and (string= "throw" (symbol-name (car control-regexp-lst))) ret) (setq control-regexp-lst nil))) (setq control-regexp-lst (cdr control-regexp-lst))) ret)) (defun mhc-guess/gather-candidate2 (regexp convfunc pos-list &optional now) (let* (lst duration param-list p) (save-excursion ;; skip Header (goto-char (point-min)) (re-search-forward "^-*$" nil t) ;; search candities. (while (re-search-forward regexp nil t) (setq p pos-list param-list nil) (while p (setq param-list (cons (if (and (car p) (match-beginning (car p))) (buffer-substring (match-beginning (car p)) (match-end (car p))) nil) param-list)) (setq p (cdr p))) (setq duration (apply 'funcall convfunc now (nreverse param-list))) (if (car duration) (setq lst (cons (mhc-guess/new (car duration) (cdr duration) (match-beginning 0) (match-end 0) nil (format "%s with %s" convfunc regexp)) lst))))) (nreverse lst))) ;; ;; make date from string. ;; (defun mhc-guess/make-date-from-yyyymmdd (now yy-str mm-str dd-str) (let (date) (if (setq date (mhc-date-new (mhc-guess/string-to-int yy-str) (mhc-guess/string-to-int mm-str) (mhc-guess/string-to-int dd-str) t)) ; noerror is t. (cons date nil)))) (defun mhc-guess/make-date-from-mmdd (now mm-str dd-str &optional mm-str2 dd-str2 relative) (let* ((start nil) (end nil)) (setq start (mhc-guess/make-date-from-mmdd2 now mm-str dd-str)) (if start (setq end (mhc-guess/make-date-from-mmdd2 start mm-str2 dd-str2))) (cond ((null start) nil) ((null end) (cons start nil)) (relative (cons start (mhc-date+ start end))) (t (cons start end))))) (defun mhc-guess/make-date-from-mmdd2 (now mm-str dd-str) (let ((data (match-data)) (mm (if mm-str (mhc-guess/string-to-int mm-str) 0)) (dd (if dd-str (mhc-guess/string-to-int dd-str) 0)) (year-offset 0) date) (cond ((string= mm-str "来") (setq mm (mhc-date-mm (mhc-date-mm++ now)))) ((string= mm-str "今") (setq mm (mhc-date-mm now))) ((= mm 0) (setq mm (mhc-date-mm now)))) (if (not (setq date (mhc-date-new (mhc-date-yy now) mm dd t))) ;; noerror is t () ;; if date is past, assume the next year. (if (mhc-date< date now) (setq year-offset (1+ year-offset))) ;; if date is far future, assume the last year. (if (< 300 (+ (mhc-date- date now) (* year-offset 365))) (setq year-offset (1- year-offset))) (setq date (mhc-date-yy+ date year-offset))) (store-match-data data) date)) (defun mhc-guess/make-date-from-usa-style-date (now month-str dd-str yy-str) (if (and (null mhc-guess-ignore-english-date) (memq 'usa mhc-guess-english-date-format)) (mhc-guess/make-date-from-english-date now month-str dd-str yy-str))) (defun mhc-guess/make-date-from-british-style-date (now dd-str month-str yy-str) (if (and (null mhc-guess-ignore-english-date) (memq 'british mhc-guess-english-date-format)) (mhc-guess/make-date-from-english-date now month-str dd-str yy-str))) (defun mhc-guess/make-date-from-english-date (now month-str dd-str yy-str) (let* ((month-alist '(("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4") ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8") ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12"))) (mm-str (cdr (assoc (capitalize (substring month-str 0 3)) month-alist))) (yy-length (length yy-str))) (cond ((= yy-length 4) ; "yyyy" (mhc-guess/make-date-from-yyyymmdd now yy-str mm-str dd-str)) ((or (= yy-length 3) (= yy-length 2)) ; "'yy" or "yy" (mhc-guess/make-date-from-yyyymmdd now (concat (substring (format-time-string "%Y") 0 2) (substring yy-str -2)) mm-str dd-str)) (t (mhc-guess/make-date-from-mmdd now mm-str dd-str))))) (defun mhc-guess/make-date-from-relative-day (now rel-word) (cond ((null rel-word) nil) ((or (string= rel-word "今日") (string= rel-word "本日")) (cons now nil)) ((or (string= rel-word "あす") (string= rel-word "あした") (string= rel-word "明日")) (cons (mhc-date++ now) nil)) ((or (string= rel-word "あさって") (string= rel-word "明後日")) (cons (mhc-date+ now 2) nil)))) (defun mhc-guess/make-date-from-english-relative-day (now rel-word) (unless mhc-guess-ignore-english-date (let ((rel (downcase rel-word))) (cond ((null rel) nil) ((string= rel "today") (cons now nil)) ((string= rel "tomorrow") (cons (mhc-date++ now) nil)) (t ;; the day after tommorow. (cons (mhc-date+ now 2) nil)))))) (defun mhc-guess/make-date-from-relative-week (now rel-word week) (let ((data (match-data)) (ww (string-match week "日月火水木金土")) (date (or now (mhc-date-now))) off) (setq off (- ww (mhc-date-ww date))) (if (string= week "日") (setq off (+ 7 off))) (setq off (cond ((or (null rel-word) (string= rel-word "今度") (string= rel-word "次")) (if (<= off 0) (+ 7 off) off)) ((string= rel-word "今週") off) ((string= rel-word "来週") (+ off 7)) ((string= rel-word "再来週") (+ off 14)))) (store-match-data data) (cons (mhc-date+ date off) nil) )) (defun mhc-guess/make-date-from-english-relative-week (now dow rel-word week) (unless mhc-guess-ignore-english-date (let ((dow-alist '(("Monday" . "月") ("Tuesday" . "火") ("Wednesday" . "水") ("Thursday" . "木") ("Friday" . "金") ("Saturday" . "土") ("Sunday" . "日"))) (rel (when (stringp rel-word) (downcase rel-word)))) (mhc-guess/make-date-from-relative-week now (if (null rel) nil (cond ((and (string= rel "this") (null week)) "今度") ((and (string= rel "this") week) "今週") ((and (string= rel "next") (null week)) "今度") ((and (string= rel "next") week) "来週") (t nil))) (cdr (assoc-string dow dow-alist t)))))) ;; ;; make time from string. ;; (defun mhc-guess/make-time-from-hhmm (now hh-str mm-str hh-str2 mm-str2 &optional relative) (let ((start (mhc-guess/make-time-from-hhmm2 hh-str mm-str)) (end (mhc-guess/make-time-from-hhmm2 hh-str2 mm-str2 relative))) (cond ((null start) nil) ((null end) (cons start nil)) (relative (cons start (mhc-time+ start end))) (t (cons start end))))) (defun mhc-guess/make-time-from-hhmm2 (hh-str mm-str &optional relative) (let (xHH xMM) (if (null hh-str) nil ;; retun value (setq xHH (mhc-guess/string-to-int hh-str)) (if (and (not relative) (< xHH 8)) ;; 8 depends on my life style. (setq xHH (+ xHH 12))) (setq xMM (cond ((not mm-str) 0) ((string= mm-str "半") 30) (t (mhc-guess/string-to-int mm-str)))) (mhc-time-new xHH xMM t)))) ;; ;; make location from string ;; (defun mhc-guess/make-location-from-string (now str) (cons str nil)) ;; ;; scoring ;; (defun mhc-guess/score (candidate-lst score-alist &optional hint1 now) (let ((clist candidate-lst) total-score candidate regexp boundary sameline score slist) (while clist (setq candidate (car clist) slist score-alist total-score 0) ;; set score using score-alist (while slist (setq regexp (nth 0 (car slist)) boundary (nth 1 (car slist)) sameline (nth 2 (car slist)) score (nth 3 (car slist))) (if (mhc-guess/search-in-boundary regexp (mhc-guess-get-begin candidate) boundary sameline) (setq total-score (+ total-score score))) (setq slist (cdr slist))) ;; hint1 is a position hint to encourage the near one. (if (and hint1 (< hint1 (mhc-guess-get-begin candidate)) (< (- (mhc-guess-get-begin candidate) hint1) 100)) (setq total-score (+ total-score 10))) ;; now is a date hint to discourage a past date. (if (and now (mhc-date<= (mhc-guess-get-date candidate) now)) (setq total-score (- total-score 5))) (mhc-guess-set-score candidate total-score) (setq clist (cdr clist))) candidate-lst)) (defun mhc-guess/search-in-boundary (regexp ptr rel-boundary sameline) (let ((pmin (+ ptr rel-boundary)) (pmax (+ ptr rel-boundary))) (save-excursion (goto-char ptr) (if sameline (setq pmax (min pmax (save-excursion (end-of-line) (point))) pmin (max pmin (save-excursion (beginning-of-line) (point))))) (if (< 0 rel-boundary) (and (< (point) pmax) (search-forward-regexp regexp pmax t)) (and (< pmin (point)) (search-backward-regexp regexp pmin t)))))) ;; ;; string-to-int with code conversion. ;; (defconst mhc-guess/zenkaku-hankaku-alist '(("０" . "0") ("１" . "1") ("２" . "2") ("３" . "3") ("４" . "4") ("５" . "5") ("６" . "6") ("７" . "7") ("８" . "8") ("９" . "9") ("／" . "/") ("：" . ":"))) (defun mhc-guess/string-to-int (str) (let ((chr "") (ret "") (data (match-data)) (z2h-alist '(("０" . "0") ("１" . "1") ("２" . "2") ("３" . "3") ("４" . "4") ("５" . "5") ("６" . "6") ("７" . "7") ("８" . "8") ("９" . "9") ("／" . "/") ("：" . ":")))) (while (string-match "^." str) (setq chr (substring str (match-beginning 0) (match-end 0))) (setq ret (concat ret (or (cdr (assoc chr z2h-alist)) chr))) (setq str (substring str (match-end 0)))) (store-match-data data) (string-to-number ret))) ;;; 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-guess.el ends here mhc-1.1.1/emacs/mhc-header.el000066400000000000000000000150661262546231500157060ustar00rootroot00000000000000;;; -*- mode: Emacs-Lisp; coding: utf-8 -*- ;; Author: Yoshinari Nomura , ;; TSUCHIYA Masatoshi ;; Created: 2000/05/11 ;; Revised: $Date$ ;;; Commentary: ;; This file is a part of MHC, includes functions to manipulate ;; headers. ;;; Code: ;; Global Variable: (defconst mhc-header-table '( ("x-sc-subject" "X-SC-Subject:" mhc-parse/subject) ("x-sc-location" "X-SC-Location:" mhc-parse/location) ("x-sc-day" "X-SC-Day:" mhc-parse/day) ("x-sc-time" "X-SC-Time:" mhc-parse/time) ("x-sc-category" "X-SC-Category:" mhc-parse/category) ("x-sc-priority" "X-SC-Priority:" mhc-parse/priority) ("x-sc-recurrence-tag" "X-SC-Recurrence-Tag:" mhc-parse/recurrence-tag) ("x-sc-cond" "X-SC-Cond:" mhc-parse/cond) ("x-sc-duration" "X-SC-Duration:" mhc-parse/duration) ("x-sc-alarm" "X-SC-Alarm:" mhc-parse/alarm) ("x-sc-record-id" "X-SC-Record-Id:" mhc-parse/record-id) ("x-sc-sequence" "X-SC-Sequence:" mhc-parse/sequence) )) (defmacro mhc-header-list () "Return headers which are referenced by MHC." `(mapcar (lambda (a) (nth 1 a)) mhc-header-table)) (defmacro mhc-header-parse-function (key) "Return a function to parse KEY." `(nth 2 (assoc (downcase ,key) mhc-header-table))) (defmacro mhc-header-narrowing (&rest form) "Evaluate FORM with restriction of editing in this buffer to the header." `(save-excursion (save-restriction (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$\\|^$") nil t) (narrow-to-region (point-min) (match-beginning 0)) (goto-char (point-min)) ,@form))) (put 'mhc-header-narrowing 'lisp-indent-function 0) (put 'mhc-header-narrowing 'edebug-form-spec '(form body)) (defsubst mhc-header-goto-end () "Move point at end of this header." (while (and (forward-line 1) (memq (following-char) '(? ?\t))))) (defun mhc-header-delete-header (header &optional regexp) "\ Remove HEADER in the narrowed buffer. If REGEXP, HEADER is a regular expression." (save-excursion (let ((case-fold-search t) (regexp (if regexp header (concat "^" (regexp-quote header) ":")))) (goto-char (point-min)) (while (re-search-forward regexp nil t) (mhc-header-goto-end) (delete-region (match-beginning 0) (point)))))) (defun mhc-header-delete-empty-header (header &optional regexp) "Remove HEADER if empty in the narrowed buffer. If REGEXP, HEADER is a regular expression." (save-excursion (let ((case-fold-search t) (regexp (if regexp (concat header " *$") (concat "^" (regexp-quote header) ": *$")))) (goto-char (point-min)) (while (re-search-forward regexp nil t) (mhc-header-goto-end) (delete-region (match-beginning 0) (point)))))) (defun mhc-header-put-value (header value) "Overwrite VALUE of HEADER in the narrowed buffer." (if (assoc (downcase header) mhc-header-table) (setq header (substring (nth 1 (assoc (downcase header) mhc-header-table)) 0 -1))) (let ((case-fold-search t) (regexp (concat "^" (regexp-quote header) ":"))) (save-excursion (goto-char (point-min)) (if (re-search-forward regexp nil t) (save-restriction (mhc-header-goto-end) (delete-region (match-beginning 0) (point)) (insert (format "%s: %s\n" header value)) (narrow-to-region (point) (point-max)) (mhc-header-delete-header header)) (goto-char (point-max)) (insert (format "%s: %s\n" header value)))))) (defun mhc-header-get-value (header &optional repeat) "Return value of HEADER in the narrowed buffer." (let ((point (point)) (case-fold-search t) (regexp (concat "^" (regexp-quote header) ":[ \t]*")) value) (goto-char (point-min)) (while (and (not value) (re-search-forward regexp nil t repeat)) (mhc-header-goto-end) (setq value (buffer-substring-no-properties (match-end 0) (1- (point))))) (goto-char point) value)) (defun mhc-header-valid-p (header &optional repeat) "Valid HEADER in the narrowed buffer." (let ((get (mhc-header-get-value header repeat))) (and (stringp get) (not (string= "" get))))) (defun mhc-header-delete-separator () "Delete separator between header and body in this buffer." (save-excursion (goto-char (point-min)) (if (re-search-forward "^-*$" nil t) (delete-region (match-beginning 0) (match-end 0))))) (eval-and-compile (autoload 'rfc2047-decode-region "rfc2047")) (defsubst mhc-header-decode-ewords () "Decode rfc2047 encoded header." (save-restriction (mhc-header-narrowing (rfc2047-decode-region (point-min) (point-max))))) (provide 'mhc-header) ;;; 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-header.el ends here. mhc-1.1.1/emacs/mhc-logic.el000066400000000000000000000567141262546231500155600ustar00rootroot00000000000000;;; -*- mode: Emacs-Lisp; coding: utf-8 -*- ;; Author: TSUCHIYA Masatoshi ;; Created: 2000/04/30 ;; Revised: $Date$ ;;; Commentary: ;; This file is a part of MHC. ;; スケジュールの条件を表すヘッダを、その条件と等しいS式に変換するため ;; のライブラリ。 ;; S式は、以下のようなローカル変数の束縛の下で評価される。 ;; (let ((month 4) ;; (day 11048) ; 1970/1/1 からの日数 ;; (day-of-month 1) ;; (day-of-week 6) ; 0 = Sun, 1 = Mon, ... ;; (week-of-month 0) ; 0 = 1st, 1 = 2nd, 2 = 3rd, 3 = 4th, 4 = 5th ;; (last-week nil) ;; (todo nil)) ;; (eval sexp)) ;; 具体的な評価の形式は、mhc-logic-eval-for-date, mhc-db/eval-for-duration ;; 関数の定義などを参照。 ;; 条件が、Emacs-Lisp の述語のみからなるS式に変換されると、元々の条件 ;; の意味が分かりづらくなるため、一旦、元々のヘッダとほとんど同じ形式 ;; のマクロを用いた式に変換する。 ;; この中間式を参照することによって、元々の条件に対する意味論的な評価 ;; が可能となる(mhc-logic-file-to-slot)。 ;; また、通常の評価を行う場合は、中間式に含まれるマクロを完全に展開し ;; てから行うため(mhc-logic-compile-file)、スピードは高速に保たれる。 ;;; Definition: (require 'mhc-date) (require 'bytecomp) ;;---------------------------------------------------------------------- ;; MHC-LOGIC 構造体 ;;---------------------------------------------------------------------- ;; MHC-LOGIC ::= [ DAY AND TODO INTERMEDIATE SEXP ] ;; DAY ::= INT | NOT_INT ;; NOT_INT ::= ( INT . nil ) ;; INT ::= integer ( represents exceptional date ) ;; AND ::= conditions ( each condition represents X-SC-Cond: header ) ;; INTERMEDIATE ::= macro expression ;; SEXP ::= full expanded expression ;; mhc-logic/day = 日付(X-SC-Day)による条件 ;; mhc-logic/and = それ以外のヘッダに基づく条件 ;; mhc-logic/todo = TODOの順位 ;; mhc-logic/intermediate = 条件をS式に変換するための中間形式 ;; mhc-logic-sexp = 完全に展開されたS式 (defun mhc-logic-new () (make-vector 5 nil)) (defmacro mhc-logic/day (logicinfo) `(aref ,logicinfo 0)) (defmacro mhc-logic/and (logicinfo) `(aref ,logicinfo 1)) (defmacro mhc-logic-todo (logicinfo) `(aref ,logicinfo 2)) (defmacro mhc-logic/intermediate (logicinfo) `(aref ,logicinfo 3)) (defmacro mhc-logic-sexp (logicinfo) `(aref ,logicinfo 4)) (defmacro mhc-logic/set-day (logicinfo value) `(aset ,logicinfo 0 ,value)) (defmacro mhc-logic/set-and (logicinfo value) `(aset ,logicinfo 1 ,value)) (defmacro mhc-logic/set-todo (logicinfo value) `(aset ,logicinfo 2 ,value)) (defmacro mhc-logic/set-intermediate (logicinfo value) `(aset ,logicinfo 3 ,value)) (defmacro mhc-logic/set-sexp (logicinfo value) `(aset ,logicinfo 4 ,value)) (defun mhc-logic-day-as-string-list (logicinfo) (mapcar (lambda (day) (if (consp day) (if (null (cdr day)) (mhc-date-format (car day) "!%04d%02d%02d" yy mm dd) (concat (mhc-date-format (car day) "%04d%02d%02d" yy mm dd) "-" (mhc-date-format (cdr day) "%04d%02d%02d" yy mm dd))) (mhc-date-format day "%04d%02d%02d" yy mm dd))) (mhc-logic/day logicinfo))) ;;---------------------------------------------------------------------- ;; 条件式を評価する関数 ;;---------------------------------------------------------------------- (defun mhc-logic-eval-for-date (sexp-list day &optional todo) "指定された日のスケジュールを探索" (mhc-day-let day (let ((week-of-month (/ (+ day-of-month (mhc-date-ww (mhc-date-mm-first day)) -8) 7)) (last-week (> 7 (- (mhc-date/last-day-of-month year month) day-of-month))) (new (mhc-day-new year month day-of-month day-of-week))) (mhc-day-set-schedules new (delq nil (mapcar (lambda (sexp) (and sexp (funcall sexp))) sexp-list))) new))) ;;---------------------------------------------------------------------- ;; 条件式を生成するための関数群 ;;---------------------------------------------------------------------- ;; S式を表現する中間形式のマクロ ;; これらは、条件式の意味論的表示として用いられる。 (defmacro mhc-logic/condition-month (n) `(eq month ,n)) (defmacro mhc-logic/condition-day (n) `(eq day ,n)) (defmacro mhc-logic/condition-day-of-month (n) `(eq day-of-month ,n)) (defmacro mhc-logic/condition-day-of-week (n) `(eq day-of-week ,n)) (defmacro mhc-logic/condition-week-of-month (n) `(eq week-of-month ,n)) (defmacro mhc-logic/condition-last-week () 'last-week) (defmacro mhc-logic/condition-duration (begin end) `(and (>= day ,begin) (<= day ,end))) (defmacro mhc-logic/condition-duration-begin (begin) `(>= day ,begin)) (defmacro mhc-logic/condition-duration-end (end) `(<= day ,end)) (defconst mhc-logic/space-regexp "[,| \t\n]+" "構文要素の区切りに一致する正規表現") (defconst mhc-logic/not-regexp "\\(!\\)?[ \t]*" "構文要素の否定に一致する正規表現") (defconst mhc-logic/day-regexp "\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)" "構文要素の日付に一致する正規表現") (defconst mhc-logic/day-of-month-regexp "0*\\([1-9]\\|[1-2][0-9]\\|3[01]\\)" "構文要素の該当月の何日目かを表す序数に一致する正規表現") (defconst mhc-logic/week-of-month-alist '(("1st" 0 (mhc-logic/condition-week-of-month 0)) ("2nd" 1 (mhc-logic/condition-week-of-month 1)) ("3rd" 2 (mhc-logic/condition-week-of-month 2)) ("4th" 3 (mhc-logic/condition-week-of-month 3)) ("5th" 4 (mhc-logic/condition-week-of-month 4)) ("last" 5 (mhc-logic/condition-last-week))) "構文要素の該当月の何週目かを表す序数の連想配列") (defconst mhc-logic/week-of-month-regexp (mhc-regexp-opt (mapcar (function car) mhc-logic/week-of-month-alist) 'paren) "構文要素の何週目かを表す序数に一致する正規表現") (defconst mhc-logic/day-of-week-alist '(("sun" . 0) ("mon" . 1) ("tue" . 2) ("wed" . 3) ("thu" . 4) ("fri" . 5) ("sat" . 6) ("sunday" . 0) ("monday" . 1) ("tuesday" . 2) ("wednesday" . 3) ("thursday" . 4) ("friday" . 5) ("saturday" . 6)) "構文要素の曜日の連想配列") (defconst mhc-logic/day-of-week-regexp (mhc-regexp-opt (mapcar (function car) mhc-logic/day-of-week-alist) 'paren) "構文要素の曜日に一致する正規表現") (defconst mhc-logic/month-alist '(("jan" . 1) ("feb" . 2) ("mar" . 3) ("apr" . 4) ("may" . 5) ("jun" . 6) ("jul" . 7) ("aug" . 8) ("sep" . 9) ("oct" . 10) ("nov" . 11) ("dec" . 12) ("january" . 1) ("february" . 2) ("march" . 3) ("april" . 4) ("june" . 6) ("july" . 7) ("august" . 8) ("september" . 9) ("october" .10) ("november" . 11) ("december" . 12)) "構文要素の月の連想配列") (defconst mhc-logic/month-regexp (mhc-regexp-opt (mapcar (function car) mhc-logic/month-alist) 'paren) "構文要素の月に一致する正規表現") (defconst mhc-logic/old-style-date-regexp "\\([0-9]+\\)[\t ]+\\([A-Z][a-z][a-z]\\)[\t ]+\\([0-9]+\\)" "構文要素の旧形式の日付指定に一致する正規表現") (defmacro mhc-logic/looking-at (&rest regexp) "正規表現に一致する構文要素を発見するマクロ" `(looking-at (concat ,@regexp mhc-logic/space-regexp))) (defun mhc-logic-parse-day (logicinfo) "X-SC-Day: ヘッダを解析する関数" (let ((d) (days (mhc-logic/day logicinfo))) (if (looking-at mhc-logic/space-regexp) (goto-char (match-end 0))) (while (not (eobp)) (setq days (cons (cond ((mhc-logic/looking-at mhc-logic/day-regexp "-" mhc-logic/day-regexp) (cons (mhc-date-new (string-to-number (match-string 1)) (string-to-number (match-string 2)) (string-to-number (match-string 3))) (mhc-date-new (string-to-number (match-string 4)) (string-to-number (match-string 5)) (string-to-number (match-string 6))))) ((mhc-logic/looking-at mhc-logic/not-regexp mhc-logic/day-regexp) (setq d (mhc-date-new (string-to-number (match-string 2)) (string-to-number (match-string 3)) (string-to-number (match-string 4)))) (if (match-string 1) (cons d nil) d)) (t (error "Parse ERROR !!! (at X-SC-Day:)"))) days)) (goto-char (match-end 0))) (mhc-logic/set-day logicinfo (nreverse days)))) ;; xxxxx (defun mhc-logic-parse-old-style-date (logicinfo) "X-SC-Date: ヘッダの日付部分を解析する関数" (if (looking-at mhc-logic/space-regexp) (goto-char (match-end 0))) (let (month) (if (and (mhc-logic/looking-at mhc-logic/old-style-date-regexp) (setq month (cdr (assoc (downcase (match-string 2)) mhc-logic/month-alist)))) (let ((year (string-to-number (match-string 3)))) (mhc-logic/set-day logicinfo (cons (mhc-date-new (cond ((< year 69) (+ year 2000)) ((< year 1000) (+ year 1900)) (t year)) month (string-to-number (match-string 1))) (mhc-logic/day logicinfo))) (goto-char (match-end 0))) (error "Parse ERROR !!!(at X-SC-Date:)")))) (defun mhc-logic-parse-cond (logicinfo) "X-SC-Cond: ヘッダを解析する関数" (let (sexp day-of-month week-of-month day-of-week month) (if (looking-at mhc-logic/space-regexp) (goto-char (match-end 0))) (while (not (eobp)) (cond ;; 何日目 ((mhc-logic/looking-at mhc-logic/day-of-month-regexp) (setq day-of-month (cons (list 'mhc-logic/condition-day-of-month (string-to-number (match-string 1))) day-of-month))) ;; 何週目 ((mhc-logic/looking-at mhc-logic/week-of-month-regexp) (setq week-of-month (cons (nth 2 (assoc (downcase (match-string 1)) mhc-logic/week-of-month-alist)) week-of-month))) ;; 曜日 ((mhc-logic/looking-at mhc-logic/day-of-week-regexp) (setq day-of-week (cons (list 'mhc-logic/condition-day-of-week (cdr (assoc (downcase (match-string 1)) mhc-logic/day-of-week-alist))) day-of-week))) ;; 月 ((mhc-logic/looking-at mhc-logic/month-regexp) (setq month (cons (list 'mhc-logic/condition-month (cdr (assoc (downcase (match-string 1)) mhc-logic/month-alist))) month))) (t ;; 解釈できない要素の場合 (error "Parse ERROR !!!(at X-SC-Cond:)"))) (goto-char (match-end 0))) (mapc (lambda (s) (set s (if (symbol-value s) (if (= 1 (length (symbol-value s))) (car (symbol-value s)) (cons 'or (nreverse (symbol-value s))))))) '(day-of-month week-of-month day-of-week month)) (setq sexp (cond ((and week-of-month day-of-week) `(and ,week-of-month ,day-of-week)) (week-of-month week-of-month) (day-of-week day-of-week))) (if day-of-month (setq sexp (if sexp (list 'or day-of-month sexp) day-of-month))) (if month (setq sexp (if sexp (list 'and month sexp) month))) (if sexp (mhc-logic/set-and logicinfo (cons sexp (mhc-logic/and logicinfo)))))) (defun mhc-logic-parse-duration (logicinfo) "X-SC-Duration: ヘッダを解析する関数" (let (sexp) (if (looking-at mhc-logic/space-regexp) (goto-char (match-end 0))) (while (not (eobp)) (setq sexp (cons (cond ((mhc-logic/looking-at mhc-logic/day-regexp "-" mhc-logic/day-regexp) (list 'mhc-logic/condition-duration (mhc-date-new (string-to-number (match-string 1)) (string-to-number (match-string 2)) (string-to-number (match-string 3))) (mhc-date-new (string-to-number (match-string 4)) (string-to-number (match-string 5)) (string-to-number (match-string 6))))) ((mhc-logic/looking-at mhc-logic/day-regexp "-") (list 'mhc-logic/condition-duration-begin (mhc-date-new (string-to-number (match-string 1)) (string-to-number (match-string 2)) (string-to-number (match-string 3))))) ((mhc-logic/looking-at "-" mhc-logic/day-regexp) (list 'mhc-logic/condition-duration-end (mhc-date-new (string-to-number (match-string 1)) (string-to-number (match-string 2)) (string-to-number (match-string 3))))) (t ; それ以外の場合 (error "Parse ERROR !!!(at X-SC-Duration:)"))) sexp)) (goto-char (match-end 0))) (if sexp (mhc-logic/set-and logicinfo (cons (if (= 1 (length sexp)) (car sexp) (cons 'or (nreverse sexp))) (mhc-logic/and logicinfo)))))) ;; Need to be deleted. (defun mhc-logic-parse-todo (logicinfo) (if (looking-at mhc-logic/space-regexp) (goto-char (match-end 0))) (let ((content (buffer-substring (point) (progn (skip-chars-forward "0-9") (point))))) (if (looking-at mhc-logic/space-regexp) (goto-char (match-end 0))) (if (eobp) (mhc-logic/set-todo logicinfo (string-to-number content)) (error "Parse ERROR !!!(at X-SC-Todo:)")))) (defun mhc-logic-compile-file (record) "日付を指定されたときに、関係するスケジュールを選びだすためのS式を生成する" (let ((sexp) (schedules (mhc-record-schedules record)) (byte-compile-warnings)) (while schedules (setq sexp (cons (mhc-logic/compile-schedule (car schedules)) sexp) schedules (cdr schedules))) (setq sexp (delq nil sexp)) (mhc-record-set-sexp record (if sexp (let (year month day day-of-month day-of-week week-of-month last-week todo) (byte-compile (list 'lambda () (if (= 1 (length sexp)) (car sexp) (cons 'or (nreverse sexp)))))))))) (defun mhc-logic/compile-schedule (schedule) "mhc-logic-compile-file の下請け関数" (let* ((logicinfo (mhc-schedule-condition schedule)) sexp) ;; 日付による例外条件とそれ以外の条件を結合した論理式を生成する (setq sexp (nreverse (delq nil (cons (let ((and (mhc-logic/and logicinfo))) (if and (if (= 1 (length and)) (list (car and) t) (list (cons 'and (reverse and)) t)))) (mapcar (lambda (day) (if (consp day) (if (null (cdr day)) `((mhc-logic/condition-day ,(car day)) nil) `((mhc-logic/condition-duration ,(car day) ,(cdr day)) t)) `((mhc-logic/condition-day ,day) t))) (mhc-logic/day logicinfo)))))) (if sexp (progn ;; 条件の数によって、条件式を最適化しておく (setq sexp (if (= 1 (length sexp)) (if (nth 1 (car sexp)) (car (car sexp)) `(not ,(car (car sexp)))) (cons 'cond sexp))) ;; TODOに基づく条件を加える (setq sexp (if (mhc-logic-todo logicinfo) `(if todo t ,sexp) `(if todo nil ,sexp)))) (if (mhc-logic-todo logicinfo) (setq sexp 'todo))) ;; この中間形式を保存しておく (mhc-logic/set-intermediate logicinfo sexp) ;; 中間形式を展開する (mhc-logic/set-sexp logicinfo (if sexp (mhc-logic/macroexpand `(if ,sexp ,schedule)))))) (defun mhc-logic/macroexpand (sexp) "部分式に遡ってマクロを展開する関数" (macroexpand (if (listp sexp) (mapcar (function mhc-logic/macroexpand) sexp) sexp))) ;;---------------------------------------------------------------------- ;; mhc-logic-record-to-slot ;;---------------------------------------------------------------------- (defun mhc-logic-record-to-slot (record) "Return appropriate slot key, ( YEAR . MONTH ), for RECORD." (let ((schedules (mhc-record-schedules record)) pre-month cur-month) (while (and schedules (not (mhc-logic-todo (mhc-schedule-condition (car schedules)))) (setq cur-month (mhc-logic/check-sexp-range (mhc-schedule-condition (car schedules)))) (if pre-month (equal pre-month cur-month) (setq pre-month cur-month))) (setq schedules (cdr schedules))) (if schedules (cons nil nil) cur-month))) (defun mhc-logic/day-to-slot (day) "Generate slot key by DAY, which represents the number of days from 1970/01/01," (mhc-day-let day (cons year month))) (defun mhc-logic/check-sexp-range (logicinfo) "Estimate appropriate slot for LOGICINFO, with macro expression." (let (duration-begin duration-end day-list month-list require-duration) (mhc-logic/check-sexp-range-internal (mhc-logic/intermediate logicinfo)) (if (or (> (length month-list) 1) (if require-duration (or (not duration-begin) (not duration-end))) (progn (if day-list (setq day-list (sort day-list '<))) (not (equal (setq duration-begin (if day-list (mhc-logic/day-to-slot (if duration-begin (min (car day-list) duration-begin) (car day-list))))) (if day-list (mhc-logic/day-to-slot (if duration-end (max (nth (1- (length day-list)) day-list) duration-end) (nth (1- (length day-list)) day-list)))))))) '(nil . nil) duration-begin))) (eval-when-compile (defvar day-list) (defvar duration-begin) (defvar duration-end) (defvar month-list) (defvar require-duration)) (defun mhc-logic/check-sexp-range-internal (sexp) "Recursive subroutine of mhc-logic/check-sexp-range." (if (listp sexp) (cond ((eq (car sexp) 'mhc-logic/condition-duration) (if (or (not duration-begin) (< (nth 1 sexp) duration-begin)) (setq duration-begin (nth 1 sexp))) (if (or (not duration-end) (> (nth 1 sexp) duration-end)) (setq duration-end (nth 2 sexp)))) ((eq (car sexp) 'mhc-logic/condition-duration-begin) (if (or (not duration-begin) (< (nth 1 sexp) duration-begin)) (setq duration-begin (nth 1 sexp)))) ((eq (car sexp) 'mhc-logic/condition-duration-end) (if (or (not duration-end) (> (nth 1 sexp) duration-end)) (setq duration-end (nth 1 sexp)))) ((eq (car sexp) 'mhc-logic/condition-day) (setq day-list (cons (nth 1 sexp) day-list))) ((eq (car sexp) 'mhc-logic/condition-month) (or (memq (nth 1 sexp) month-list) (setq month-list (cons (nth 1 sexp) month-list))) (setq require-duration t)) ((eq (car sexp) 'mhc-logic/condition-day-of-week) (setq require-duration t)) ((eq (car sexp) 'mhc-logic/condition-day-of-month) (setq require-duration t)) (t (while sexp (mhc-logic/check-sexp-range-internal (car sexp)) (setq sexp (cdr sexp))))))) ; (defun mhc-logic-occur-multiple-p (logicinfo) ; "If LOGICINFO occurs multiple times, return t." ; (let (duration-begin duration-end day-list month-list require-duration) ; (mhc-logic/check-sexp-range-internal (mhc-logic/intermediate logicinfo)) ; (if (or duration-begin ; duration-end ; month-list ; (> (length day-list) 1)) ; t))) ;; rough (but safety) check -- nom (defun mhc-logic-occur-multiple-p (logicinfo) "If LOGICINFO occurs multiple times, return t." (if (or (mhc-logic/and logicinfo) (> (length (mhc-logic/day logicinfo)) 1)) t)) (provide 'mhc-logic) ;;; 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-logic.el ends here mhc-1.1.1/emacs/mhc-message.el000066400000000000000000000111711262546231500160730ustar00rootroot00000000000000;;; mhc-message.el --- Message major mode in MHC. ;; Copyright (C) 2014 MHC development team. ;; Author: Yoshinari Nomura ;; Keywords: calendar ;; This file is NOT part of GNU Emacs. ;;; License: ;; You can redistribute it and/or modify it under the terms of ;; The BSD 3-Clause License. You can check the details from: ;; https://github.com/yoshinari-nomura/mhc/blob/master/COPYRIGHT ;;; Commentary: ;; This file is a part of MHC. mhc-message major mode in MHC. ;;; Code: (defcustom mhc-message-mode-hook nil "*Hook run in mhc message mode buffers." :group 'mhc :type 'hook) (defvar mhc-message-mode-map nil) (setq mhc-message-mode-map (make-sparse-keymap)) (define-key mhc-message-mode-map " " 'mhc-message-scroll-page-forward) (defvar mhc-message-end-of-messge-marker "[End of message]") (defun mhc-message/remove-overlay (overlay-property) "Remove OVERLAY-PROPERTY from current buffer." (dolist (ovl (overlays-in (point-max) (point-max))) (if (overlay-get ovl overlay-property) (delete-overlay ovl)))) (defun mhc-message/insert-end-mark () "Insert end of message mark." (let ((end-mark (make-overlay (point-max) (point-max) nil t t)) (end-text mhc-message-end-of-messge-marker)) ;; Delete any previous markers. (mhc-message/remove-overlay 'mhc-eom-overlay) ;; Add a new marker. (mhc-face-put end-text 'mhc-message-face-eof-marker) (overlay-put end-mark 'mhc-eom-overlay t) (overlay-put end-mark 'after-string end-text))) (define-derived-mode mhc-message-mode text-mode "MHC-Msg" "Major mode for viewing schdule files of MHC." (save-excursion (mhc-header-decode-ewords) (goto-char (point-max)) (unless (bolp) (insert "\n")) (mhc-message/insert-end-mark) (mhc-highlight-message)) ;; (setq mhc-message-mode-called-count (1+ mhc-message-mode-called-count)) ;; (message "mhc-message-mode-called-count: %d" mhc-message-mode-called-count) ;; ) ;; (set (make-local-variable 'scroll-error-top-bottom) t) ;; (run-hooks 'mhc-message-mode-hook) ) ;; user interface (defun mhc-message-scroll-page-forward (&optional lines) "Scroll text of selected MHC message window upward LINES. If LINES is omitted or nil, scroll upward by a near full screen." (interactive) (unless (ignore-errors (scroll-up lines) t) (message "End of buffer"))) (defun mhc-message-scroll-page-backward (&optional lines) "Scroll text of selected MHC message window down LINES. If LINES is omitted or nil, scroll down by a near full screen." (interactive) (unless (ignore-errors (scroll-down lines) t) (message "Beginning of buffer"))) ;; file signature (defvar mhc-message-current-signature nil) (make-variable-buffer-local 'mhc-message-cache-signature) (defun mhc-message-file-signature (file-name) (let ((file-path (and (stringp file-name) (expand-file-name file-name)))) (and file-path (file-exists-p file-path) (cons file-path (nth 5 (file-attributes file-path)))))) (defun mhc-message-update-signature (file-name) (let ((file-signature (mhc-message-file-signature file-name))) (if (equal mhc-message-current-signature file-signature) nil ;; not updated (setq mhc-message-current-signature file-signature) t ;; updated ))) ;; message setup and update (defun mhc-message-create (buffer-or-name &optional file-name) "Create the mhc-message-mode buffer specified by BUFFER-OR-NAME. This is similar to `get-buffer-create'. If FILE-NAME is non-nil, the buffer is filled with the content of FILE-NAME." (let ((buf (get-buffer-create buffer-or-name))) (with-current-buffer buf (mhc-message-clear) (if file-name (mhc-message-update file-name)) (mhc-message-mode) (set-buffer-modified-p nil)) buf)) (defun mhc-message-update (file-name &optional buffer-or-name) "Replace buffer content by FILE-NAME in BUFFER-OR-NAME." (let ((buf (or buffer-or-name (current-buffer)))) (with-current-buffer buf (when (mhc-message-update-signature file-name) (mhc-message-clear) (mhc-insert-file-contents-as-coding-system mhc-default-coding-system file-name))) buf)) (defun mhc-message-clear (&optional buffer-or-name) "Clear current buffer content. If BUFFER-OR-NAME is specified, clear the content of BUFFER-OR-NAME. Returns the designated buffer." (let ((buf (or buffer-or-name (current-buffer)))) (with-current-buffer buf (setq buffer-read-only nil inhibit-read-only t) (set-visited-file-name nil) (goto-char (point-min)) (erase-buffer)) buf)) (provide 'mhc-message) ;;; mhc-message.el ends here mhc-1.1.1/emacs/mhc-minibuf.el000066400000000000000000000377621262546231500161160ustar00rootroot00000000000000;;; mhc-minibuf.el ;; Author: Yoshinari Nomura ;; ;; Created: 1999/12/10 ;; Revised: $Date: 2004/09/08 09:12:10 $ ;;; ;;; Commentay: ;;; ;;; ;;; Code: ;;; (defvar mhc-minibuf-candidate-to-s-func nil) (defvar mhc-minibuf-candidate-alist nil) (defvar mhc-minibuf-candidate-offset 0) (defvar mhc-minibuf-candidate-overlay nil) (defvar mhc-minibuf-candidate-buffer nil) (defvar mhc-minibuf-candidate-delimiter nil) ;; (make-variable-buffer-local 'mhc-minibuf-candidate-to-s-func) ;; (make-variable-buffer-local 'mhc-minibuf-candidate-alist) ;; (make-variable-buffer-local 'mhc-minibuf-candidate-offset) ;; (make-variable-buffer-local 'mhc-minibuf-candidate-overlay) ;; (make-variable-buffer-local 'mhc-minibuf-candidate-buffer) (defun mhc-minibuf-read (&optional prompt default buffer cand offset to-s delimiter) (if mhc-minibuf-candidate-overlay (delete-overlay mhc-minibuf-candidate-overlay)) (setq mhc-minibuf-candidate-buffer buffer mhc-minibuf-candidate-alist cand mhc-minibuf-candidate-offset (or offset 0) mhc-minibuf-candidate-to-s-func to-s mhc-minibuf-candidate-delimiter delimiter) (if cand (progn (setq mhc-minibuf-candidate-overlay (make-overlay (mhc-minibuf-candidate-nth-begin) (mhc-minibuf-candidate-nth-end) buffer)) (overlay-put mhc-minibuf-candidate-overlay 'face 'mhc-minibuf-face-candidate) (mhc-minibuf-move-candidate 0 t t))) (read-from-minibuffer prompt (cond (default default) ((and to-s (mhc-minibuf-candidate-nth-obj) (funcall to-s (mhc-minibuf-candidate-nth-obj)))) (t "")) mhc-minibuf-map)) ;; access methods to candidate-alist ;; ;; candidate-alist is like: ;; ((score (begin . end) obj) ...) ;; (defun mhc-minibuf/get-nth-candidate (&optional alist n) (nth (or n mhc-minibuf-candidate-offset) (or alist mhc-minibuf-candidate-alist))) (defun mhc-minibuf-candidate-nth-score (&optional alist n) (let ((candidate (mhc-minibuf/get-nth-candidate alist n))) (if candidate (mhc-guess-get-score candidate)))) (defun mhc-minibuf-candidate-nth-begin (&optional alist n) (let ((candidate (mhc-minibuf/get-nth-candidate alist n))) (if candidate (mhc-guess-get-begin candidate)))) (defun mhc-minibuf-candidate-nth-end (&optional alist n) (let ((candidate (mhc-minibuf/get-nth-candidate alist n))) (if candidate (mhc-guess-get-end candidate)))) (defun mhc-minibuf-candidate-nth-obj (&optional alist n) (let ((candidate (mhc-minibuf/get-nth-candidate alist n))) (if candidate (cons (mhc-guess-get-date-or-time candidate) (mhc-guess-get-date-or-time-end candidate))))) ;; ;; move candidate by score. ;; (defun mhc-minibuf-candidate-inc-offset2 (&optional n) (let ((len (length mhc-minibuf-candidate-alist))) (if (< 0 len) (setq mhc-minibuf-candidate-offset (% (+ len (% (+ mhc-minibuf-candidate-offset (or n 1)) len)) len))))) ;; ;; move candidate by position. ;; xxx: offset is 1 or -1 only. ;; (defun mhc-minibuf-candidate-inc-offset (&optional n) (let* ((len (length mhc-minibuf-candidate-alist)) (cur (mhc-minibuf-candidate-nth-begin)) (max cur) (min cur) (max-i mhc-minibuf-candidate-offset) (min-i mhc-minibuf-candidate-offset) (i 0) nxt prv ptr prv-i nxt-i) (while (< i len) (setq ptr (mhc-minibuf-candidate-nth-begin mhc-minibuf-candidate-alist i)) (if (< max ptr) (setq max ptr max-i i)) (if (< ptr min) (setq min ptr min-i i)) (if (and (< cur ptr) (or (null nxt) (< ptr nxt))) (setq nxt ptr nxt-i i)) (if (and (< ptr cur) (or (null prv) (< prv ptr))) (setq prv ptr prv-i i)) (setq i (1+ i))) (if (< 0 n) (setq mhc-minibuf-candidate-offset (if nxt-i nxt-i min-i)) (setq mhc-minibuf-candidate-offset (if prv-i prv-i max-i))))) (defun mhc-minibuf-candidate-set-offset (n) (setq mhc-minibuf-candidate-offset n)) ;; ;; keybind ;; (defvar mhc-minibuf-map nil) ;; (setq mhc-minibuf-map nil) (if mhc-minibuf-map () (setq mhc-minibuf-map (copy-keymap minibuffer-local-map)) (define-key mhc-minibuf-map "\C-c?" 'mhc-minibuf-insert-calendar) (define-key mhc-minibuf-map "\C-n" 'mhc-minibuf-next-candidate) (define-key mhc-minibuf-map "\C-p" 'mhc-minibuf-prev-candidate) (define-key mhc-minibuf-map "\C-v" 'scroll-other-window) (define-key mhc-minibuf-map "\M-v" 'scroll-other-window-down)) ;; ;; minibuffer functions ;; ;; (defun mhc-minibuf-delete-word () ;; (delete-region ;; (save-excursion ;; (while (and (not (bobp)) ;; (string-match "[0-9:/-]" ;; (buffer-substring ;; (1- (point)) (point)))) ;; (forward-char -1)) ;; (point)) ;; (point))) (defun mhc-minibuf-delete-word (&optional delimiter) (delete-region (save-excursion (while (and (not (bobp)) (string-match (or delimiter "[0-9:/-]") (buffer-substring (1- (point)) (point)))) (forward-char -1)) (point)) (point))) (defun mhc-minibuf-move-candidate (offset &optional absolute non-minibuf) (if (not mhc-minibuf-candidate-alist) () (if absolute (mhc-minibuf-candidate-set-offset offset) (mhc-minibuf-candidate-inc-offset offset)) ;; (y-or-n-p (format "%d" mhc-minibuf-candidate-offset)) (let* ((b (mhc-minibuf-candidate-nth-begin)) (e (mhc-minibuf-candidate-nth-end)) (obj (mhc-minibuf-candidate-nth-obj)) (str (if (and mhc-minibuf-candidate-to-s-func obj) (funcall mhc-minibuf-candidate-to-s-func obj) ""))) (if (not (and mhc-minibuf-candidate-overlay b)) () (move-overlay mhc-minibuf-candidate-overlay b e) (if (not non-minibuf) (pop-to-buffer mhc-minibuf-candidate-buffer)) (goto-char b) (if (not (pos-visible-in-window-p b)) (recenter)) (if (not non-minibuf) (pop-to-buffer (window-buffer (minibuffer-window)))) ;; in minibuffer (if non-minibuf () ;; (if (string-match "-" str) ;; (delete-region (point-min) (point-max)) ;; (mhc-minibuf-delete-word)) (mhc-minibuf-delete-word mhc-minibuf-candidate-delimiter) (insert str)))))) (defun mhc-minibuf-next-candidate () (interactive) (mhc-minibuf-move-candidate 1)) (defun mhc-minibuf-prev-candidate () (interactive) (mhc-minibuf-move-candidate -1)) ;; ;; input functions for mhc. ;; (defun mhc-minibuf/date-to-string (date-cons) (let ((date (car date-cons)) (date2 (cdr date-cons))) (concat (mhc-date-format date "%04d/%02d/%02d" yy mm dd) (if date2 (mhc-date-format date2 "-%04d/%02d/%02d" yy mm dd) "")))) (defun mhc-minibuf/time-to-string (time-cons) (let ((time (car time-cons)) (time2 (cdr time-cons))) (if time2 (concat (mhc-time-to-string time) "-" (mhc-time-to-string time2)) (mhc-time-to-string time)))) (defun mhc-minibuf/location-to-string (location-cons) (let ((loc (car location-cons)) (loc2 (cdr location-cons))) (if loc2 (concat (format "%s" loc) "-" (format "%s" loc2)) (format "%s" loc)))) (defun mhc-input-day (&optional prompt default candidate) (interactive) (let (str-list date ret (error t) str) (while error (setq str (mhc-minibuf-read (concat (or prompt "") "(yyyy/mm/dd): ") (if candidate nil (cond ((and (stringp default) (mhc-date-new-from-string default t)) default) ((mhc-date-p default) (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 " ")) (t nil))) (current-buffer) candidate 0 (function mhc-minibuf/date-to-string)) str-list (mhc-misc-split str) ret nil error nil) (while (car str-list) (cond ((= 2 (length (mhc-misc-split (car str-list) "-"))) (let* ((duration (mhc-misc-split (car str-list) "-")) (b (mhc-date-new-from-string2 (nth 0 duration) nil t)) (e (mhc-date-new-from-string2 (nth 1 duration) b t))) (if (and b e (mhc-date< b e)) (progn (setq date b) (while (mhc-date<= date e) (if (not (member date ret)) (setq ret (cons date ret)) (setq error t)) (setq date (mhc-date++ date)))) (setq error t)))) ((string= (car str-list) "") ()) ((setq date (mhc-date-new-from-string2 (car str-list) date t)) (if (not (member date ret)) (setq ret (cons date ret)) (setq error t))) ((string= (car str-list) "none") ()) (t (setq error t))) (setq str-list (cdr str-list))) (if error (beep))) (mhc-calendar-input-exit) (mhc-date-sort ret))) (defun mhc-input-time (&optional prompt default candidate) (interactive) (let (str time-b time-e) (catch 'ok (while t (setq str (mhc-minibuf-read (concat (or prompt "") "(HH:MM-HH:MM or none) ") (if candidate nil (if default (if (stringp default) default (mhc-minibuf/time-to-string default) ""))) (current-buffer) candidate 0 (function mhc-minibuf/time-to-string))) (cond ((and (string-match "^\\([0-9]+:[0-9]+\\)\\(-\\([0-9]+:[0-9]+\\)\\)?$" str) (setq time-b (mhc-time-new-from-string (substring str (match-beginning 1) (match-end 1)) t mhc-input-time-regex))) (if (not (match-beginning 3)) (throw 'ok (list time-b nil))) (if (and (setq time-e (mhc-time-new-from-string (substring str (match-beginning 3) (match-end 3)) t mhc-input-time-regex)) (mhc-time<= time-b time-e)) (throw 'ok (list time-b time-e)))) ((string= "" str) (throw 'ok (list nil nil)))) (beep))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; input x-sc- schedule data from minibuffer. (defvar mhc-month-hist nil) (defun mhc-input-month (prompt &optional default) (let ((ret nil) (month-str (mhc-date-format (or default (mhc-date-now)) "%04d/%02d" yy mm))) (while (null ret) (setq month-str (read-from-minibuffer (concat prompt "(yyyy/mm) : ") month-str nil nil 'mhc-month-hist)) (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)" month-str) (setq ret (mhc-date-new (string-to-number (match-string 1 month-str)) (string-to-number (match-string 2 month-str)) 1 t)))) ret)) (defconst mhc-input-time-regex "^\\([0-9]+\\):\\([0-9]+\\)$") (defvar mhc-subject-hist nil) (defun mhc-input-subject (&optional prompt default) (interactive) (read-from-minibuffer (or prompt "Subject: ") (or default "") nil nil 'mhc-subject-hist)) (defvar mhc-location-hist nil) ;; (defun mhc-input-location (&optional prompt default) ;; (interactive) ;; (read-from-minibuffer (or prompt "Location: ") ;; (or default "") ;; nil nil 'mhc-location-hist)) (defun mhc-input-location (&optional prompt default) (mhc-minibuf-read "Location: " default (current-buffer) (mhc-guess-location) 0 (function mhc-minibuf/location-to-string) "[^ ]")) (defvar mhc-category-hist nil) (if (fboundp 'completing-read-multiple) (defun mhc-input-category (&optional prompt default) (interactive) (let ((completion-ignore-case t) (table (nconc (delete '("Todo") (delete '("Done") (mapcar (lambda (x) (list (car x))) mhc-category-face-alist))) (list '("Todo") '("Done"))))) (completing-read-multiple (or prompt "Category: ") ;PROMPT table nil ;PREDICATE nil ;REQUIRE-MATCH default ;INITIAL-INPUT 'mhc-category-hist ;HIST ))) (defun mhc-input-category (&optional prompt default) (interactive) (let (in) (and default (listp default) (setq default (mapconcat 'identity default " "))) (if (string= "" (setq in (read-from-minibuffer (or prompt "Category: ") (or default "") nil nil 'mhc-category-hist))) nil (mhc-misc-split in))))) (defvar mhc-recurrence-tag-hist nil) (defun mhc-input-recurrence-tag (&optional prompt default) (interactive) (read-from-minibuffer (or prompt "Recurrence Tag: ") (or default "") nil nil 'mhc-recurrence-tag-hist)) (defvar mhc-alarm-hist nil) (defun mhc-input-alarm (&optional prompt default) (interactive) (read-from-minibuffer (or prompt "Alarm: ") (or default mhc-default-alarm) nil nil 'mhc-alarm-hist)) (provide 'mhc-minibuf) ;;; 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-minibuf.el ends here mhc-1.1.1/emacs/mhc-misc.el000066400000000000000000000216321262546231500154050ustar00rootroot00000000000000;;; mhc-misc.el -- miscellaneous functions for mhc. ;; Author: Yoshinari Nomura ;; ;; Created: 1997/10/12 ;; Revised: $Date: 2002/12/01 03:55:06 $ ;;; ;;; Commentay: ;;; ;;; ;;; Code: ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; string (defun mhc-misc-sub (str regex replace) (if (and (stringp str) (string-match regex str)) (concat (substring str 0 (match-beginning 0)) replace (substring str (match-end 0))) str)) (defun mhc-misc-gsub (str regex replace) (if (and (stringp str) (string-match regex str)) (concat (substring str 0 (match-beginning 0)) replace (mhc-misc-gsub (substring str (match-end 0)) regex replace)) str)) (defun mhc-misc-split (str &optional sep) (let ((ret ())) (while (string-match (or sep "[\t ]+") str) (setq ret (cons (substring str 0 (match-beginning 0)) ret)) (setq str (substring str (match-end 0)))) (nreverse (cons str ret)))) (defun mhc-misc-strip (str) (mhc-misc-sub (mhc-misc-sub str "^[\t ]+" "") "[\t ]+$" "")) (defun mhc-misc-substring-to-int (str pos) (cond ((stringp str) (string-to-number (substring str (match-beginning pos) (match-end pos)))) (t (string-to-number (buffer-substring (match-beginning pos) (match-end pos)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; file & path (defun mhc-misc-get-new-path (dir &optional record) "Return name for new schedule file on DIR." (let ((filename (cond ((and (stringp record) (file-exists-p record) (string-match "\\.mhc$" record)) (file-name-nondirectory record)) ((and record (mhc-record-id record)) (concat (mhc-record-id record) ".mhc"))))) (if filename ;; uses UUID format, so simply change the directory (expand-file-name filename dir) ;; make old-style number filename (mhc-misc-get-new-path-by-number dir)))) (defun mhc-misc-get-new-path-by-number (dir) "Return name for new schedule file on DIR." (let (dirent (max 0) (num nil)) (mhc-file-make-directory dir) (setq dirent (directory-files dir nil nil t)) (while dirent (or (string-match "[^0-9]" (car dirent)) (if (< max (setq num (string-to-number (car dirent)))) (setq max num))) (setq dirent (cdr dirent))) (expand-file-name (number-to-string (1+ max)) dir))) ;; ;; touch directory and files. ;; (defvar mhc-mtime-file ".mhc-mtime") (defun mhc-misc-get-mtime (obj) (let ((mtime-file (expand-file-name mhc-mtime-file obj))) (cond ((not (stringp obj)) nil) ((file-exists-p mtime-file) (nth 5 (file-attributes mtime-file))) ((file-exists-p obj) (nth 5 (file-attributes obj))) (t nil)))) (defun mhc-misc-touch-directory (dir) (let ((mtime-file (expand-file-name mhc-mtime-file dir))) (if (file-writable-p mtime-file) ;; (write-region (point-min) (point-min) mtime-file nil 'silence)) (write-region 1 2 mtime-file nil 'silence)) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; rectangle ;; ;; Does (current-column) count visible character only? ;; emacs 19.34, 20.4, 20.5 -- yes ;; emacs 19.28 -- no ;; xemacs -- no ;; (defvar mhc-misc-column-count-visible-only (and (not (featurep 'xemacs)) (string< "19.3" emacs-version))) (defun mhc-misc-move-to-column (column) "Move point to column COLUMN rigidly in the current line, considering invisible charracters." (if mhc-misc-column-count-visible-only () (beginning-of-line) (let* ((bol (point)) (vis (if (get-char-property bol 'invisible) (next-single-property-change bol 'invisible) bol))) (setq column (+ column (- vis bol))))) (if (< column (move-to-column column t)) (progn (delete-char -1) (insert ?\ )))) (defun mhc-misc-current-column () "Return current column in a visible field." (if mhc-misc-column-count-visible-only (current-column) (let* ((bol (save-excursion (beginning-of-line) (point))) (vis (if (get-char-property bol 'invisible) (next-single-property-change bol 'invisible) bol))) (- (current-column) (- vis bol))))) (defun mhc-misc-insert-rectangle (rectangle) (let ((lines rectangle) (insertcolumn (mhc-misc-current-column)) (first t)) ;; (push-mark) (while lines (or first (progn (forward-line 1) (or (bolp) (insert ?\n)) (mhc-misc-move-to-column insertcolumn))) (setq first nil) (if (looking-at "[^\r\n]+") (delete-region (point) (match-end 0))) (insert (car lines)) (setq lines (cdr lines))))) (defun mhc-misc-get-width () (let ((dw (* mhc-calendar-width 2)) (ww (window-width)) (fw (frame-width))) (cond ((> ww dw) ww) ((and (< (* ww 2) fw) (> (* ww 2) dw)) (* ww 2)) ((> fw dw) fw) (t dw)))) ;; read-passwd (defun mhc-misc-read-passwd (prompt) (let ((inhibit-input-event-recording t)) (if (fboundp 'read-passwd) (condition-case nil (read-passwd prompt) ;; If read-passwd causes an error, let's return "" so that ;; the password process will safely fail. (error "")) (let ((pass "") (c 0) (echo-keystrokes 0) (ociea cursor-in-echo-area)) (condition-case nil (progn (setq cursor-in-echo-area 1) (while (and (/= c ?\r) (/= c ?\n) (/= c ?\e) (/= c 7)) ;; ^G (message "%s%s" prompt (make-string (length pass) ?.)) (setq c (read-char-exclusive)) (cond ((char-equal c ?\C-u) (setq pass "")) ((or (char-equal c ?\b) (char-equal c ?\177)) ;; BS DELL ;; delete one character in the end (if (not (equal pass "")) (setq pass (substring pass 0 -1)))) ((< c 32) ()) ;; control, just ignore (t (setq pass (concat pass (char-to-string c)))))) (setq cursor-in-echo-area -1)) (quit (setq cursor-in-echo-area ociea) (signal 'quit nil)) (error ;; Probably not happen. Just align to the code above. (setq pass ""))) (setq cursor-in-echo-area ociea) (message "") (sit-for 0) pass)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Window stack (defvar mhc-misc-window-stack nil) (defun mhc-misc-window-push () (interactive) (setq mhc-misc-window-stack (cons (current-window-configuration) mhc-misc-window-stack))) (defun mhc-misc-window-pop () (interactive) (if mhc-misc-window-stack (set-window-configuration (car-safe mhc-misc-window-stack))) (setq mhc-misc-window-stack (cdr-safe mhc-misc-window-stack))) (defalias 'mhc-window-push 'mhc-misc-window-push) (defalias 'mhc-window-pop 'mhc-misc-window-pop) (eval-and-compile (autoload 'rfc2047-decode-string "rfc2047")) (defalias 'mhc-misc-decode-eword-string 'rfc2047-decode-string) (provide 'mhc-misc) ;;; 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-misc.el ends here mhc-1.1.1/emacs/mhc-parse.el000066400000000000000000000260261262546231500155660ustar00rootroot00000000000000;;; -*- mode: Emacs-Lisp; coding: utf-8 -*- ;; Author: Yoshinari Nomura , ;; TSUCHIYA Masatoshi ;; Created: 2000/04/30 ;; Revised: $Date$ ;;; Commentary: ;; This file is a part of MHC, and includes functions to parse ;; schedule headers. ;;; Code: (require 'mhc-logic) (require 'mhc-record) (require 'mhc-header) (require 'mhc-misc) (defvar mhc-parse/strict nil) (defun mhc-parse/continuous-lines () "ヘッダの継続行を処理して、内容のみを取り出す関数" (let (list) (skip-chars-forward " \t\n") (while (not (eobp)) (setq list (cons (buffer-substring-no-properties (point) (progn (end-of-line) (skip-chars-backward " \t") (point))) list)) (end-of-line) (skip-chars-forward " \t\n")) (mapconcat 'identity (nreverse list) " "))) (defun mhc-parse/day (record schedule) (mhc-logic-parse-day (mhc-schedule-condition schedule)) schedule) (defun mhc-parse/cond (record schedule) (mhc-logic-parse-cond (mhc-schedule-condition schedule)) schedule) (defun mhc-parse/duration (record schedule) (mhc-logic-parse-duration (mhc-schedule-condition schedule)) schedule) (defun mhc-parse/priority (record schedule) (if (looking-at mhc-logic/space-regexp) (goto-char (match-end 0))) (let ((content (buffer-substring (point) (progn (skip-chars-forward "0-9") (point))))) (if (looking-at mhc-logic/space-regexp) (goto-char (match-end 0))) (if (eobp) (mhc-schedule/set-priority schedule (if (eq (length content) 0) nil (string-to-number content))) (error "Parse ERROR !!!(at X-SC-Priority:)"))) schedule) (defun mhc-parse/subject (record schedule) (mhc-schedule/set-subject schedule (mhc-misc-decode-eword-string (mhc-parse/continuous-lines))) schedule) (defun mhc-parse/location (record schedule) (mhc-schedule/set-location schedule (mhc-misc-decode-eword-string (mhc-parse/continuous-lines))) schedule) (defconst mhc-parse/time-regexp "\\([012][0-9]\\):\\([0-5][0-9]\\)") (defun mhc-parse/time (record schedule) (let ((time (mhc-parse/continuous-lines)) begin end) (cond ((string-match (concat "^" mhc-parse/time-regexp "-" mhc-parse/time-regexp "$") time) (setq begin (+ (* 60 (string-to-number (match-string 1 time))) (string-to-number (match-string 2 time))) end (+ (* 60 (string-to-number (match-string 3 time))) (string-to-number (match-string 4 time))))) ((string-match (concat "^" mhc-parse/time-regexp "-?$") time) (setq begin (+ (* 60 (string-to-number (match-string 1 time))) (string-to-number (match-string 2 time))))) ((string-match (concat "^-" mhc-parse/time-regexp "$") time) (setq end (+ (* 60 (string-to-number (match-string 1 time))) (string-to-number (match-string 2 time))))) ((and mhc-parse/strict (not (string= "" time))) (error "Parse ERROR!!!(at X-SC-Time:)"))) (mhc-schedule/set-time schedule begin end)) schedule) ;; For backward compatibility. (defun mhc-parse/old-style-date (record schedule) (mhc-logic-parse-old-style-date (mhc-schedule-condition schedule)) (mhc-parse/time record schedule)) (defconst mhc-parse/alarm-regexp "^[0-9]+ \\(minute\\|hour\\|day\\)$") (defun mhc-parse/alarm (record schedule) (let ((alarm (mhc-parse/continuous-lines))) (unless (or (not mhc-parse/strict) (string-match mhc-parse/alarm-regexp alarm) (string= "" alarm)) (error "Parse ERROR!!! (at X-SC-Alarm:)")) (mhc-schedule/set-alarm schedule alarm)) schedule) (defun mhc-parse/category (record schedule) (let ((category (mhc-parse/continuous-lines))) (mhc-schedule/set-categories schedule (nconc (delq nil (mapcar (lambda (str) (and (stringp str) (downcase str))) (mhc-misc-split (mhc-misc-decode-eword-string category) "[ \t]+"))) (mhc-schedule-categories schedule)))) (mhc-logic/set-todo (mhc-schedule-condition schedule) (mhc-schedule-in-category-p schedule "todo")) schedule) (defun mhc-parse/recurrence-tag (record schedule) (mhc-schedule/set-recurrence-tag schedule (mhc-misc-decode-eword-string (mhc-parse/continuous-lines))) schedule) (defun mhc-parse/sequence (record schedule) (if (looking-at mhc-logic/space-regexp) (goto-char (match-end 0))) (let ((content (buffer-substring (point) (progn (skip-chars-forward "0-9") (point))))) (if (looking-at mhc-logic/space-regexp) (goto-char (match-end 0))) (if (eobp) (mhc-schedule/set-sequence schedule (if (eq (length content) 0) nil (string-to-number content))) (error "Parse ERROR !!!(at X-SC-Sequence:)"))) schedule) ;; FIXME: 要削除 (defun mhc-parse/next (record schedule) (let ((new (mhc-schedule-new record))) (if schedule (mhc-schedule/set-region-end schedule (point-min))) (mhc-schedule/set-region-start new (point-min)) new)) ;; FIXME: X-SC-Schedule の入れ子構造は、(mhc-db-add-exception-rule) の ;; 実装の都合上受け入れられないので、top level 以外の X-SC-Schedule は ;; 安全に無視される必要がある。 (defun mhc-parse/schedule (record schedule) (let ((buffer (current-buffer)) (start (point)) (end (point-max)) (schedule (mhc-schedule-new record))) (mhc-schedule/set-region-start schedule start) (mhc-schedule/set-region-start schedule end) (with-temp-buffer (insert-buffer-substring buffer start end) (goto-char (point-min)) (while (not (eobp)) (let ((start (point))) (if (skip-chars-forward " \t\n") (delete-region start (point)))) (while (if (eobp) nil (eq ?\\ (progn (end-of-line) (preceding-char)))) (delete-char -1) (forward-line)) (forward-line)) (goto-char (point-min)) (mhc-parse/internal-parser record schedule))) schedule) ;; FIXME: top level 以外の場所で記述された X-SC-Record-Id: は安全に無 ;; 視される必要があるが、現在の実装では何も考えずに上書きしてしまう。 (defun mhc-parse/record-id (record schedule) (mhc-record-set-id record (mhc-parse/continuous-lines)) schedule) ;; FIXME: top level とそれ以外の場所で許される header が異なるので、 ;; multi pass parser に組み替えるべきかも知れない。 (defun mhc-parse/internal-parser (record &optional schedule strict) "Internal parseser of schedule headers in this narrowed buffer." (let ((mhc-parse/strict strict) (case-fold-search t) func) (while (not (eobp)) (if (looking-at "\\([^ \t:]+\\):") (progn (setq func (mhc-header-parse-function (format "%s" (match-string 1)))) (mhc-header-goto-end) (if (fboundp func) (save-restriction (narrow-to-region (match-beginning 0) (point)) (goto-char (match-end 0)) (setq schedule (funcall func record (or schedule (if (memq func '(mhc-parse/schedule mhc-parse/next)) nil (mhc-parse/next record nil))))) (goto-char (point-max))))) ;; Always skip non-header lines. (forward-line 1)))) schedule) (defun mhc-parse-buffer (&optional record strict) "Parse schedule headers in this buffer." (unless record (setq record (mhc-record-new (buffer-file-name)))) (mhc-header-narrowing (let ((schedule (mhc-parse/internal-parser record nil strict))) (if schedule (mhc-schedule/set-region-end schedule (point))))) ;; 得られた構造を整理する (let (schedules sexp) ;; 現れた順序に直しておく (mhc-record-set-schedules record (nreverse (mhc-record-schedules record))) ;; 先頭のスケジュールをデフォルトとして参照して、欠けている要素を埋めておく (setq schedules (cdr (mhc-record-schedules record))) (while schedules (mhc-schedule-append-default (car schedules) (car (mhc-record-schedules record))) (setq schedules (cdr schedules))) ;; 各スケジュールの条件式を生成する (mhc-logic-compile-file record)) record) (defun mhc-parse-file (filename) "Parse schedules headers in the file, FILENAME." (with-current-buffer (mhc-get-buffer-create " *mhc-parse-file*") (delete-region (point-min) (point-max)) (mhc-insert-file-contents-as-coding-system mhc-default-coding-system filename) (mhc-parse-buffer (mhc-record-new filename)))) (defun mhc-parse-string (string) "Parse schedules headers in the file, STRING." (with-current-buffer (mhc-get-buffer-create " *mhc-parse-file*") (delete-region (point-min) (point-max)) (insert string) (mhc-parse-buffer))) (provide 'mhc-parse) ;;; 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-parse.el ends here. mhc-1.1.1/emacs/mhc-process.el000066400000000000000000000023661262546231500161330ustar00rootroot00000000000000(defvar mhc-process nil) (add-to-list 'process-coding-system-alist '("^mhc$" . utf-8)) (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)) (setq i (1+ i)) (accept-process-output mhc-process 0.5))) (read (buffer-substring (point-min) (1- (point-max)))))) (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")) (set-process-query-on-exit-flag mhc-process nil) mhc-process)) (provide 'mhc-process) mhc-1.1.1/emacs/mhc-ps.el000066400000000000000000001063401262546231500150740ustar00rootroot00000000000000;;; -*- mode: Emacs-Lisp; coding: utf-8 -*- ;; Author: TSUCHIYA Masatoshi ;; Hideyuki SHIRAI ;; Created: 2000/06/18 ;; Revised: $Date: 2004/05/06 16:35:12 $ ;;; Commentary: ;; This file is a part of MHC and includes functions to make ;; PostScrpit calendar. ;;; History: ;; Original PostScript program was written ;; by Patrick Wood in 1987. ;; ;; Shell stuff added by King Ables at Sep 3, 1987. ;; ;; Made pretty by tjt in 1988. ;; ;; Holiday and printer flag passing hacks added by ;; smann@june.cs.washington.edu in Dec 1988. ;; ;; Used the better looking version with 5 rows of days rather than 6 ;; hacked together with holiday and banner/footnotes added ;; by Joe Wood in Dec 1989. ;; ;; Fixed "-R" (didn't work at all; now it at least works on 8.5x11) ;; and also fixed handling of unrecognized arguments ;; by Jeff Mogul in Jan 1990. ;; ;; Japanized and improved handling holidays ;; by SUZUKI Shingo in Feb 2000. ;; ;; Stuffs rewritten with Emacs Lisp ;; by TSUCHIYA Masatoshi ;; in Jun 2000. ;;; Bugs: ;; This program doesn't work for months before 1753 (weird stuff ;; happened in September, 1752). ;;; Code: (require 'mhc) ;;; Customize variables: (defcustom mhc-ps-preview-command "gv" "*Command to preview PostScript calendar." :group 'mhc :type 'string) (defcustom mhc-ps-preview-command-arguments '() "*Argument of previewer" :group 'mhc :type '(repeat string)) (defcustom mhc-ps-print-command "lp" "*Command to print PostScript calendar." :group 'mhc :type 'string) (defcustom mhc-ps-print-command-arguments '() "*Argument of print command." :group 'mhc :type '(repeat string)) (defcustom mhc-ps-paper-type t "*Calendar paper type." :group 'mhc :type '(radio (const :tag "Landscape" t) (const :tag "Portrait" nil))) (defcustom mhc-ps-paper-fill-print nil "*Fill printing just in Landscape paper size." :group 'mhc :type 'boolean) (defcustom mhc-ps-truncate-lines nil "*Truncate line." :group 'mhc :type 'boolean) (defcustom mhc-ps-left-margin 2 "*Left margin of the each schedule." :group 'mhc :type 'integer) (defcustom mhc-ps-string-width 20 "*Width of the each schedule." :group 'mhc :type 'integer) (defcustom mhc-ps-string-column 7 "*Column of the each schedule." :group 'mhc :type 'integer) (defcustom mhc-ps-title-font "Times-Bold" "*PostScript Font used for title." :group 'mhc :type 'string) (defcustom mhc-ps-day-font "Helvetica-Bold" "*PostScript Font used for days." :group 'mhc :type 'string) (defcustom mhc-ps-event-font "Times-Roman" "*PostScript Font used for events." :group 'mhc :type 'string) (defcustom mhc-ps-japanese-font "Ryumin-Light-EUC-H" "*PostScript Font used for Japanese characters." :group 'mhc :type 'string) (defcustom mhc-ps-coding-system (if (boundp 'MULE) '*euc-japan*unix 'euc-japan-unix) "*Coding system of PostScript data." :group 'mhc :type 'symbol) (defcustom mhc-ps-save-directory "~/" "*Directory to save PostScript file." :group 'mhc :type 'directory) ;;; Internal Variables: (defconst mhc-ps/string "\ %! % PostScript program to draw calendar % Copyright \(C\) 1987 by Pipeline Associates, Inc. % Permission is granted to modify and distribute this free of charge. % The number after /month should be set to a number from 1 to 12. % The number after /year should be set to the year you want. % You can change the title and date fonts, if you want. % We figure out the rest. % This program won't produce valid calendars before 1800 due to the switch % from Julian to Gregorian calendars in September of 1752 wherever English % was spoken. %% For Japanese. Added by ichimal, 2000/2/6. %% Original code is generated by k2ps. /copyfont { % font-dic extra-entry-count copyfont font-dic 1 index maxlength add dict begin { 1 index /FID ne 2 index /UniqueID ne and {def}{pop pop} ifelse } forall currentdict end } bind def %% For Japanese. Added by ichimal, 2000/2/6. %% Original code is generated by k2ps. /narrowfont { % ASCIIFontName EUCFontName compositefont font' findfont dup /FontType get 0 eq { 12 dict begin % % 7+8 bit EUC font % 12 dict begin /EUCFont exch def /FontInfo \(7+8 bit EUC font\) readonly def /PaintType 0 def /FontType 0 def /FontMatrix matrix def % /FontName /Encoding \[ 16#00 1 16#20 { pop 0 } for 16#21 1 16#28 { 16#20 sub } for 16#29 1 16#2F { pop 0 } for 16#30 1 16#74 { 16#27 sub } for 16#75 1 16#FF { pop 0 } for \] def /FMapType 2 def EUCFont /WMode known { EUCFont /WMode get /WMode exch def } { /WMode 0 def } ifelse /FDepVector \[ EUCFont /FDepVector get 0 get \[ 16#21 1 16#28 {} for 16#30 1 16#74 {} for \] { 13 dict begin /EUCFont EUCFont def /UpperByte exch 16#80 add def % /FontName /FontInfo \(EUC lower byte font\) readonly def /PaintType 0 def /FontType 3 def /FontMatrix matrix def /FontBBox {0 0 0 0} def /Encoding \[ 16#00 1 16#A0 { pop /.notdef } for 16#A1 1 16#FE { 16#80 sub 16 2 string cvrs \(cXX\) dup 1 4 -1 roll putinterval cvn } for /.notdef \] def % /UniqueID % /WMode /BuildChar { gsave exch dup /EUCFont get setfont /UpperByte get 2 string dup 0 4 -1 roll put dup 1 4 -1 roll put dup stringwidth setcharwidth 0 0 moveto show grestore } bind def currentdict end /lowerbytefont exch definefont } forall \] def currentdict end /eucfont exch definefont exch findfont 1 copyfont dup begin /FontMatrix FontMatrix \[.83 0 0 1 0 0.05\] matrix concatmatrix def end /asciifont exch definefont exch /FDepVector \[ 4 2 roll \] def /FontType 0 def /WMode 0 def /FMapType 4 def /FontMatrix matrix def /Encoding \[0 1\] def /FontBBox {0 0 0 0} def currentdict end }{ pop findfont 0 copyfont } ifelse } def /month @MONTH@ def /year @YEAR@ def /titlefont /@TFONT@ def /dayfont /@DFONT@ def %% For Japanese. Changed by ichimal, 2000/2/6. %% Original code is generated by k2ps. %% /eventfont /@EFONT@ def /Courier-Ryumin /@EFONT@ /@JFONT@ narrowfont definefont pop /eventfont /Courier-Ryumin def /holidays \[ @HOLIDAYS@ \] def /lholidays \[ @LHOLIDAYS@ \] def /nholidays \[ @NHOLIDAYS@ \] def /schedules \[ @SCHEDULES@ \] def /lschedules \[ @LSCHEDULES@ \] def /nschedules \[ @NSCHEDULES@ \] def /Bannerstring \(@BANNER@\) def /Lfootstring \(@LFOOT@\) def /Rfootstring \(@RFOOT@\) def /Cfootstring \(@CFOOT@\) def % calendar names - change these if you don't speak english % \"August\", \"April\" and \"February\" could stand to be kerned even if you do /month_names \[ \(January\) \(February\) \(March\) \(April\) \(May\) \(June\) \(July\) \(August\) \(September\) \(October\) \(November\) \(December\) \] def /day_names \[ \(Sunday\) \(Monday\) \(Tuesday\) \(Wednesday\) \(Thursday\) \(Friday\) \(Saturday\) \] def % layout parameters - you can change these, but things may not look nice /daywidth 100 def /dayheight 95 def /titlefontsize 48 def /weekdayfontsize 10 def /datefontsize 24 def /footfontsize 20 def /topgridmarg 35 def /leftmarg 35 def /daytopmarg 14 def /dayleftmarg 5 def % layout constants - don't change these, things probably won't work /mainrows @WEEKS@ def /subrows 6 def % calendar constants - change these if you want a French revolutionary calendar /days_week 7 def /days_month \[ 31 28 31 30 31 30 31 31 30 31 30 31 \] def /isleap { % is this a leap year? year 4 mod 0 eq % multiple of 4 year 100 mod 0 ne % not century year 1000 mod 0 eq or and % unless it's a millenia } def /ndays { % number of days in this month days_month month 1 sub get month 2 eq % February isleap and { 1 add } if } def /weekday { % weekday \(range 0-6\) for integer date days_week mod } def /startday { % starting day-of-week for this month /off year 2032 sub def % offset from start of \"epoch\" off off 4 idiv add % number of leap years off 100 idiv sub % number of centuries off 1000 idiv add % number of millenia 4 add weekday days_week add % offset from Jan 1 2032 /off exch def 1 1 month 1 sub { /idx exch def days_month idx 1 sub get idx 2 eq isleap and { 1 add } if /off exch off add def } for off weekday % 0--Sunday, 1--monday, etc. } def /prtevent { % event-string day prtevent % print out an event /start startday def /day 2 1 roll def day start add 1 sub 7 mod daywidth mul day start add 1 sub 7 div truncate dayheight neg mul -5 numevents day start add get -10 mul add numevents day start add numevents day start add get 1 add put add 2 add moveto show } def /drawevents { % read in a file full of events; print % the events for this month /numevents \[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0\] def eventfont findfont 9 scalefont setfont 0 2 holidays length 2 sub { % for the \"Holidays\" dup 1 add holidays 2 1 roll get 2 1 roll holidays 2 1 roll get prtevent } for 0 2 schedules length 2 sub { % for the \"Schedules\" dup 1 add schedules 2 1 roll get 2 1 roll schedules 2 1 roll get prtevent } for } def % ------------------------------------------------------------------------ /prtnum { 3 string cvs show } def /center { % center string in given width /width exch def /str exch def width str stringwidth pop sub 2 div 0 rmoveto str show } def /centernum { exch 3 string cvs exch center } def /drawgrid { % draw calendar boxes titlefont findfont weekdayfontsize scalefont setfont currentpoint /y0 exch def /x0 exch def 0 1 days_week 1 sub { submonth 0 eq { x0 y0 moveto dup dup daywidth mul 40 rmoveto day_names exch get daywidth center } if x0 y0 moveto daywidth mul topgridmarg rmoveto 1.0 setlinewidth submonth 0 eq { /rowsused mainrows 1 sub def } { /rowsused subrows 1 sub def } ifelse 0 1 rowsused { gsave daywidth 0 rlineto 0 dayheight neg rlineto daywidth neg 0 rlineto closepath stroke grestore 0 dayheight neg rmoveto } for } for } def /drawnums { % place day numbers on calendar dayfont findfont datefontsize submonth 0 ne { 2.5 mul } if scalefont setfont /start startday def /days ndays def start daywidth mul dayleftmarg add daytopmarg rmoveto submonth 0 ne { dayleftmarg neg dayheight -2 div rmoveto } if 1 1 days { /day exch def gsave day start add weekday 0 eq { submonth 0 eq { .7 setgray } { holidaymark } ifelse } if day start add weekday 1 eq { submonth 0 eq { .7 setgray } { holidaymark } ifelse } if %% Added by ichimal, 2000.2 submonth 0 eq { 0 2 holidays length 2 sub { holidays 2 1 roll get day eq { .7 setgray exit } if } for } { nsubmonth 0 eq { 0 1 lholidays length 1 sub { lholidays exch get day eq { holidaymark exit } if } for 0 1 lschedules length 1 sub { lschedules exch get day eq { shedulemark exit } if } for } { 0 1 nholidays length 1 sub { nholidays exch get day eq { holidaymark exit } if } for 0 1 nschedules length 1 sub { nschedules exch get day eq { shedulemark exit } if } for } ifelse } ifelse submonth 0 eq { day prtnum } { day daywidth centernum } ifelse grestore day start add weekday 0 eq { currentpoint exch pop dayheight sub 0 exch moveto submonth 0 eq { dayleftmarg 0 rmoveto } if } { daywidth 0 rmoveto } ifelse } for } def /holidaymark { % tiny holiday mark gsave 0 dayheight 2 div daytopmarg add 5 add rmoveto daywidth 0 rlineto 0 dayheight neg rlineto daywidth neg 0 rlineto .9 setgray closepath fill grestore } def /shedulemark { % tiny shedule mark gsave 80 60 rmoveto 10 0 rlineto 0 -10 rlineto -10 0 rlineto 0 10 rlineto closepath .0 setgray fill grestore } def /drawfill { % place fill squares on calendar /start startday def /days ndays def currentpoint /y0 exch def /x0 exch def submonth 0 eq { usefirst { /fillstart 2 def } { /fillstart 0 def } ifelse } { /fillstart 0 def } ifelse fillstart daywidth mul topgridmarg rmoveto 1.0 setlinewidth fillstart 1 start 1 sub { gsave .9 setgray daywidth 0 rlineto 0 dayheight neg rlineto daywidth neg 0 rlineto closepath fill grestore daywidth 0 rmoveto } for x0 y0 moveto submonth 0 ne { /lastday subrows days_week mul def days_week 1 sub daywidth mul -440 rmoveto } { /lastday mainrows days_week mul 2 sub fillstart add def days_week 3 sub fillstart add daywidth mul @FOFFSET@ dayheight add rmoveto } ifelse lastday -1 ndays start 1 add add { /day exch def gsave .9 setgray daywidth 0 rlineto 0 dayheight neg rlineto daywidth neg 0 rlineto closepath fill grestore day weekday 1 eq { submonth 0 ne { x0 y0 moveto days_week 1 sub daywidth mul -440 dayheight add rmoveto } { x0 y0 moveto days_week 1 sub daywidth mul @FOFFSET@ dayheight add rmoveto } ifelse } { daywidth neg 0 rmoveto } ifelse } for } def /usefirst { % are last two boxes used by days? start ndays add mainrows days_week mul 3 sub gt start 2 ge and mainrows 6 eq or } def /calendar { titlefont findfont titlefontsize scalefont setfont 0 60 moveto /month_name month_names month 1 sub get def month_name show /yearstring year 10 string cvs def daywidth days_week mul yearstring stringwidth pop sub 60 moveto yearstring show eventflag { % Show a centered Banner if any at the Top daywidth days_week mul 2 div Bannerstring stringwidth pop 2 div sub 60 moveto Bannerstring show % Show footnotes left-center-right eventfont findfont footfontsize scalefont setfont /bottomrow { dayheight mainrows mul 5 sub neg } def 0 bottomrow moveto Lfootstring show daywidth days_week mul Rfootstring stringwidth pop sub bottomrow moveto Rfootstring show daywidth days_week mul Cfootstring stringwidth pop sub 2 div bottomrow moveto Cfootstring show } if 0 -5 moveto drawnums 0 -5 moveto drawfill eventflag { 0 0 moveto drawevents } if 0 -5 moveto drawgrid } def /eventflag true def @SCALE@ scale @ROTATE@ rotate @TRANSLATE@ translate /submonth 0 def calendar /eventflag false def month 1 sub 0 eq { /lmonth 12 def /lyear year 1 sub def } { /lmonth month 1 sub def /lyear year def } ifelse month 1 add 13 eq { /nmonth 1 def /nyear year 1 add def } { /nmonth month 1 add def /nyear year def } ifelse usefirst { 0 30 translate } { days_week 2 sub daywidth mul -350 translate } ifelse /submonth 1 def /nsubmonth 0 def /year lyear def /month lmonth def gsave .138 .138 scale 12 -120 translate calendar grestore /submonth 1 def /nsubmonth 1 def /year nyear def /month nmonth def daywidth 0 translate gsave .138 .138 scale 12 -120 translate calendar grestore showpage ") (defconst mhc-ps/replace-table '(("@MONTH@" . (format "%d" month)) ("@YEAR@" . (format "%d" year)) ("@TFONT@" . mhc-ps-title-font) ("@DFONT@" . mhc-ps-day-font) ("@EFONT@" . mhc-ps-event-font) ("@JFONT@" . mhc-ps-japanese-font) ("@HOLIDAYS@" . holidays-buffer) ("@SCHEDULES@" . schedules-buffer) ("@LHOLIDAYS@" . last-holidays-buffer) ("@LSCHEDULES@" . last-schedules-buffer) ("@NHOLIDAYS@" . next-holidays-buffer) ("@NSCHEDULES@" . next-schedules-buffer) ("@WEEKS@" . (number-to-string weeks)) ("@FOFFSET@" . (if (eq weeks 6) "-535" "-440")) ("@BANNER@" . (user-login-name)) ("@LFOOT@" . "") ("@RFOOT@" . "") ("@CFOOT@" . "") ("@SCALE@" . (cond ((and mhc-ps-paper-type (or (not mhc-ps-paper-fill-print) (eq weeks 6))) "0.85 0.85") (mhc-ps-paper-type "1.0 1.0") (t "0.75 0.75"))) ("@ROTATE@" . (if mhc-ps-paper-type "90" "0")) ("@TRANSLATE@" . (cond ((and mhc-ps-paper-type (or (not mhc-ps-paper-fill-print) (eq weeks 6))) "140 -120") (mhc-ps-paper-type "50 -120") (t "50 900"))))) (defun mhc-ps/weeks (date) (if (> (+ (mhc-date-dd (mhc-date-mm-last date)) (mhc-date-ww (mhc-date-mm-first date))) 35) 6 5)) (defun mhc-ps/substring (str width) (let ((clist (mhc-string-to-char-list str)) cw (i 0) (w 0) (ow 0) (spc ?\ )) (catch 'loop (while clist (setq w (+ w (char-width (car clist)))) (if (> w width) (throw 'loop nil)) (setq i (+ i (length (char-to-string (car clist))))) (setq clist (cdr clist)))) (substring str 0 i))) (defun mhc-ps/compose-subject (time subject margin) (let ((mstr (make-string margin ?\ )) pos str) ;; Delete characters to emphasize subject. (and (string-match "^\\*+[ \t\r\f\n]*" subject) (setq pos (match-end 0)) (string-match "[ \t\r\f\n]*\\*+$" subject) (setq subject (substring subject pos (match-beginning 0)))) (if time (setq str (concat time " " subject)) (setq str subject)) (cond ((<= (string-width str) mhc-ps-string-width) (list str)) (mhc-ps-truncate-lines (if (null time) (list (if (= (string-width (setq subject (mhc-ps/substring subject mhc-ps-string-width))) mhc-ps-string-width) (concat subject "$") subject)) (setq subject (concat mstr subject)) (if (= (string-width (setq subject (mhc-ps/substring subject mhc-ps-string-width))) mhc-ps-string-width) (setq subject (concat subject "$"))) (list time subject))) (t (with-temp-buffer (let ((fill-column mhc-ps-string-width) (left-margin 0) ret) (insert str) (fill-region (point-min) (point-max)) (goto-char (point-min)) (if (= (forward-line 1) 0) (let ((fill-column (- mhc-ps-string-width margin))) (fill-region (point) (point-max)))) (delete-region (goto-char (point-max)) (progn (skip-chars-backward " \t\n") (point))) (goto-char (point-min)) (setq ret (list (buffer-substring (point) (progn (end-of-line) (point))))) (forward-line 1) (while (not (eobp)) (setq ret (cons (concat mstr (buffer-substring (point) (progn (end-of-line) (point)))) ret)) (forward-line 1)) (nreverse ret))))))) (defun mhc-ps/encode-string (string) (let ((start 0) buf ch) (while (string-match "[()\\\\]" string start) (setq ch (aref string (match-beginning 0)) buf (cons (if (eq ch ?\() "\\(" (if (eq ch ?\)) "\\)" "\\\\")) (cons (substring string start (match-beginning 0)) buf)) start (match-end 0))) (eval (cons 'concat (nreverse (cons (substring string start) buf)))))) (defun mhc-ps/schedule-to-string (dayinfo schedule) (let ((begin (mhc-schedule-time-begin schedule)) (end (mhc-schedule-time-end schedule)) (day (mhc-day-day-of-month dayinfo))) (if (or begin end) (mapconcat (lambda (str) (format "%d ( %s)" day (mhc-ps/encode-string str))) (mhc-ps/compose-subject (concat (if begin (mhc-time-to-string begin) "") (if end (concat "-" (mhc-time-to-string end)) "")) (mhc-schedule-subject-as-string schedule) mhc-ps-left-margin) " ") (mapconcat (lambda (str) (format "%d ( %s)" day (mhc-ps/encode-string str))) (mhc-ps/compose-subject nil (mhc-schedule-subject-as-string schedule) mhc-ps-left-margin) " ")))) (defun mhc-ps/uniq-list (lst) (let ((tmp lst)) (while tmp (setq tmp (setcdr tmp (delete (car tmp) (cdr tmp)))))) lst) (defun mhc-ps/make-contents (file year month &optional category-predicate) (let ((weeks (mhc-ps/weeks (mhc-date-new year month 1))) (last-yymm (mhc-date-mm-- (mhc-date-new year month 1))) (next-yymm (mhc-date-mm++ (mhc-date-new year month 1))) schedules-buffer holidays-buffer last-schedules-buffer last-holidays-buffer next-schedules-buffer next-holidays-buffer) ;; this month (let ((dayinfo-list (mhc-db-scan-month year month))) (while dayinfo-list (let ((schedules (mhc-day-schedules (car dayinfo-list)))) (while schedules (when (funcall category-predicate (car schedules)) (if (mhc-schedule-in-category-p (car schedules) "holiday") (setq holidays-buffer (cons (mhc-ps/schedule-to-string (car dayinfo-list) (car schedules)) holidays-buffer)) (setq schedules-buffer (cons (mhc-ps/schedule-to-string (car dayinfo-list) (car schedules)) schedules-buffer)))) (setq schedules (cdr schedules)))) (setq dayinfo-list (cdr dayinfo-list)))) ;; last month (let ((dayinfo-list (mhc-date-let last-yymm (mhc-db-scan-month yy mm)))) (while dayinfo-list (let ((schedules (mhc-day-schedules (car dayinfo-list)))) (while schedules (when (funcall category-predicate (car schedules)) (if (mhc-schedule-in-category-p (car schedules) "holiday") (setq last-holidays-buffer (cons (number-to-string (mhc-day-day-of-month (car dayinfo-list))) last-holidays-buffer)) (setq last-schedules-buffer (cons (number-to-string(mhc-day-day-of-month (car dayinfo-list))) last-schedules-buffer)))) (setq schedules (cdr schedules)))) (setq dayinfo-list (cdr dayinfo-list)))) ;; next month (let ((dayinfo-list (mhc-date-let next-yymm (mhc-db-scan-month yy mm)))) (while dayinfo-list (let ((schedules (mhc-day-schedules (car dayinfo-list)))) (while schedules (when (funcall category-predicate (car schedules)) (if (mhc-schedule-in-category-p (car schedules) "holiday") (setq next-holidays-buffer (cons (number-to-string (mhc-day-day-of-month (car dayinfo-list))) next-holidays-buffer)) (setq next-schedules-buffer (cons (number-to-string (mhc-day-day-of-month (car dayinfo-list))) next-schedules-buffer)))) (setq schedules (cdr schedules)))) (setq dayinfo-list (cdr dayinfo-list)))) (setq last-schedules-buffer (mhc-ps/uniq-list last-schedules-buffer) last-holidays-buffer (mhc-ps/uniq-list last-holidays-buffer) next-schedules-buffer (mhc-ps/uniq-list next-schedules-buffer) next-holidays-buffer (mhc-ps/uniq-list next-holidays-buffer)) (setq schedules-buffer (mapconcat 'identity (nreverse schedules-buffer) " ") holidays-buffer (mapconcat 'identity (nreverse holidays-buffer) " ") last-schedules-buffer (mapconcat 'identity (nreverse last-schedules-buffer) " ") last-holidays-buffer (mapconcat 'identity (nreverse last-holidays-buffer) " ") next-schedules-buffer (mapconcat 'identity (nreverse next-schedules-buffer) " ") next-holidays-buffer (mapconcat 'identity (nreverse next-holidays-buffer) " ")) (with-temp-buffer (insert mhc-ps/string) (let ((case-fold-search nil) (alist mhc-ps/replace-table) key value) (while alist (setq key (car (car alist)) value (eval (cdr (car alist))) alist (cdr alist)) (goto-char (point-min)) (while (search-forward key nil t) (delete-region (- (point) (length key)) (point)) (insert value)))) (and file (mhc-write-region-as-coding-system mhc-ps-coding-system (point-min) (point-max) (expand-file-name file) nil 'nomsg)) (buffer-substring (point-min) (point-max))))) (defvar mhc-ps/process-file-alist '()) (defun mhc-ps/process (command arguments file buffer year month category-predicate) (mhc-setup) (message "PostScript creating...") (let ((contents (mhc-ps/make-contents file year month category-predicate))) (if (null contents) (message "No PostScript create.") (cond ((stringp command) (let ((process (apply (function start-process) (format "mhc-ps-%s" command) (mhc-get-buffer-create (format " *mhc-ps-%s*" command)) command (append arguments (list (expand-file-name file)))))) (set-process-coding-system process mhc-ps-coding-system mhc-ps-coding-system) (set-process-sentinel process 'mhc-ps/process-sentinel) (setq mhc-ps/process-file-alist (cons (cons process (expand-file-name file)) mhc-ps/process-file-alist)) (message "PostScript creating...done"))) ((eq command 'save) (message "PostScript saving (%s)...done" file)) ((eq command 'buffer) (pop-to-buffer (get-buffer-create buffer)) (kill-new contents) (let ((msg "Insert PostScript data ? (y or n) ") (char nil)) (message msg) (while (null char) (setq char (read-char-exclusive)) (if (or (eq ?y char) (eq ?\ char) (eq ?n char) (eq ?\177 char)) () (setq char nil) (message (concat "Please answer y or n. " msg)))) (if (or (eq ?y char) (eq ?\ char)) (save-excursion (insert contents) (message "PostScript insert to \"%s\"." buffer)) (message "PostScript data to the latest kill in the kill ring.")))))))) (defun mhc-ps/process-sentinel (process event) (let ((al (assoc process mhc-ps/process-file-alist))) (and (cdr al) (file-writable-p (cdr al)) (delete-file (cdr al))) (setq mhc-ps/process-file-alist (delete al mhc-ps/process-file-alist)))) ;;;###autoload (defun mhc-ps (&optional arg) "*Create PostScript calendar with selected method." (interactive "P") (let ((method 'preview) (date (or (mhc-current-date-month) (mhc-calendar-get-date))) year month char) (if (or arg (null date)) (setq date (mhc-input-month "Month: " date))) (setq year (mhc-date-yy date)) (setq month (mhc-date-mm date)) (message "pre(V)iew (default), (P)rint, (S)ave, (I)nsert buffer") (condition-case nil (setq char (read-char)) (error (setq char ?v))) (cond ((memq char '(?p ?P)) (mhc-ps-print year month mhc-default-category-predicate-sexp)) ((memq char '(?s ?S)) (mhc-ps-save year month (expand-file-name (mhc-date-format date "mhc%04d%02d.ps" yy mm) mhc-ps-save-directory) mhc-default-category-predicate-sexp)) ((memq char '(?i ?I)) (mhc-ps-insert-buffer year month (read-buffer "Insert buffer: " "*mhc-postscript*") mhc-default-category-predicate-sexp)) (t (mhc-ps-preview year month mhc-default-category-predicate-sexp))))) ;;;###autoload (defun mhc-ps-preview (year month &optional category-predicate) "*Preview PostScript calendar." (interactive (let* ((cdate (or (mhc-current-date-month) (mhc-calendar-get-date))) (date (mhc-input-month "Month: " cdate))) (list (mhc-date-yy date) (mhc-date-mm date) mhc-default-category-predicate-sexp))) (mhc-ps/process mhc-ps-preview-command mhc-ps-preview-command-arguments (expand-file-name (format "mhc%04d%02d.ps" year month) mhc-ps-save-directory) nil year month category-predicate)) ;;;###autoload (defun mhc-ps-print (year month &optional category-predicate) "*Print PostScript calendar." (interactive (let* ((cdate (or (mhc-current-date-month) (mhc-calendar-get-date))) (date (mhc-input-month "Month: " cdate))) (list (mhc-date-yy date) (mhc-date-mm date) mhc-default-category-predicate-sexp))) (mhc-ps/process mhc-ps-print-command mhc-ps-print-command-arguments (expand-file-name (format "mhc%04d%02d.ps" year month) mhc-ps-save-directory) nil year month category-predicate)) ;;;###autoload (defun mhc-ps-save (year month file &optional category-predicate) "*Save PostScript calendar." (interactive (let* ((cdate (or (mhc-current-date-month) (mhc-calendar-get-date))) (date (mhc-input-month "Month: " cdate)) (default (expand-file-name (mhc-date-format date "mhc%04d%02d.ps" yy mm) mhc-ps-save-directory)) (file (read-file-name "Save file: " default default))) (list (mhc-date-yy date) (mhc-date-mm date) file mhc-default-category-predicate-sexp))) (mhc-ps/process 'save nil file nil year month category-predicate)) ;;;###autoload (defun mhc-ps-insert-buffer (year month buffer &optional category-predicate) "*Insert PostScript calendar." (interactive (let* ((cdate (or (mhc-current-date-month) (mhc-calendar-get-date))) (date (mhc-input-month "Month: " cdate)) (buffer (read-buffer "Insert buffer: " "*mhc-postscript*"))) (list (mhc-date-yy date) (mhc-date-mm date) buffer mhc-default-category-predicate-sexp))) (mhc-ps/process 'buffer nil nil buffer year month category-predicate)) (provide 'mhc-ps) ;;; Copyright Notice of the PostScript programs. ;; Copyright (C) 1987 by Pipeline Associates, Inc. ;; Copyright (C) 2000 by SUZUKI Shingo . ;; Permission is granted to modify and distribute this free of charge. ;;; Copyright Notice of the Emacs Lisp programs. ;; 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-ps.el ends here. mhc-1.1.1/emacs/mhc-record.el000066400000000000000000000156631262546231500157370ustar00rootroot00000000000000;;; -*- mode: Emacs-Lisp; coding: utf-8 -*- ;; Author: Yoshinari Nomura , ;; TSUCHIYA Masatoshi ;; Created: 2000/05/15 ;; Revised: $Date$ ;;; Commentary: ;; This file is a part of MHC, and includes functions manipulate ;; MHC-RECORD structure. ;;; About MHC-RECORD structure: ;; Each MHC-RECORD structure is a cons cell has a construction as ;; follows: ;; ;; MHC-RECORD ::= ( KEY . VALUE ) ;; KEY ::= string ( represents file name of record ) ;; VALUE ::= [ ID SCHEDULES SEXP ] ;; ID ::= string ( represents unique id of recort ) ;; SCHEDULES ::= MHC-SCHEDULE* ;; SEXP ::= S expression to get schedule. ;;; Code: (require 'mhc-summary) (require 'mhc-file) (require 'mhc-draft) (require 'mhc-logic) (eval-when-compile (mhc-file-setup)) ;; Global Variable: (defcustom mhc-record-log-file "mhc-db.log" "*Log file of DB transaction." :group 'mhc :type 'file) ;; Internal Variable: (defvar mhc-record/id-counter 0) ;; Functions: (require 'org-id) (defun mhc-record-create-id () "Return unique ID string." (org-id-new)) (defun mhc-record-new (name &optional id schedules sexp) "Constructer of MHC-RECORD structure." (cons name (vector id schedules sexp))) (defmacro mhc-record/key (record) `(car ,record)) (defmacro mhc-record/value (record) `(cdr ,record)) (defmacro mhc-record-name (record) `(mhc-record/key ,record)) (defmacro mhc-record-id (record) `(aref (mhc-record/value ,record) 0)) (defmacro mhc-record-schedules (record) `(aref (mhc-record/value ,record) 1)) (defmacro mhc-record-sexp (record) `(aref (mhc-record/value ,record) 2)) (defmacro mhc-record-set-name (record name) `(setcar ,record ,name)) (defmacro mhc-record-set-id (record id) `(aset (mhc-record/value ,record) 0 ,id)) (defmacro mhc-record-set-schedules (record schedules) `(aset (mhc-record/value ,record) 1 ,schedules)) (defmacro mhc-record-set-sexp (record sexp) `(aset (mhc-record/value ,record) 2 ,sexp)) (defun mhc-record-copy (record) (cons (copy-sequence (mhc-record/key record)) (copy-sequence (mhc-record/value record)))) (defun mhc-record-subject (record) (catch 'found (let ((schedules (mhc-record-schedules record))) (while schedules (if (mhc-schedule-subject (car schedules)) (throw 'found (mhc-schedule-subject (car schedules)))) (setq schedules (cdr schedules)))))) (defun mhc-record-subject-as-string (record) (or (mhc-record-subject record) "(none)")) (defun mhc-record-occur-multiple-p (record) "Return t if RECORD occurs multiple times." (let ((schedules (mhc-record-schedules record))) (or (> (length schedules) 1) (mhc-logic-occur-multiple-p (mhc-schedule-condition (car schedules)))))) (defun mhc-record-write-buffer (record buffer &optional old-record) "Write BUFFER to RECORD." (let ((modify (file-exists-p (mhc-record-name record)))) (with-current-buffer buffer (mhc-draft-increment-sequence) (mhc-draft-translate) (mhc-file-make-directory (file-name-directory (mhc-record-name record))) (mhc-write-region-as-coding-system mhc-default-coding-system (point-min) (point-max) (mhc-record-name record) nil 'nomsg) (set-buffer-modified-p nil) (if modify (prog1 (mhc-file-modify (mhc-record-name record)) (mhc-record/append-log record 'modify)) (if old-record (prog2 (mhc-file-remove (mhc-record-name old-record)) (mhc-file-add (mhc-record-name record)) (mhc-record/append-log record 'modify)) (prog1 (mhc-file-add (mhc-record-name record)) (mhc-record/append-log record 'add))))))) (defun mhc-record-delete (record) (prog1 (mhc-file-remove (mhc-record-name record)) (mhc-record/append-log record 'delete))) (defun mhc-record/append-log (record status) (if mhc-record-log-file (let ((tmp-buffer (mhc-get-buffer-create " *mhc-record-append-log*"))) (with-current-buffer tmp-buffer (delete-region (point-min) (point-max)) (insert (format "%c %s %s %s %s\n" (cond ((eq status 'add) ?A) ((eq status 'delete) ?D) ((eq status 'modify) ?M) (t ??)) (format-time-string "%Y-%m-%d %T") (mhc-record-id record) (mhc-record-name record) (mhc-record-subject-as-string record))) (mhc-write-region-as-coding-system mhc-default-coding-system (point-min) (point-max) (expand-file-name mhc-record-log-file (expand-file-name "status/log" (mhc-config-base-directory))) 'append 'nomsg))))) (provide 'mhc-record) ;;; 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-record.el ends here mhc-1.1.1/emacs/mhc-schedule.el000066400000000000000000000173771262546231500162610ustar00rootroot00000000000000;;; -*- mode: Emacs-Lisp; coding: utf-8 -*- ;; Author: Yoshinari Nomura , ;; TSUCHIYA Masatoshi ;; Created: 1997/10/12 ;; Revised: $Date: 2004/05/06 16:35:12 $ ;;; Commentary: ;; This file is a part of MHC, and includes functions to manipulate ;; MHC-SCHEDULE structure. ;; About MHC-SCHEDULE structure: ;; Each MHC-SCHEDULE structure is a vector has a construction as ;; follows: ;; ;; MHC-SCHEDULE ::= [ RECORD CONDITION SUBJECT LOCATION TIME ALARM CATEGORIES PRIORITY REGION RECURRENCE-TAG SEQUENCE] ;; RECORD ::= MHC-RECORD ;; CONDITION ::= MHC-LOGIC ;; SUBJECT ::= string ( represents subject of schedule ) ;; LOCATION ::= string ( represents location of schedule ) ;; TIME ::= integer ( represents minutes of day from midnight ) ;; ALARM ::= string ;; CATEGORIES ::= CATEGORY* ;; CATEGORY ::= string ( represents category of schedule ) ;; PRIORITY ::= integer ;; REGION ::= ( START . END ) ;; START ::= integer ( represents start point of headers of schedule ) ;; END ::= integer ( represents end point of headers of schedule ) ;; RECURRENCE-TAG ::= string ;; SEQUENCE ::= integer ;;; Codes: (defun mhc-schedule-new (record &optional condition subject location time alarm categories priority region recurrence-tag sequence) "Constructor of MHC-SCHEDULE structure." (let ((new (vector record (or condition (mhc-logic-new)) subject location time alarm categories priority (or region (cons nil nil)) recurrence-tag sequence))) (mhc-record-set-schedules record (cons new (mhc-record-schedules record))) new)) (defsubst mhc-schedule-record (schedule) (if schedule (aref schedule 0))) (defsubst mhc-schedule-condition (schedule) (if schedule (aref schedule 1))) (defsubst mhc-schedule-subject (schedule) (if schedule (aref schedule 2))) (defsubst mhc-schedule-location (schedule) (if schedule (aref schedule 3))) (defsubst mhc-schedule-time (schedule) (if schedule (aref schedule 4))) (defsubst mhc-schedule-alarm (schedule) (if schedule (aref schedule 5))) (defsubst mhc-schedule-categories (schedule) (if schedule (aref schedule 6))) (defsubst mhc-schedule-priority (schedule) (if schedule (aref schedule 7))) (defsubst mhc-schedule-region (schedule) (if schedule (aref schedule 8))) (defsubst mhc-schedule-recurrence-tag (schedule) (if schedule (aref schedule 9))) (defsubst mhc-schedule-sequence (schedule) (if schedule (aref schedule 10))) (defmacro mhc-schedule-time-begin (schedule) `(car (mhc-schedule-time ,schedule))) (defmacro mhc-schedule-time-end (schedule) `(cdr (mhc-schedule-time ,schedule))) (defmacro mhc-schedule-region-start (schedule) `(car (mhc-schedule-region ,schedule))) (defmacro mhc-schedule-region-end (schedule) `(cdr (mhc-schedule-region ,schedule))) (defmacro mhc-schedule/set-subject (schedule subject) `(aset ,schedule 2 ,subject)) (defmacro mhc-schedule/set-location (schedule location) `(aset ,schedule 3 ,location)) (defmacro mhc-schedule/set-time (schedule begin end) `(aset ,schedule 4 (cons ,begin ,end))) (defmacro mhc-schedule/set-alarm (schedule alarm) `(aset ,schedule 5 ,alarm)) (defmacro mhc-schedule/set-categories (schedule categories) `(aset ,schedule 6 ,categories)) (defmacro mhc-schedule/set-priority (schedule priority) `(aset ,schedule 7 ,priority)) (defmacro mhc-schedule/set-region-start (schedule start) `(setcar (aref ,schedule 8) ,start)) (defmacro mhc-schedule/set-region-end (schedule end) `(setcdr (aref ,schedule 8) ,end)) (defmacro mhc-schedule/set-recurrence-tag (schedule tag) `(aset ,schedule 9 ,tag)) (defmacro mhc-schedule/set-sequence (schedule sequence) `(aset ,schedule 10 ,sequence)) (defun mhc-schedule-append-default (schedule default) (or (mhc-schedule-subject schedule) (mhc-schedule/set-subject schedule (mhc-schedule-subject default))) (or (mhc-schedule-location schedule) (mhc-schedule/set-location schedule (mhc-schedule-location default))) (or (mhc-schedule-time schedule) (not (mhc-schedule-time default)) (mhc-schedule/set-time schedule (mhc-schedule-time-begin default) (mhc-schedule-time-end default))) (or (mhc-schedule-alarm schedule) (mhc-schedule/set-alarm schedule (mhc-schedule-alarm default))) (or (mhc-schedule-categories schedule) (mhc-schedule/set-categories schedule (mhc-schedule-categories default))) (or (mhc-schedule-recurrence-tag schedule) (mhc-schedule/set-recurrence-tag schedule (mhc-schedule-recurrence-tag default)))) (defsubst mhc-schedule/time-to-string (minutes) (format "%02d:%02d" (/ minutes 60) (% minutes 60))) (defun mhc-schedule-time-as-string (schedule) (let ((time (mhc-schedule-time schedule))) (cond ((and (car time) (cdr time)) (concat (mhc-schedule/time-to-string (car time)) "-" (mhc-schedule/time-to-string (cdr time)))) ((car time) (mhc-schedule/time-to-string (car time))) ((cdr time) (concat "-" (mhc-schedule/time-to-string (cdr time)))) (t "")))) (defun mhc-schedule-subject-as-string (schedule) (or (mhc-schedule-subject schedule) "(none)")) (defun mhc-schedule-categories-as-string (schedule) (let ((categories (mhc-schedule-categories schedule))) (if categories (mapconcat (function identity) categories " ") ""))) (defun mhc-schedule-in-category-p (schedule category) (and schedule (if (listp category) (catch 'found (while category (if (member (downcase (car category)) (mhc-schedule-categories schedule)) (throw 'found t)) (setq category (cdr category)))) (member (downcase category) (mhc-schedule-categories schedule))))) (defun mhc-schedule-recurrence-tag-as-string (schedule) (or (mhc-schedule-recurrence-tag schedule) "")) (provide 'mhc-schedule) ;;; 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-schedule.el ends here. mhc-1.1.1/emacs/mhc-summary.el000066400000000000000000000712431262546231500161520ustar00rootroot00000000000000;;; mhc-summary.el --- Summary major mode in MHC. ;; Author: Yoshinari Nomura , ;; TSUCHIYA Masatoshi ;; Created: 2000/05/01 ;; Revised: $Date$ ;;; Commentary: ;; This file is a part of MHC. ;; This file consists of two parts: the first part contains MUA ;; backend functions, and the second part contains functions to make ;; summary contents. ;;; About MUA Backend: ;; In order to define new MUA backend, it is required to define these ;; methods. ;; ;; (mhc-foo-summary-filename) ;; Return the file name of the article on the current line in ;; this summary buffer. ;; ;; Define these methods appropriately, and put definitions as follows: ;; ;; (provide 'mhc-foo) ;; (put 'mhc-foo 'summary-filename 'mhc-foo-summary-filename) ;;; Code: (require 'mhc-vars) (require 'mhc-day) (require 'mhc-compat) (require 'mhc-schedule) (require 'bytecomp) ;;; Global Variables: (defcustom mhc-summary-language 'english "*Language of the summary." :group 'mhc :type '(choice (const :tag "English" english) (const :tag "Japanese" japanese))) (defcustom mhc-summary-use-cw nil "*If non-nil, insert `Calendar week number' instead of `Monday'." :group 'mhc :type '(choice (const :tag "Use" t) (const :tag "No" nil))) (defcustom mhc-use-week-separator t "*If non-nil insert separator in summary buffer." :group 'mhc :type 'boolean) (defcustom mhc-summary-separator ?- "*Character of the separator as 'mhc-use-week-separator'." :group 'mhc :type 'character) (defcustom mhc-use-month-separator t "*Insert separator in summary buffer for wide scope." :group 'mhc :type '(choice (const :tag "Insert (full width)" t) (integer :tag "Insert (number of width)") (const :tag "Not use" nil))) (defcustom mhc-summary-month-separator ?= "*Character of the separator as 'mhc-use-month-separator'." :group 'mhc :type 'character) (defcustom mhc-summary-string-conflict "[C]" "*String which indicates conflicts in summary buffer." :group 'mhc :type 'string) (defcustom mhc-summary-string-recurrence "[R]" "*String which indicates recurrences in summary buffer." :group 'mhc :type 'string) (defcustom mhc-summary-string-secret "[SECRET]" "*String which hides private subjects in summary buffer." :group 'mhc :type 'string) (defcustom mhc-use-icon t "*If non-nil, schedule icon is used." :group 'mhc :type 'boolean) (defcustom mhc-icon-path (if (fboundp 'locate-data-directory) (locate-data-directory "mhc")) "*Icon path for MHC." :group 'mhc :type 'directory) (defcustom mhc-icon-setup-hook nil "*A hook called after icon setup." :group 'mhc :type 'hook) (defcustom mhc-summary-line-format (if (eq mhc-summary-language 'japanese) "%Y%年%M%月%D%日%(%曜%) %b%e %c%i%s %p%l" "%Y%/%M%/%D%S%W %b%e %c%r%i%s %p%l") "*A format string for summary line of MHC. It may include any of the following format specifications which are replaced by the given information: %Y The year of the line if first line of the day. %M The month of the line if first line of the day. %D The day of the line if first line of the day. %W The weekday name of the line if first line of the day. %b Begin time. %e End time (includes '-'). %c Warning string for conflict (See also `mhc-summary-string-conflict'). %i The icon for the schedule. %s The subject of the schedule. %p The priority of the schedule. %l The location of the schedule. %r Indicator for recurrence-tag (See also `mhc-summary-string-recurrence'). %/ A slash character if first line of the day. %( A left parenthesis character if first line of the day. %) A right parenthesis character if first line of the day. %S A space with face. %年 The '年' of the line if first line of the day. %月 The '月' of the line if first line of the day. %日 The '日' of the line if first line of the day. %曜 The japaneses weekday name of the line if first line of the day. " :group 'mhc :type 'string) ;;; Internal Variable: (defconst mhc-summary-major-mode-alist '((mew-summary-mode . mhc-mew) (mew-virtual-mode . mhc-mew) (wl-folder-mode . mhc-wl) (wl-summary-mode . mhc-wl) (gnus-group-mode . mhc-gnus) (gnus-summary-mode . mhc-gnus))) ;; Internal Variables which are bound while inserting line: (defvar mhc-tmp-day-face nil "a face for the day.") (defvar mhc-tmp-dayinfo nil "a dayinfo for the day.") (defvar mhc-tmp-schedule nil "a schedule structure.") (defvar mhc-tmp-begin nil "begin time.") (defvar mhc-tmp-end nil "end time.") (defvar mhc-tmp-conflict nil "non-nil if conflicted schedule.") (defvar mhc-tmp-recurrence nil "non-nil if recurrence schedule.") (defvar mhc-tmp-first nil "non-nil if first schedule.") (defvar mhc-tmp-private nil "non-nil if private display mode.") (defvar mhc-tmp-priority nil "a priority of the schedule.") ;; For TODO. (defvar mhc-tmp-day nil "the day.") (defvar mhc-tmp-deadline nil "a schedule structure.") ;; Inserter (internal variable) (defvar mhc-summary/line-inserter nil) (defvar mhc-summary-line-format-alist '((?Y (mhc-summary/line-year-string) 'face mhc-tmp-day-face) (?/ (if mhc-tmp-first "/" " ") 'face mhc-tmp-day-face) (?S " " 'face mhc-tmp-day-face) (?M (mhc-summary/line-month-string) 'face mhc-tmp-day-face) (?D (mhc-summary/line-day-string) 'face mhc-tmp-day-face) (?W (mhc-summary/line-day-of-week-string) 'face mhc-tmp-day-face) (?b (if (null mhc-tmp-begin) (make-string 5 ? ) (format "%02d:%02d" (/ mhc-tmp-begin 60) (% mhc-tmp-begin 60))) 'face 'mhc-summary-face-time) (?e (if (null mhc-tmp-end) (make-string 6 ? ) (format "-%02d:%02d" (/ mhc-tmp-end 60) (% mhc-tmp-end 60))) 'face 'mhc-summary-face-time) (?c (if mhc-tmp-conflict (if (and (mhc-use-icon-p) (mhc-icon-exists-p "conflict")) t mhc-summary-string-conflict)) (if (and (mhc-use-icon-p) (mhc-icon-exists-p "conflict")) 'icon 'face) (if (and (mhc-use-icon-p) (mhc-icon-exists-p "conflict")) (list "conflict") 'mhc-summary-face-conflict)) (?r (if (and mhc-tmp-recurrence (not (string= "" mhc-tmp-recurrence))) (if (and (mhc-use-icon-p) (mhc-icon-exists-p "recurrence")) t mhc-summary-string-recurrence)) (if (and (mhc-use-icon-p) (mhc-icon-exists-p "recurrence")) 'icon 'face) (if (and (mhc-use-icon-p) (mhc-icon-exists-p "recurrence")) (list "recurrence") 'mhc-summary-face-recurrence)) (?p (if mhc-tmp-priority (format "[%d]" mhc-tmp-priority)) 'face (cond ((null mhc-tmp-priority) nil) ((>= mhc-tmp-priority 80) 'mhc-summary-face-sunday) ((>= mhc-tmp-priority 50) 'mhc-summary-face-saturday))) (?i (not mhc-tmp-private) 'icon (if (mhc-schedule-in-category-p mhc-tmp-schedule "done") (delete "todo" (copy-sequence (mhc-schedule-categories mhc-tmp-schedule))) (mhc-schedule-categories mhc-tmp-schedule))) (?s (mhc-summary/line-subject-string) 'face (if mhc-tmp-private (mhc-face-category-to-face "Private") (mhc-face-category-to-face (car (mhc-schedule-categories mhc-tmp-schedule))))) (?l (mhc-summary/line-location-string) 'face 'mhc-summary-face-location) (?\( (if mhc-tmp-first "(" " ") 'face mhc-tmp-day-face) (?\) (if mhc-tmp-first ")" " ") 'face mhc-tmp-day-face) (?年 (if mhc-tmp-first "年" (make-string 2 ? )) 'face mhc-tmp-day-face) (?月 (if mhc-tmp-first "月" (make-string 2 ? )) 'face mhc-tmp-day-face) (?日 (if mhc-tmp-first "日" (make-string 2 ? )) 'face mhc-tmp-day-face) (?曜 (mhc-summary/line-day-of-week-ja-string) 'face mhc-tmp-day-face)) "An alist of format specifications that can appear in summary lines. Each element is a list of following: \(SPEC STRING-EXP PROP-TYPE PROP-VALUE\) SPEC is a character for format specification. STRING is an expression to get string to insert. PROP-TYPE is an expression to get one of the two symbols `face' or `icon'. It indicates a type of the property to put on the inserted string. PROP-VALUE is the property value correspond to PROP-TYPE. ") (defvar mhc-summary/cw-separator nil) (defvar mhc-summary/cw-week nil) ;;; MUA Backend Functions: (defun mhc-summary/true (&rest args) "This is the dummy backend function, which always returns t." t) (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." (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) (mhc-insert-file-contents-as-coding-system mhc-default-coding-system 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) (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." (let (dayinfo) (goto-char (point-min)) (while (and (not (eobp)) (or (null (setq dayinfo (get-text-property (point) 'mhc-dayinfo))) (not (eq (mhc-day-date dayinfo) date)))) (goto-char (next-single-property-change (point) 'mhc-dayinfo))))) (defun mhc-summary-record (&optional mailer) "Return record on current line." (let ((filename (mhc-summary-filename))) (if filename (mhc-parse-file filename)))) ;;; Codes: (defsubst mhc-summary/make-string (count character) (make-string (max 4 count) character)) ;; xxxx 4 ? (defun mhc-summary/insert-separator (&optional char banner width) "Insert horizontal using CHAR in WIDTH. CHAR is '-' if not specified. default WIDTH is calculated from window size. If BANNER is set, it is printed on the horizontal line." (let ((hr (make-string (or width (- (mhc-misc-get-width) 2)) (or char ?-))) (bn (or banner "")) (bn-offset 4)) (mhc-face-put hr 'mhc-summary-face-separator) (mhc-face-put bn 'mhc-summary-face-cw) (insert (concat (substring hr 0 bn-offset) bn (substring hr (+ bn-offset (length bn)) -1) "\n")))) (defvar mhc-summary/today nil) (defun mhc-summary/insert-dayinfo (mhc-tmp-dayinfo mailer category-predicate secret) (let ((time-max -1) (schedules (mhc-day-schedules mhc-tmp-dayinfo)) (mhc-tmp-first t) mhc-tmp-begin mhc-tmp-end mhc-tmp-location mhc-tmp-schedule mhc-tmp-conflict mhc-tmp-recurrence mhc-tmp-priority next-begin displayed) (if schedules (progn (while schedules (if (funcall category-predicate (car schedules)) (progn (setq mhc-tmp-begin (mhc-schedule-time-begin (car schedules)) mhc-tmp-end (mhc-schedule-time-end (car schedules)) mhc-tmp-priority (mhc-schedule-priority (car schedules)) next-begin (if (car (cdr schedules)) (mhc-schedule-time-begin (car (cdr schedules)))) mhc-tmp-conflict (or (and mhc-tmp-end next-begin (< next-begin mhc-tmp-end)) (and mhc-tmp-begin time-max (< mhc-tmp-begin time-max))) mhc-tmp-recurrence (mhc-schedule-recurrence-tag (car schedules))) (if mhc-tmp-end (setq time-max (max mhc-tmp-end time-max))) (setq displayed t) (mhc-summary-insert-contents (car schedules) (and secret (mhc-schedule-in-category-p (car schedules) mhc-category-as-private)) 'mhc-summary-line-insert mailer) (setq mhc-tmp-first nil))) (setq schedules (cdr schedules))) (if (not displayed) (mhc-summary-insert-contents nil secret 'mhc-summary-line-insert mailer))) (mhc-summary-insert-contents nil secret 'mhc-summary-line-insert mailer)))) (defun mhc-summary-make-contents (dayinfo-list &optional from to mailer category-predicate secret) (let* ((sparse (or from to)) (from (or from (mhc-day-date (car dayinfo-list)))) (to (or to (mhc-day-date (car (last dayinfo-list))))) (date from) dayinfo (separator-format (and mhc-summary-use-cw mhc-use-week-separator (eq mhc-start-day-of-week 1) " CW %d "))) (while (mhc-date<= date to) (setq dayinfo (or (assoc date dayinfo-list) (and sparse (mhc-day-new date)))) (when dayinfo (mhc-summary/insert-dayinfo dayinfo (or mailer 'mhc-mua) (or category-predicate mhc-default-category-predicate-sexp) secret)) (setq date (mhc-date++ date)) ;; insert week separator (and sparse mhc-use-week-separator (eq (mhc-date-ww date) mhc-start-day-of-week) (mhc-summary/insert-separator mhc-summary-separator (and separator-format (format separator-format (mhc-date-cw date))))) ;; insert month separator (and sparse mhc-use-month-separator (eq (mhc-date-dd date) 1) (mhc-summary/insert-separator mhc-summary-month-separator))))) (defun mhc-summary/line-year-string () (if mhc-tmp-first (format "%4d" (mhc-day-year mhc-tmp-dayinfo)) (make-string 4 ? ))) (defun mhc-summary/line-month-string () (if mhc-tmp-first (format "%02d" (mhc-day-month mhc-tmp-dayinfo)) (make-string 2 ? ))) (defun mhc-summary/line-day-string () (if mhc-tmp-first (format "%02d" (mhc-day-day-of-month mhc-tmp-dayinfo)) (make-string 2 ? ))) (defun mhc-summary/line-day-of-week-string () (if mhc-tmp-first (let ((week (mhc-day-day-of-week mhc-tmp-dayinfo))) (if (and mhc-summary/cw-week (= week 1) ) (format "%3s" (format "w%d" (mhc-date-cw (mhc-day-date mhc-tmp-dayinfo)))) (aref ["Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"] week))) (make-string 3 ? ))) (defun mhc-summary/line-day-of-week-ja-string () (if mhc-tmp-first (let ((week (mhc-day-day-of-week mhc-tmp-dayinfo))) (if (and mhc-summary/cw-week(= week 1) ) (format "%2d" (mhc-date-cw (mhc-day-date mhc-tmp-dayinfo))) (aref ["日" "月" "火" "水" "木" "金" "土"] week))) (make-string 2 ? ))) (defun mhc-summary/line-subject-string () (if mhc-tmp-private (and mhc-tmp-schedule mhc-summary-string-secret) (or (mhc-schedule-subject mhc-tmp-schedule) ""))) (defun mhc-summary/line-location-string () (let ((location (mhc-schedule-location mhc-tmp-schedule))) (and (not mhc-tmp-private) location (> (length location) 0) (concat "[" location "]")))) ;;; Line format parsing (defmacro mhc-line-insert (string) `(and (stringp ,string) (insert ,string))) (defun mhc-line-parse-format (format spec-alist) (let ((f (mhc-string-to-char-list format)) inserter entry) (setq inserter (list 'let (list 'pos))) (while f (if (eq (car f) ?%) (progn (setq f (cdr f)) (if (eq (car f) ?%) (setq inserter (append inserter (list (list 'insert ?%)))) (setq entry (assq (car f) spec-alist)) (unless entry (error "Unknown format spec %%%c" (car f))) (setq inserter (append inserter (list (list 'setq 'pos (list 'point))) (list (list 'mhc-line-insert (nth 1 entry))) (and (nth 2 entry) (list (append (cond ((eq (eval (nth 2 entry)) 'face) (list 'put-text-property 'pos (list 'point) (list 'quote 'face) (nth 3 entry))) ((eq (eval (nth 2 entry)) 'icon) (list 'if (nth 1 entry) (list 'and (list 'mhc-use-icon-p) (list 'mhc-put-icon (nth 3 entry))))))))))))) (setq inserter (append inserter (list (list 'insert (car f)))))) (setq f (cdr f))) inserter)) (defmacro mhc-line-inserter-setup (inserter format alist) `(let (byte-compile-warnings) (setq ,inserter (byte-compile (list 'lambda () (mhc-line-parse-format ,format ,alist)))) (when (get-buffer "*Compile-Log*") (bury-buffer "*Compile-Log*")) (when (get-buffer "*Compile-Log-Show*") (bury-buffer "*Compile-Log-Show*")))) (defun mhc-summary-line-inserter-setup () "Setup MHC summary and line inserter." (interactive) (if (and (called-interactively-p 'interactive) (mhc-use-icon-p)) (call-interactively 'mhc-icon-setup)) (setq mhc-summary/cw-separator (and mhc-summary-use-cw mhc-use-week-separator (eq mhc-start-day-of-week 1))) (setq mhc-summary/cw-week (and mhc-summary-use-cw (not mhc-summary/cw-separator))) (mhc-line-inserter-setup mhc-summary/line-inserter mhc-summary-line-format mhc-summary-line-format-alist)) (defun mhc-summary-line-insert () "Insert summary line." (let ((mhc-tmp-day-face (cond ((mhc-day-holiday mhc-tmp-dayinfo) 'mhc-category-face-holiday) ((eq (mhc-day-day-of-week mhc-tmp-dayinfo) 0) 'mhc-summary-face-sunday) ((eq (mhc-day-day-of-week mhc-tmp-dayinfo) 6) 'mhc-summary-face-saturday) (t 'mhc-summary-face-default))) (pos (point))) (if (mhc-date= (mhc-day-date mhc-tmp-dayinfo) (mhc-date-now)) (setq mhc-tmp-day-face (mhc-face-get-today-face mhc-tmp-day-face))) (funcall mhc-summary/line-inserter) (put-text-property pos (point) 'mhc-dayinfo mhc-tmp-dayinfo))) (defvar mhc-summary-mode-map nil) ;; (unless mhc-summary-mode-map (setq mhc-summary-mode-map (make-sparse-keymap)) (define-key mhc-summary-mode-map " " 'mhc-summary-scroll-message-forward) (define-key mhc-summary-mode-map (kbd "DEL") 'mhc-summary-scroll-message-backward) (define-key mhc-summary-mode-map "." 'mhc-summary-display) (define-key mhc-summary-mode-map "\C-m" 'mhc-summary-scroll-message-line-forward) (define-key mhc-summary-mode-map "v" 'mhc-summary-toggle-display-message) (define-key mhc-summary-mode-map "g" 'mhc-goto-month) (define-key mhc-summary-mode-map "/" 'mhc-search) (define-key mhc-summary-mode-map ">" 'mhc-goto-next-month) (define-key mhc-summary-mode-map "N" 'mhc-goto-next-year) (define-key mhc-summary-mode-map "<" 'mhc-goto-prev-month) (define-key mhc-summary-mode-map "P" 'mhc-goto-prev-year) (define-key mhc-summary-mode-map "s" 'mhc-rescan-month) (define-key mhc-summary-mode-map "D" 'mhc-delete) (define-key mhc-summary-mode-map "c" 'mhc-set-default-category) (define-key mhc-summary-mode-map "?" 'mhc-calendar) (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) (define-key mhc-summary-mode-map "f" 'forward-char) (define-key mhc-summary-mode-map "b" 'backward-char) (define-key mhc-summary-mode-map "j" 'mhc-summary-display-next) (define-key mhc-summary-mode-map "k" 'mhc-summary-display-previous) (define-key mhc-summary-mode-map "l" 'forward-char) (define-key mhc-summary-mode-map "h" 'backward-char) ;; ) (defun mhc-summary-mode () "Major mode for MHC summary. \\{mhc-summary-mode-map}" (interactive) (setq major-mode 'mhc-summary-mode mode-name "MHC") (setq mode-line-buffer-identification (propertized-buffer-identification "MHC: %12b")) (set-buffer-modified-p nil) (setq buffer-read-only t) (setq inhibit-read-only nil) (setq truncate-lines t) (use-local-map mhc-summary-mode-map) (run-hooks 'mhc-summary-mode-hook)) (defun mhc-summary-buffer-p (&optional buffer) (if buffer (set-buffer buffer)) mhc-summary-buffer-current-date-month) (defun mhc-summary-current-date () (when (mhc-summary-buffer-p) (let ((dayinfo (get-text-property (point) 'mhc-dayinfo))) (or (and dayinfo (mhc-day-date dayinfo)) (save-excursion (end-of-line) (while (and (not (bobp)) (null dayinfo)) (or (setq dayinfo (get-text-property (point) 'mhc-dayinfo)) (forward-char -1))) (and dayinfo (mhc-day-date dayinfo))))))) (defvar mhc-summary-buffer-current-date-month nil "Indicate summary buffer's month. It is also used by mhc-summary-buffer-p") (make-variable-buffer-local 'mhc-summary-buffer-current-date-month) (defun mhc-summary-current-date-month () mhc-summary-buffer-current-date-month) (defalias 'mhc-current-date-month 'mhc-summary-current-date-month) (defun mhc-summary-display-message () (interactive) (save-selected-window (mhc-summary-display-article))) (defun mhc-summary-toggle-display-message () (interactive) (if (mhc-message-visible-p) (mhc-message-delete-windows) (mhc-summary-display-message))) (defvar mhc-message-file-name nil) (make-variable-buffer-local 'mhc-message-file-name) (defun mhc-message-set-file-name (file-name) (setq mhc-message-file-name file-name)) (defun mhc-message-visible-p (&optional file-name) "Return non-nil if MHC message is currently displaying, or nil if none." (and (get-buffer-window "*MHC message*") (or (null file-name) (save-selected-window (pop-to-buffer "*MHC message*") (and (stringp mhc-message-file-name) (string= mhc-message-file-name file-name)))))) (defun mhc-message-delete-windows () (delete-windows-on "*MHC message*")) (defalias 'mhc-summary-display 'mhc-summary-display-message) (defun mhc-summary-display-next () (interactive) (forward-line) (if (mhc-message-visible-p) (mhc-summary-display))) (defun mhc-summary-display-previous () (interactive) (forward-line -1) (if (mhc-message-visible-p) (mhc-summary-display))) (defun mhc-summary-scroll-message-line-forward () (interactive) (mhc-summary-scroll-message-forward 1)) (defun mhc-summary-scroll-message-forward (&optional lines) (interactive) (mhc-summary-scroll-message 'forward lines)) (defun mhc-summary-scroll-message-backward (&optional lines) (interactive) (mhc-summary-scroll-message 'backward lines)) (defun mhc-summary-scroll-message (direction &optional lines) (interactive) (if (mhc-message-visible-p (mhc-summary-filename)) (save-selected-window (pop-to-buffer "*MHC message*") (if (eq direction 'forward) (mhc-message-scroll-page-forward lines) (mhc-message-scroll-page-backward lines))) (mhc-summary-display-message))) (provide 'mhc-summary) ;;; 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-summary.el ends here. mhc-1.1.1/emacs/mhc-sync.el000066400000000000000000000127441262546231500154320ustar00rootroot00000000000000;;; -*- emacs-lisp -*- ;; mhc-sync.el -- mhc-sync (ruby script) interface ;; ;; Author: Hideyuki SHIRAI ;; ;; Created: 2000/06/12 ;; Revised: $Date: 2002/11/11 05:27:15 $ ;;; Commentary: ;; This file is a part of MHC, includes backend functions to ;; manipulate schedule files. ;;; Customize Variables: (defcustom mhc-sync-id nil "*Identical id of mhc-sync (-x option)." :group 'mhc :type 'string) (defcustom mhc-sync-remote nil "*Remote server repository of mhc-sync ([user@]remote.host[:dir])." :group 'mhc :type 'string) (defcustom mhc-sync-localdir nil "*Local repository directory of mhc-sync (-r option)." :group 'mhc :type 'string) (defcustom mhc-sync-coding-system (if (>= emacs-major-version 20) 'undecided '*autoconv*) "*Default coding system for process of mhc-sync." :group 'mhc :type 'symbol) ;;; Interanal variabiles: (defconst mhc-sync/passwd-regexp "password:\\|passphrase:\\|Enter passphrase") (defvar mhc-sync/process nil) (defvar mhc-sync/req-passwd nil) ;;; Code: (defun mhc-sync/backup-and-remove (file &optional offline) "Backend function to remove FILE." (let ((file (expand-file-name file)) (new-path (expand-file-name "trash" (mhc-config-base-directory)))) (or (file-directory-p new-path) (make-directory new-path)) (rename-file file (mhc-misc-get-new-path new-path file)))) (defun mhc-sync/start-process (&optional full) (cond ((not (and (stringp mhc-sync-remote) (stringp mhc-sync-id))) (message "No remote server specified.") nil) ((processp mhc-sync/process) (message "another mhc-sync running.") nil) (t (let ((buf (mhc-get-buffer-create " *mhc-sync*")) (ldir (expand-file-name (or mhc-sync-localdir "~/Mail/schedule")))) (mhc-window-push) (pop-to-buffer buf) (setq buffer-read-only nil) (erase-buffer) (setq buffer-read-only t) (message "mhc-sync...") (setq mhc-sync/req-passwd t) (setq mhc-sync/process (apply (function start-process) "mhc-sync" buf "mhc-sync" (list "-x" mhc-sync-id "-r" ldir mhc-sync-remote))) (set-process-coding-system mhc-sync/process mhc-sync-coding-system) (set-process-filter mhc-sync/process 'mhc-sync/filter) (set-process-sentinel mhc-sync/process 'mhc-sync/sentinel) (if (featurep 'xemacs) (while mhc-sync/process (accept-process-output)) (while mhc-sync/process (sit-for 0.1) (discard-input))) (sit-for 1) (mhc-window-pop) (or (and (mhc-summary-buffer-p) (mhc-rescan-month mhc-default-hide-private-schedules)) (and (mhc-calendar-p) (mhc-calendar-rescan))) t)))) (defun mhc-sync/filter (process string) (if (bufferp (process-buffer process)) (let ((obuf (buffer-name))) (unwind-protect (progn (set-buffer (process-buffer process)) (let ((buffer-read-only nil) passwd) (goto-char (point-max)) (insert string) (cond ((and mhc-sync/req-passwd (string-match mhc-sync/passwd-regexp string)) (setq passwd (mhc-misc-read-passwd string)) (process-send-string process (concat passwd "\n"))) ((string-match "---------------------" string) (setq mhc-sync/req-passwd nil))))) (if (get-buffer obuf) (set-buffer obuf)))))) (defun mhc-sync/sentinel (process event) (when (bufferp (process-buffer process)) (pop-to-buffer (process-buffer process)) (let ((buffer-read-only nil)) (goto-char (point-max)) (insert "<<>>"))) (setq mhc-sync/process nil)) (provide 'mhc-sync) (put 'mhc-sync 'remove 'mhc-sync/backup-and-remove) (put 'mhc-sync 'sync 'mhc-sync/start-process) ;;; Copyright Notice: ;; 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-sync.el ends here mhc-1.1.1/emacs/mhc-vars.el000066400000000000000000000111071262546231500154210ustar00rootroot00000000000000;;; -*- mode: Emacs-Lisp; coding: utf-8 -*- ;; Author: Yoshinari Nomura , ;; Created: 2000/04/30 ;; Revised: $Date$ ;;; Commentary: ;; This file is a part of MHC, and includes defintions of global ;; confiration variables. ;;; Code: (require 'mhc-compat) (require 'mhc-process) ;;; Constants: (defconst mhc-version "mhc 1.1.1") ;; MHC_VERSION ;;; Configration Variables: (defgroup mhc nil "Various sorts of MH Calender." :group 'mail) (defcustom mhc-start-day-of-week 0 "*Day of the week as the start of the week." :group 'mhc :type '(choice (const :tag "Sunday" 0) (const :tag "Monday" 1) (const :tag "Tuesday" 2) (const :tag "Wednesday" 3) (const :tag "Thursday" 4) (const :tag "Friday" 5) (const :tag "Saturday" 6))) (defcustom mhc-insert-calendar t "*If non nil value, display vertical calender." :group 'mhc :type 'boolean) (defcustom mhc-vertical-calendar-length 3 "*Length of vertical calendar in summary buffer." :group 'mhc :type '(radio (integer :tag "Show length (current month is center)" 3) (cons (integer :tag " Show length" 3) (integer :tag "Length of before current" 1)))) (defcustom mhc-default-coding-system (if (>= emacs-major-version 20) 'utf-8-unix '*iso-2022-ss2-7*) "*Default coding system for MHC schedule files." :group 'mhc :type 'symbol) (defcustom mhc-default-hide-private-schedules nil "*If non-nil value, hide private schedules." :group 'mhc :type 'boolean) (defcustom mhc-category-as-private '("private") "*String list of private categories." :group 'mhc :type '(repeat (string :tag "Category"))) (defcustom mhc-default-network-status t "*Flag of the default network status." :group 'mhc :type 'boolean) (defcustom mhc-show-network-status t "*Flag to show the network status." :group 'mhc :type 'boolean) (defcustom mhc-use-cache t "*Flag to decide whether to use cache or not." :group 'mhc :type '(radio (const :tag "Use" t) (const :tag "Lazy check" 0) (const :tag "No use" nil))) (defcustom mhc-use-wide-scope nil "*Wide scope method in summary mode." :group 'mhc :type '(radio (const :tag "No use" nil) (const :tag "Complete week scope" week) (const :tag "Wide week scope" wide) (integer :tag "Scope wide size (>=0)" 3))) (defcustom mhc-default-alarm "5 minute" "*Default alarm string in making draft." :group 'mhc :type 'string) (defcustom mhc-ask-alarm nil "*If non-nil value, ask the alarm string in making draft." :group 'mhc :type 'boolean) (defun mhc-config-get-property (&optional dot-separated-key) (mhc-process-send-command (format "config --format=emacs %s" (or dot-separated-key "")))) (defun mhc-config-base-directory () (expand-file-name (mhc-config-get-property "general.repository"))) (provide 'mhc-vars) ;;; 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-vars.el ends here mhc-1.1.1/emacs/mhc.el000066400000000000000000001172471262546231500144640ustar00rootroot00000000000000;;; mhc.el --- Message Harmonized Calendaring system. ;; Description: Message Harmonized Calendaring system. ;; Author: Yoshinari Nomura ;; Created: 1994-07-04 ;; Version: 1.1.1 ;; Keywords: calendar ;; URL: http://www.quickhack.net/mhc ;; Package-Requires: ((calfw "20150703")) ;;; ;;; Commentary: ;;; ;; Mhc is the personal schedule management package. ;; Please visit http://www.quickhack.net/mhc for details. ;; ;; Minimum setup: ;; ;; (setq load-path ;; (cons "~/src/mhc/emacs" load-path)) ;; (autoload 'mhc "mhc") ;; ;; and M-x mhc ;;; Code: (eval-when-compile (require 'cl)) ;; For Mule 2.3 (eval-and-compile (when (boundp 'MULE) (require 'poe) (require 'pcustom))) (require 'mhc-vars) (require 'mhc-record) (require 'mhc-parse) (require 'mhc-file) (require 'mhc-process) (require 'mhc-db) (require 'mhc-message) (require 'mhc-misc) (require 'mhc-date) (require 'mhc-guess) (require 'mhc-schedule) (require 'mhc-face) (require 'mhc-calendar) (require 'mhc-draft) (cond ((eval-when-compile (and (not (featurep 'xemacs)) (>= emacs-major-version 21) (if (eq system-type 'windows-nt) ;; Meadow2 or NTEmacs21.3(and the later ;; version) supports the image feature. (or (featurep 'meadow) (>= emacs-major-version 22) (>= emacs-minor-version 3)) t))) (require 'mhc-e21)) ((eval-when-compile (condition-case nil (require 'bitmap) (error nil))) (require 'mhc-bm)) ((eval-when-compile (featurep 'xemacs)) (require 'mhc-xmas)) (t (defun mhc-use-icon-p ()))) (require 'mhc-minibuf) (require 'mhc-summary) (provide 'mhc) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Menu setup ;; (defvar mhc-mode-menu-spec '("Mhc" ["This month" mhc-goto-this-month t] ["Next month" mhc-goto-next-month t] ["Prev month" mhc-goto-prev-month t] ["Goto month" mhc-goto-month t] ["Goto date" mhc-goto-date t] ["Import" mhc-import t] ["Set category" mhc-set-default-category t] "----" ["Goto today" mhc-goto-today (mhc-summary-buffer-p)] ["Modify" mhc-modify (mhc-summary-buffer-p)] ["Edit" mhc-edit (mhc-summary-buffer-p)] ["Rescan" mhc-rescan-month (mhc-summary-buffer-p)] ["Delete" mhc-delete (mhc-summary-buffer-p)] ["Insert Schedule" mhc-insert-schedule (not buffer-read-only)] ["3 months Mini calendar" mhc-calendar t] ["Toggle 3 months calendar" mhc-calendar-toggle-insert-rectangle (mhc-summary-buffer-p)] "----" ["Reset" mhc-reset (mhc-summary-buffer-p)] ("Network" ["Online" mhc-file-toggle-offline mhc-file/offline] ["Offline" mhc-file-toggle-offline (not mhc-file/offline)]) "----" ("PostScript" ["PostScript" mhc-ps t] ["Preview" mhc-ps-preview t] ["Print" mhc-ps-print t] ["Save" mhc-ps-save t] ["Insert buffer" mhc-ps-insert-buffer t]))) (defvar mhc-prefix-key "\C-c." "*Prefix key to call MHC functions.") (defvar mhc-mode-map nil "Keymap for `mhc-mode'.") (defvar mhc-prefix-map nil "Keymap for 'mhc-key-prefix'.") (if (and mhc-mode-map mhc-prefix-map) () (setq mhc-mode-map (make-sparse-keymap)) (setq mhc-prefix-map (make-sparse-keymap)) (define-key mhc-prefix-map "g" 'mhc-goto-month) (define-key mhc-prefix-map "j" 'mhc-goto-date) (define-key mhc-prefix-map "." 'mhc-goto-this-month) (define-key mhc-prefix-map "n" 'mhc-goto-next-month) (define-key mhc-prefix-map "N" 'mhc-goto-next-year) (define-key mhc-prefix-map "p" 'mhc-goto-prev-month) (define-key mhc-prefix-map "P" 'mhc-goto-prev-year) (define-key mhc-prefix-map "f" 'mhc-goto-today) (define-key mhc-prefix-map "|" 'mhc-import) (define-key mhc-prefix-map "m" 'mhc-modify) (define-key mhc-prefix-map "e" 'mhc-edit) (define-key mhc-prefix-map "s" 'mhc-rescan-month) (define-key mhc-prefix-map "d" 'mhc-delete) (define-key mhc-prefix-map "c" 'mhc-set-default-category) (define-key mhc-prefix-map "i" 'mhc-insert-schedule) (define-key mhc-prefix-map "?" 'mhc-calendar) (define-key mhc-prefix-map "t" 'mhc-calendar-toggle-insert-rectangle) (define-key mhc-prefix-map "T" 'mhc-file-toggle-offline) (define-key mhc-prefix-map "R" 'mhc-reset) (define-key mhc-mode-map mhc-prefix-key mhc-prefix-map) (cond ((featurep 'xemacs) (define-key mhc-mode-map [(button1)] 'mhc-calendar-mouse-goto-date) (define-key mhc-mode-map [(button2)] 'mhc-calendar-mouse-goto-date-view)) (t (define-key mhc-mode-map [mouse-1] 'mhc-calendar-mouse-goto-date) (define-key mhc-mode-map [mouse-2] 'mhc-calendar-mouse-goto-date-view)))) (defvar mhc-mode nil "Non-nil when in mhc-mode.") (defcustom mhc-mode-hook nil "Hook run in when entering MHC mode." :group 'mhc :type 'hook) ;; Avoid warning of byte-compiler. (defvar mhc-mode-menu) (eval-and-compile (autoload 'easy-menu-add "easymenu")) (defun mhc-mode (&optional arg) "\ \\ MHC is the mode for registering schdule directly from email. Requres Mew or Wanderlust or Gnus. Key assinment on mhc-mode. \\[mhc-goto-this-month] Review the schedule of this month \\[mhc-goto-next-month] Review the schedule of next month \\[mhc-goto-prev-month] Review the schedule of previous month \\[mhc-goto-month] Jump to your prefer month \\[mhc-goto-date] Jump to your prefer date \\[mhc-rescan-month] Rescan the buffer of the month \\[mhc-goto-today] Move cursor to today (Only available reviewing this month) \\[mhc-import] Register the reviewing mail to schdule \\[mhc-delete] Delete the schdule on the cursor line \\[mhc-set-default-category] Edit the schdule on the cursor line \\[mhc-modify] Modify the schdule on the cursor line \\[mhc-edit] Create new schdule file \\[mhc-set-default-category] Change default category \\[mhc-calendar] Display 3 months mini calendar \\[mhc-calendar-toggle-insert-rectangle] Toggle 3 months calendar \\[mhc-reset] Reset MHC '\\[universal-argument]' prefix is available on using '\\[mhc-rescan-month]', '\\[mhc-goto-this-month]', '\\[mhc-goto-month]', '\\[mhc-goto-date]' , it works to assign the category (see below). The prefix arg '\\[mhc-goto-next-month]', '\\[mhc-goto-prev-month]' is also available and you can indicate the number of months to forward/back. Field names using by MHC. X-SC-Category: Space-seperated Keywords. You can set default category to scan. You can also indicate keywords by typing '\\[mhc-rescan-month]', '\\[mhc-goto-this-month]', '\\[mhc-goto-month]', '\\[mhc-goto-date]' with C-u. " (interactive "P") (make-local-variable 'mhc-mode) (setq mhc-mode (if (null arg) (not mhc-mode) (> (prefix-numeric-value arg) 0))) (when (featurep 'xemacs) (easy-menu-add mhc-mode-menu)) (force-mode-line-update) (run-hooks 'mhc-mode-hook)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; lexical analyzer part for category. ;; (defsubst mhc-expr/new () (vector nil nil nil nil)) (defsubst mhc-expr/token (expr-obj) ;; literal (aref expr-obj 0)) (defsubst mhc-expr/token-type (expr-obj) ;; symbolized (aref expr-obj 1)) (defsubst mhc-expr/string (expr-obj) ;; currently parsing string. (aref expr-obj 2)) (defsubst mhc-expr/set-token (expr-obj val) (aset expr-obj 0 val)) (defsubst mhc-expr/set-token-type (expr-obj val) (aset expr-obj 1 val)) (defsubst mhc-expr/set-string (expr-obj val) (aset expr-obj 2 val)) (defconst mhc-expr-token-type-alist '( ("[^!&|()\t \n]+" . symbol) ("!" . negop) ("&&" . andop) ("||" . orop) ("(" . lparen) (")" . rparen))) ;; Eat one token from parsing string in obj. (defun mhc-expr/gettoken (obj) (let ((string (mhc-expr/string obj)) (token-alist mhc-expr-token-type-alist) (token-type nil) (token nil)) ;; delete leading white spaces. (if (string-match "^[\t ]+" string) (setq string (substring string (match-end 0)))) (while (and token-alist (not token-type)) (if (string-match (concat "^" (car (car token-alist))) string) (setq token (substring string 0 (match-end 0)) string (substring string (match-end 0)) token-type (cdr (car token-alist)))) (setq token-alist (cdr token-alist))) (mhc-expr/set-token obj token) (mhc-expr/set-string obj string) (mhc-expr/set-token-type obj token-type) obj)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; recursive descent parser for category. ;; ;; ;; expression -> term ("||" term)* ;; (defun mhc-expr/expression (obj) (let ((ret (list (mhc-expr/term obj)))) (while (eq (mhc-expr/token-type obj) 'orop) (mhc-expr/gettoken obj) (setq ret (cons (mhc-expr/term obj) ret))) (if (= 1 (length ret)) (car ret) (cons 'or (nreverse ret))))) ;; ;; term -> factor ("&&" factor)* ;; (defun mhc-expr/term (obj) (let ((ret (list (mhc-expr/factor obj)))) (while (eq (mhc-expr/token-type obj) 'andop) (mhc-expr/gettoken obj) (setq ret (cons (mhc-expr/factor obj) ret))) (if (= 1 (length ret)) (car ret) (cons 'and (nreverse ret))))) ;; ;; factor -> "!"* category_name || "(" expression ")" ;; (defun mhc-expr/factor (obj) (let ((ret) (neg-flag nil)) (while (eq (mhc-expr/token-type obj) 'negop) (setq neg-flag (not neg-flag)) (mhc-expr/gettoken obj)) (cond ;; symbol ((eq (mhc-expr/token-type obj) 'symbol) (setq ret (list 'mhc-schedule-in-category-p 'schedule (mhc-expr/token obj))) (mhc-expr/gettoken obj)) ;; ( expression ) ((eq (mhc-expr/token-type obj) 'lparen) (mhc-expr/gettoken obj) (setq ret (mhc-expr/expression obj)) (if (not (eq (mhc-expr/token-type obj) 'rparen)) (error "Syntax error.")) (mhc-expr/gettoken obj)) ;; error (t (error "Syntax error.") ;; (error "Missing category name or `(' %s %s" ;; mhc-expr-token mhc-expr-parsing-string) )) (if neg-flag (list 'not ret) ret))) (defun mhc-expr-parse (string) (let ((obj (mhc-expr/new)) (ret nil)) (if (or (not string) (string= string "")) t (mhc-expr/set-string obj string) (mhc-expr/gettoken obj) (setq ret (mhc-expr/expression obj)) (if (mhc-expr/token obj) (error "Syntax Error.") ret)))) (defun mhc-expr-compile (string) (byte-compile `(lambda (schedule) ,(mhc-expr-parse string) ))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; category ;; (defvar mhc-default-category nil) (defvar mhc-default-category-predicate-sexp (mhc-expr-compile "")) (defvar mhc-default-category-hist nil) (defun mhc-set-default-category () (interactive) (setq mhc-default-category (read-from-minibuffer "Default Category: " (or mhc-default-category "") nil nil 'mhc-default-category-hist)) (setq mhc-default-category-predicate-sexp (mhc-expr-compile mhc-default-category)) (if (mhc-summary-buffer-p) (mhc-rescan-month))) ; (defun mhc-category-convert (lst) ; (let (ret inv) ; ;; preceding `!' means invert logic. ; (if (and lst (string-match "^!" (car lst))) ; (setq lst (cons (substring (car lst) (match-end 0)) (cdr lst)) ; inv t)) ; (cons inv lst))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; goto-* (defun mhc-goto-month (&optional date hide-private) "*Show schedules of specified month. If HIDE-PRIVATE, priavate schedules are suppressed." (interactive (list (mhc-input-month "Month ") (if mhc-default-hide-private-schedules (not current-prefix-arg) current-prefix-arg))) (mhc-scan-month date 'mhc-mua mhc-default-category-predicate-sexp hide-private)) (defvar mhc-goto-date-func 'mhc-goto-date-calendar) ; or mhc-goto-date-summary (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) (save-excursion (when win (select-window win)) (setq date (car (mhc-input-day "Date: " (mhc-date-now) (mhc-guess-date)))) (select-window owin)) (funcall mhc-goto-date-func date hide-private))) (defun mhc-goto-date-calendar (date hide-private) (mhc-calendar-goto-month date)) (defun mhc-goto-date-summary (date hide-private) ;; XXX mhc-calendar-scanのパクリです (mhc-goto-month date hide-private) (goto-char (point-min)) (if (mhc-summary-search-date date) (progn (beginning-of-line) (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." (interactive (list (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) (interactive "p") (mhc-goto-month (mhc-date-mm+ (or (mhc-current-date-month) (mhc-date-now)) arg) mhc-default-hide-private-schedules)) (defun mhc-goto-next-year (&optional arg) (interactive "p") (mhc-goto-next-month (* (or arg 1) 12))) (defun mhc-goto-prev-month (&optional arg) (interactive "p") (mhc-goto-next-month (- arg))) (defun mhc-goto-prev-year (&optional arg) (interactive "p") (mhc-goto-next-year (- arg))) (defun mhc-goto-today (&optional no-display) "*Go to the line of today's schedule or first day of month. Unless NO-DISPLAY, display it." (interactive "P") (let ((now (mhc-date-now)) (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)))) (defun mhc-rescan-month (&optional hide-private) "*Rescan schedules of this buffer. If HIDE-PRIVATE, private schedules are suppressed." (interactive (list (if mhc-default-hide-private-schedules (not current-prefix-arg) current-prefix-arg))) (move-to-column 1) (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-mua mhc-default-category-predicate-sexp hide-private) (goto-char (point-min)) (if (eq selective-display t) (re-search-forward "[\n\C-m]" nil 'end (1- line)) (forward-line (1- line)))) (beginning-of-line)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; make scan form. (defvar mhc-face-week-color-paint-thick nil) (defun mhc-expand-date-scope-backward (date scope) "Expand date scope backward involving the whole first week of month. DATE can be any date of the target month. SCOPE is one of: + 'week: Expand to involve the whole first week of month. + 'wide: Just like 'week, but if 'week does not expand nothing, it takes 7 days. + number: Expand N days backward." (let ((edge-date (mhc-date-mm-first date))) (cond ((integerp scope) (mhc-date- edge-date scope)) ((eq scope 'week) (mhc-date-ww-first edge-date mhc-start-day-of-week)) ((eq scope 'wide) (mhc-date-ww-first (mhc-date-- edge-date) mhc-start-day-of-week))))) (defun mhc-expand-date-scope-forward (date scope) "Expand date scope forward involving the whole last week of month. DATE can be any date of the target month. SCOPE is one of: + 'week: Expand to involve the whole last week of month. + 'wide: Just like 'week, but if 'week does not expand nothing, it takes 7 days. + number: Expand N days forward." (let ((edge-date (mhc-date-mm-last date))) (cond ((integerp scope) (mhc-date+ edge-date scope)) ((eq scope 'week) (mhc-date-ww-last edge-date mhc-start-day-of-week)) ((eq scope 'wide) (mhc-date-ww-last (mhc-date++ edge-date) mhc-start-day-of-week))))) (defun mhc-scan-month (date mailer category-predicate secret) "Make summary buffer for a month indicated by DATE. DATE can be any date of the target month. If MAILER is 'direct, insert scanned result into current buffer. CATEGORY-PREDICATE must be a function that can take one mhc-schedule argument and return a boolean value indicates opacity of the article. If SECRET is non-nil, hide articles those categories are listed in ``mhc-category-as-private''." (let* ((from (mhc-date-mm-first date)) (to (mhc-date-mm-last date)) (today (mhc-date-now)) ;; 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) (setq mhc-summary-buffer-current-date-month (mhc-date-mm-first date))) (when mhc-use-wide-scope (setq from (mhc-expand-date-scope-backward date mhc-use-wide-scope)) (setq to (mhc-expand-date-scope-forward date mhc-use-wide-scope))) (message "%s" (mhc-date-format date "Scanning %04d/%02d..." yy mm)) (mhc-summary-make-contents dayinfo-list from to mailer category-predicate secret) (unless (eq 'direct mailer) (when mhc-insert-calendar (mhc-calendar-insert-rectangle-at date (- (mhc-misc-get-width) mhc-calendar-width) mhc-vertical-calendar-length dayinfo-list)) (mhc-summary-mode) (mhc-mode 1) (setq mhc-summary-buffer-current-date-month (mhc-date-mm-first date)) (mhc-goto-today t) (message "%s" (mhc-date-format date "Scanning %04d/%02d...done" yy mm))))) (defun mhc-search (string &optional subject-only) "Search events by STRING. If SUBJECT-ONLY is non-nil, it will search only on X-SC-Subject:" (interactive "sSearch: \nP") (let* ((match (mhc-db-search :subject string :body (unless subject-only string)))) (if (null match) (message "No match") (mhc-scan match)))) (defun mhc-search-recurrence (recurrence-tag) "Search events by RECURRENCE-TAG." (interactive "sSearch recurrence-tag: ") (let* ((match (mhc-db-search :recurrence_tag recurrence-tag))) (if (null match) (message "No match") (mhc-scan match)))) (defun mhc-scan (events &optional insert-current-buffer clip-from clip-to) "Create mhc-summary buffer using EVENTS list. If INSERT-CURRENT-BUFFER is non-nil, insert contents in the current buffer. if CLIP-FROM and CLIP-TO are specified, clip EVENTS by date using these two params." (unless insert-current-buffer (mhc-summary-generate-buffer "MHC SEARCH")) (message "Listing MHC events...") (mhc-summary-make-contents events clip-from clip-to) (mhc-summary-mode) (goto-char (point-min)) (message "Listing MHC events...done")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; import, edit, delete, modify (defcustom mhc-input-sequences '(date time subject location category recurrence-tag alarm) "*Sequence of the inputs." :group 'mhc :type '(repeat (choice (const :tag "Date" date) (const :tag "Time" time) (const :tag "Subject" subject) (const :tag "Location" location) (const :tag "Category" category) (const :tag "Recurrence tag" recurrence-tag) (const :tag "Alarm" alarm)))) (defun mhc-edit (&optional import-buffer) "Edit a new schedule. If optional argument IMPORT-BUFFER is specified, import its content. Returns t if the importation was succeeded." (interactive (if current-prefix-arg (list (get-buffer (read-buffer "Import buffer: " (current-buffer)))))) (let ((draft-buffer (generate-new-buffer mhc-draft-buffer-name)) (current-date (or (mhc-summary-current-date) (mhc-calendar-get-date) (mhc-date-now))) (succeed t) msgp date time subject location category recurrence-tag priority alarm) (and (called-interactively-p 'interactive) (mhc-window-push)) (set-buffer draft-buffer) (if import-buffer (progn (insert-buffer-substring-no-properties (if (consp import-buffer) (cdr import-buffer) import-buffer)) (mhc-header-narrowing (setq msgp (or (mhc-header-get-value "from") (mhc-header-get-value "x-sc-subject"))) (mhc-header-delete-header (concat "^\\(" (mhc-regexp-opt mhc-draft-unuse-hdr-list) "\\)") 'regexp)) (mhc-highlight-message) (switch-to-buffer draft-buffer t))) (condition-case () (if import-buffer (progn (delete-other-windows-vertically) (goto-char (point-min)) (if (y-or-n-p "Do you want to import this article? ") (let* ((original (with-current-buffer (if (consp import-buffer) (cdr import-buffer) import-buffer) (mhc-parse-buffer))) (schedule (car (mhc-record-schedules original))) (inputs (copy-sequence mhc-input-sequences)) input) (while (setq input (car inputs)) (setq inputs (delq input inputs)) (cond ((eq input 'date) ;; input date (setq date (mhc-input-day "Date: " current-date (mhc-guess-date)))) ((eq input 'time) ;; input time (setq time (mhc-input-time "Time: " (mhc-schedule-time-as-string schedule) (mhc-guess-time (mhc-minibuf-candidate-nth-begin))))) ((eq input 'subject) ;; input subject (setq subject (mhc-input-subject "Subject: " (mhc-misc-sub (or (mhc-record-subject original) (mhc-header-narrowing (mhc-header-get-value "subject"))) "^\\(Re:\\)? *\\(\\[[^\]]+\\]\\)? *" "")))) ((eq input 'location) ;; input location (setq location (mhc-input-location "Location: " (mhc-schedule-location schedule)))) ((eq input 'category) ;; input category (setq category (mhc-input-category "Category: " (mhc-schedule-categories-as-string schedule)))) ;; input recurrence tag ((eq input 'recurrence-tag) (setq recurrence-tag (mhc-input-recurrence-tag "Recurrence Tag: " (mhc-schedule-recurrence-tag-as-string schedule)))) ;; input alarm ((eq input 'alarm) (if mhc-ask-alarm (setq alarm (mhc-input-alarm "Alarm: " mhc-default-alarm)))))) ;; (setq priority (mhc-schedule-priority schedule))) ;; Answer was no. (message "") ; flush minibuffer. (and (called-interactively-p 'interactive) (mhc-window-pop)) (setq succeed nil) (kill-buffer draft-buffer))) ;; No import (it succeeds). (let ((inputs (copy-sequence mhc-input-sequences)) input) (while (setq input (car inputs)) (setq inputs (delq input inputs)) (cond ((eq input 'date) (setq date (mhc-input-day "Date: " current-date))) ((eq input 'time) (setq time (mhc-input-time "Time: "))) ((eq input 'subject) (setq subject (mhc-input-subject "Subject: "))) ((eq input 'location) (setq location (mhc-input-location "Location: "))) ((eq input 'category) (setq category (mhc-input-category "Category: "))) ((eq input 'recurrence-tag) (setq recurrence-tag (mhc-input-recurrence-tag "Recurrence Tag: " (or subject "")))) ((eq input 'alarm) (if mhc-ask-alarm (setq alarm (mhc-input-alarm "Alarm: " mhc-default-alarm)))))))) ;; Quit. (quit (and (called-interactively-p 'interactive) (mhc-window-pop)) (setq succeed nil) (kill-buffer draft-buffer))) (if succeed (progn (switch-to-buffer draft-buffer t) (set-buffer draft-buffer) (if (and import-buffer msgp) (if (consp import-buffer) (mhc-draft-reedit-buffer (car import-buffer) 'original) ;; Delete candidate overlay if exists. (if mhc-minibuf-candidate-overlay (delete-overlay mhc-minibuf-candidate-overlay)) ;; Already imported to current buffer. (mhc-draft-reedit-buffer (current-buffer))) ;; Delete candidate overlay if exists. (if mhc-minibuf-candidate-overlay (delete-overlay mhc-minibuf-candidate-overlay)) (mhc-draft-setup-new)) (mhc-header-narrowing (mhc-header-delete-header (concat "^\\(" (mhc-regexp-opt (mhc-header-list)) "\\)") 'regexp)) (goto-char (point-min)) (insert "X-SC-Subject: " subject "\nX-SC-Location: " location "\nX-SC-Day: " (mapconcat (lambda (day) (mhc-date-format day "%04d%02d%02d" yy mm dd)) date " ") "\nX-SC-Time: " (mhc-time-range-to-string time) "\nX-SC-Category: " (mapconcat (function capitalize) category " ") "\nX-SC-Priority: " (if priority (number-to-string priority) "") "\nX-SC-Recurrence-Tag: " recurrence-tag "\nX-SC-Cond: " "\nX-SC-Duration: " "\nX-SC-Alarm: " (or alarm "") "\nX-SC-Record-Id: " (mhc-record-create-id) "\nX-SC-Sequence: 0\n") (goto-char (point-min)) (mhc-draft-mode) succeed)))) (defcustom mhc-default-import-original-article nil "*If non-nil value, import a schedule with MIME attachements." :group 'mhc :type 'boolean) (defun mhc-import (&optional get-original) "Import a schedule from the current article. The default action of this command is to import a schedule from the current article without MIME attachements. If you want to import a schedule including MIME attachements, call this command with a prefix argument GET-ORIGINAL. Set non-nil to `mhc-default-import-original-article', and the default action of this command is changed to the latter." (interactive (list (if mhc-default-import-original-article (not current-prefix-arg) current-prefix-arg))) (mhc-window-push) (unless (mhc-edit (mhc-summary-get-import-buffer get-original)) ;; failed. (mhc-window-pop))) (defun mhc-import-from-region (beg end) "Import a schedule from region BEG END." (interactive "r") (save-restriction (narrow-to-region beg end) (let ((str (buffer-substring beg end))) (mhc-import) (goto-char (point-max)) (insert str) (goto-char (point-min))))) (defun mhc-delete () "Delete the current schedule." (interactive) (mhc-delete-file (mhc-summary-record))) (defcustom mhc-delete-file-hook nil "Normal hook run after mhc-delete-file." :group 'mhc :type 'hook) (defun mhc-delete-file (record) (interactive) (if (not (and record (file-exists-p (mhc-record-name record)))) (message "File does not exist (%s)." (mhc-record-name record)) (if (not (y-or-n-p (format "Do you delete %s ?" (mhc-record-subject-as-string record)))) (message "Never mind..") (if (and (mhc-record-occur-multiple-p record) (not (y-or-n-p (format "%s has multiple occurrences. Delete all(=y) or one(=n) ?" (mhc-record-subject-as-string record))))) (mhc-db-add-exception-rule record (or (mhc-summary-current-date) (mhc-calendar-view-date))) (mhc-db-delete-file record)) (or (and (mhc-summary-buffer-p) (mhc-rescan-month mhc-default-hide-private-schedules)) (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-summary-current-date)) " ")) (time-list (mhc-time-range-to-string (mhc-input-time "Time: " (mhc-schedule-time-as-string (car (mhc-record-schedules (mhc-parse-string (mhc-draft-template))))))))) (mhc-window-push) (mhc-draft-new (mhc-draft-template) `(("x-sc-record-id" . ,(mhc-record-create-id)) ("x-sc-sequence" . 0) ("x-sc-time" . ,time-list) ("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 (mhc-insert-file-contents-as-coding-system mhc-default-coding-system 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) (mhc-modify-file (mhc-summary-filename))) (defcustom mhc-browse-x-url-function 'browse-url "*A function to browse URL." :group 'mhc :type 'function) (defun mhc-browse-x-url () "Browse X-URL field." (interactive) (let ((filename (mhc-summary-filename)) url) (with-temp-buffer (mhc-insert-file-contents-as-coding-system mhc-default-coding-system filename) (if (setq url (mhc-header-narrowing (or (mhc-header-get-value "x-uri") (mhc-header-get-value "x-url")))) (progn (funcall mhc-browse-x-url-function url) (message "X-URL browser started.")) (message "No X-URL field."))))) (defun mhc-modify-file (file) (if (and (stringp file) (file-exists-p file)) (let* ((name (format "*mhc draft %s*" (file-name-nondirectory file))) (buffer (get-buffer name))) (if (buffer-live-p buffer) (progn (message "Specified file(%s) has already been opened." file) (switch-to-buffer-other-window buffer)) (mhc-window-push) (set-buffer (setq buffer (get-buffer-create name))) (mhc-draft-reedit-file file) (set-buffer-modified-p nil) (switch-to-buffer-other-window buffer) (goto-char (point-min)) (mhc-draft-mode) (set (make-local-variable 'mhc-draft-buffer-file-name) file))) (message "Specified file(%s) does not exist." file))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; (Category . (parent-face fg bg)) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; misc. ;; ;; Convinient function when you want to insert your schedule into an ;; editing buffer. ;; (defun mhc-insert-schedule (&optional hide-private) (interactive "P") (set-mark (point)) (mhc-scan-month (mhc-input-month "Month ") 'direct ;; insert into current buffer. mhc-default-category-predicate-sexp hide-private) (exchange-point-and-mark)) (defun mhc-view-file () "View the schedule on the current line in View mode in another window." (interactive) (let ((path (mhc-summary-filename))) (view-file-other-window path))) ;;; Temporary buffers (defvar mhc-tmp-buffer-list nil) (defun mhc-get-buffer-create (name) "Return NAME buffer for temporary use of MHC." (let ((buf (get-buffer name))) (or (and buf (buffer-name buf)) (progn (setq buf (get-buffer-create name) mhc-tmp-buffer-list (cons buf mhc-tmp-buffer-list)) (buffer-disable-undo buf))) buf)) (defun mhc-kill-all-buffers () "Kill all buffers for temporary use of MHC." (while mhc-tmp-buffer-list (if (buffer-name (car mhc-tmp-buffer-list)) (kill-buffer (car mhc-tmp-buffer-list))) (setq mhc-tmp-buffer-list (cdr mhc-tmp-buffer-list)))) ;;; Setup and exit (defcustom mhc-setup-hook nil "Run hook after mhc-setup." :group 'mhc :type 'hook) (defvar mhc-setup-p nil) (defun mhc-setup () (unless mhc-setup-p (condition-case nil (progn (or (featurep 'easymenu) (require 'easymenu)) (easy-menu-define mhc-mode-menu mhc-mode-map "Menu used in mhc mode." mhc-mode-menu-spec) (easy-menu-define mhc-calendar-mode-menu mhc-calendar-mode-map "Menu used in mhc calendar mode." mhc-calendar-mode-menu-spec)) (error nil)) (or (assq 'mhc-mode minor-mode-alist) (setq minor-mode-alist (cons (list 'mhc-mode (mhc-file-line-status)) minor-mode-alist))) (or (assq 'mhc-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'mhc-mode mhc-mode-map) minor-mode-map-alist))) (mhc-face-setup) (mhc-calendar-setup) (mhc-file-setup) (setq mhc-default-category-predicate-sexp (mhc-expr-compile mhc-default-category)) (and (mhc-use-icon-p) (mhc-icon-setup)) (and mhc-calendar-link-hnf (mhc-calendar-hnf-face-setup)) (mhc-summary-line-inserter-setup) (mhc-guess-location-setup) (autoload 'mhc-ps "mhc-ps" "*Create PostScript calendar with selected method." t) (autoload 'mhc-ps-preview "mhc-ps" "*Preview PostScript calendar." t) (autoload 'mhc-ps-print "mhc-ps" "*Print PostScript calendar." t) (autoload 'mhc-ps-save "mhc-ps" "*Save PostScript calendar." t) (autoload 'mhc-ps-insert-buffer "mhc-ps" "*Insert PostScript calendar." t) (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) (message "MHC resetting...") (mhc-face-setup) (mhc-calendar-setup) (and (mhc-use-icon-p) (mhc-icon-setup)) (and mhc-calendar-link-hnf (mhc-calendar-hnf-face-setup)) (mhc-summary-line-inserter-setup) (mhc-guess-location-setup) (or (and (mhc-summary-buffer-p) (mhc-rescan-month mhc-default-hide-private-schedules)) (and (mhc-calendar-p) (mhc-calendar-rescan))) (message "MHC resetting...done")) (defcustom mhc-exit-hook nil "Run hook after mhc-exit." :group 'mhc :type 'hook) (defun mhc-exit () (setq mhc-setup-p nil) (mhc-file-exit) (mhc-kill-all-buffers) (run-hooks 'mhc-exit-hook)) (defun mhc-version () "Show mhc version." (interactive) (message mhc-version)) ;;; 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.el ends here mhc-1.1.1/icons/000077500000000000000000000000001262546231500134025ustar00rootroot00000000000000mhc-1.1.1/icons/Anniversary.xbm000066400000000000000000000004601262546231500164130ustar00rootroot00000000000000#define Anniversary_width 16 #define Anniversary_height 16 static unsigned char Anniversary_bits[] = { 0x40, 0x02, 0xc8, 0x16, 0xd8, 0x2f, 0x70, 0x56, 0xf8, 0x29, 0x88, 0x6f, 0x08, 0xbc, 0x08, 0xf0, 0x08, 0x90, 0x10, 0x10, 0x10, 0x0c, 0x10, 0x02, 0x90, 0x01, 0x48, 0x00, 0x48, 0x00, 0x78, 0x00, }; mhc-1.1.1/icons/Anniversary.xpm000066400000000000000000000011251262546231500164300ustar00rootroot00000000000000/* XPM */ static char * Anniversary_xpm[] = { "16 16 8 1", " s backgroundColor c None", ". c #FFFF659571C6", "X c #FFFFA699A699", "o c #00009E790000", "O c #FFFFBAEA5144", "+ c #FFFFFFFFFFFF", "@ c #000000000000", "# c #0000FFFF0000", " . X ", " o .OO XX X ", " + o.OO.XXXXX ", " +ooo+.. XXOO ", " @@@@o...o..O ", " @+++@@@o+...O", " @++++++@@#o+ ", " @++++++++@oo ", " @++++++++@+ o", " @+++++++@ ", " @+++++@@ ", " @++++@ ", " @++@@ ", " @++@ ", " @++@ ", " @@@@ "}; mhc-1.1.1/icons/Birthday.xbm000066400000000000000000000004471262546231500156650ustar00rootroot00000000000000#define Birthday_width 16 #define Birthday_height 16 static unsigned char Birthday_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x48, 0x12, 0x00, 0x00, 0x48, 0x12, 0x48, 0x12, 0x48, 0x12, 0xfc, 0x3f, 0x04, 0x20, 0x54, 0x2a, 0xfc, 0x3f, 0xfc, 0x3f, 0xfc, 0x3f, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00, }; mhc-1.1.1/icons/Birthday.xpm000066400000000000000000000010361262546231500156760ustar00rootroot00000000000000/* XPM */ static char * Birthday_xpm[] = { "16 16 6 1", " s backgroundColor c None", ". c #FFFFB6DA28A2", "X c #FFFFFFFF0000", "o c #00000000FFFF", "O c #000000000000", "+ c #FFFFFFFFFFFF", " ", " ", " . . . . ", " X X X X ", " o o o o ", " o o o o ", " o o o o ", " OOOOOOOOOOOO ", " O++++++++++O ", " O+O+O++O+O+O ", " OO.O.OO.O.OO ", " O..........O ", " O..........O ", " O..........O ", " OOOOOOOOOOOO ", " "}; mhc-1.1.1/icons/Business.xbm000066400000000000000000000004501262546231500157040ustar00rootroot00000000000000#define Business_width 16 #define Business_height 16 static unsigned char Business_bits[] = { 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0xe0, 0x07, 0x60, 0x06, 0xfc, 0x3f, 0xfc, 0x3f, 0xfc, 0x3f, 0xfc, 0x3f, 0xfc, 0x3f, 0xfc, 0x3f, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; mhc-1.1.1/icons/Business.xpm000066400000000000000000000010041262546231500157160ustar00rootroot00000000000000/* XPM */ static char * Business_xpm[] = { "16 16 5 1", " s backgroundColor c None", ". c #79E765954924", "X c #CF3CAAAA79E7", "o c #000000000000", "O c #FFFFCF3C9658", " ", " ...... ", " .XXXXXX. ", " .X. .X. ", " oooooooooooooo ", " oOOOOOOOOOOOOo ", " oOXXXXXXXXXX.o ", " oOXXXXXXXXXX.o ", " oOXXXXXXXXXX.o ", " oOXXXXXXXXXX.o ", " oOXXXXXXXXXX.o ", " oOXXXXXXXXXX.o ", " o............o ", " oooooooooooooo ", " ", " "}; mhc-1.1.1/icons/CheckBox.xbm000066400000000000000000000004471262546231500156050ustar00rootroot00000000000000#define CheckBox_width 16 #define CheckBox_height 16 static unsigned char CheckBox_bits[] = { 0x00, 0x00, 0xfe, 0x7f, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0xfe, 0x7f, 0x00, 0x00, }; mhc-1.1.1/icons/CheckBox.xpm000066400000000000000000000007541262546231500156240ustar00rootroot00000000000000/* XPM */ static char * CheckBox_xpm[] = { "16 16 5 1", " s backgroundColor c None", ". c #000000", "+ c #717171", "@ c #BEBEBE", "# c #E7E7E7", " ", " .............. ", " .++++++++++++@ ", " .+@@@@@@@@@@@# ", " .+@@@@@@@@@@@# ", " .+@@@@@@@@@@@# ", " .+@@@@@@@@@@@# ", " .+@@@@@@@@@@@# ", " .+@@@@@@@@@@@# ", " .+@@@@@@@@@@@# ", " .+@@@@@@@@@@@# ", " .+@@@@@@@@@@@# ", " .+@@@@@@@@@@@# ", " .+@@@@@@@@@@@# ", " @############# ", " "}; mhc-1.1.1/icons/CheckedBox.xbm000066400000000000000000000004551262546231500161150ustar00rootroot00000000000000#define CheckedBox_width 16 #define CheckedBox_height 16 static unsigned char CheckedBox_bits[] = { 0x00, 0x00, 0xfe, 0x7f, 0x02, 0x58, 0x02, 0x4c, 0x02, 0x4e, 0x22, 0x47, 0x72, 0x47, 0xf2, 0x43, 0xe2, 0x43, 0xc2, 0x43, 0x82, 0x41, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0xfe, 0x7f, 0x00, 0x00, }; mhc-1.1.1/icons/CheckedBox.xpm000066400000000000000000000010401262546231500161220ustar00rootroot00000000000000/* XPM */ static char * CheckedBox_xpm[] = { "16 16 6 1", " s backgroundColor c None", ". c #000000000000", "X c #FFFF00000000", "o c #71C671C671C6", "O c #E79DE79DE79D", "+ c #BEFBBEFBBEFB", " ", " ...........XX. ", " .oooooooooXXoO ", " .o+++++++XX++O ", " .o++++++XXX++O ", " .o++X++XXX+++O ", " .o+XXX+XXX+++O ", " .o+XXXXXX++++O ", " .o++XXXXX++++O ", " .o+++XXXX++++O ", " .o++++XX+++++O ", " .o+++++++++++O ", " .o+++++++++++O ", " .o+++++++++++O ", " OOOOOOOOOOOOOO ", " "}; mhc-1.1.1/icons/Conflict.xbm000066400000000000000000000003741262546231500156570ustar00rootroot00000000000000#define Conflict_width 16 #define Conflict_height 16 static char Conflict_bits[] = { 0x80,0x40,0x80,0x30,0xc1,0x19,0xfe,0x1f,0xfc,0x1f,0x78,0x3e,0x78,0xfe,0x7c, 0x3e,0x7f,0x1e,0xfc,0x1f,0x78,0x1e,0xf8,0x3f,0xf8,0x7f,0x9c,0x87,0x02,0x03, 0x00,0x04}; mhc-1.1.1/icons/Conflict.xpm000066400000000000000000000007201262546231500156700ustar00rootroot00000000000000/* XPM */ static char * Conflict_xpm[] = { "16 16 3 1", " s backgroundColor c None", ". c #FFFFFFFF0000", "X c #000000000000", " . . ", " . .. ", ". ... .. ", " ............ ", " ........... ", " ....XX..... ", " ....XX.......", " .....XX..... ", ".......XX.... ", " ........... ", " ....XX.... ", " ........... ", " ............ ", " ... .... .", " . .. ", " . "}; mhc-1.1.1/icons/Date.xbm000066400000000000000000000004031262546231500147640ustar00rootroot00000000000000#define Date_width 16 #define Date_height 14 static unsigned char Date_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x60, 0x1c, 0xf0, 0x3e, 0xf0, 0x3f, 0xf0, 0x3f, 0xf0, 0x1f, 0xf0, 0x1f, 0xe0, 0x0f, 0xc0, 0x07, 0xc0, 0x03, 0x80, 0x01, 0x00, 0x01, 0x00, 0x00, }; mhc-1.1.1/icons/Date.xpm000066400000000000000000000012171262546231500150060ustar00rootroot00000000000000/* XPM */ static char * Date_xpm[] = { "16 14 12 1", " s backgroundColor c None", ". c #FFFF00000000", "X c #FFFF0C300820", "o c #FFFF1C711861", "O c #FFFF28A22081", "+ c #FFFF3CF330C2", "@ c #FFFF49244103", "# c #FFFF59655144", "$ c #FFFF69A65965", "% c #FFFF79E769A6", "& c #FFFF861779E7", "* c #FFFF96588E38", " ", " ", " .. ... ", " XXXX XXXXX ", " oooooooooo ", " OOOOOOOOOO ", " +++++++++ ", " @@@@@@@@@ ", " ####### ", " $$$$$ ", " %%%% ", " && ", " * ", " "}; mhc-1.1.1/icons/Holiday.xbm000066400000000000000000000004441262546231500155050ustar00rootroot00000000000000#define Holiday_width 16 #define Holiday_height 16 static unsigned char Holiday_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x7f, 0x02, 0x40, 0x82, 0x41, 0xc2, 0x43, 0xe2, 0x47, 0xe2, 0x47, 0xc2, 0x43, 0x82, 0x41, 0x02, 0x40, 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, }; mhc-1.1.1/icons/Holiday.xpm000066400000000000000000000010351262546231500155200ustar00rootroot00000000000000/* XPM */ static char * Holiday_xpm[] = { "16 16 6 1", " s backgroundColor c None", ". c #000000000000", "X c #FFFFFFFFFFFF", "o c #FFFF96589658", "O c #FFFF4D344924", "+ c #FFFF00000000", " ", " ", " ", " ", " .............. ", " .XXXXXXXXXXXX. ", " .XXXXXooXXXXX. ", " .XXXXO++OXXXX. ", " .XXXo++++oXXX. ", " .XXXo++++oXXX. ", " .XXXXO++OXXXX. ", " .XXXXXooXXXXX. ", " .XXXXXXXXXXXX. ", " .............. ", " ", " "}; mhc-1.1.1/icons/Link.xbm000066400000000000000000000004341262546231500150100ustar00rootroot00000000000000#define Link_width 16 #define Link_height 16 static unsigned char Link_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x30, 0x00, 0x38, 0x00, 0x1d, 0x80, 0x0e, 0xc0, 0x06, 0x60, 0x08, 0x30, 0x0c, 0x10, 0x06, 0x60, 0x03, 0x70, 0x01, 0xb8, 0x00, 0x18, 0x00, 0x00, 0x00, 0x00, 0x00}; mhc-1.1.1/icons/Link.xpm000066400000000000000000000010321262546231500150210ustar00rootroot00000000000000/* XPM */ static char * Link_xpm[] = { "16 16 6 1", " s backgroundColor c None", ". c #30C230C26185", "X c #E79DE79DE79D", "o c #C71BC30BEFBE", "O c #8E388A288E38", "+ c #BEFBBEFBBEFB", " ", " .. ", " .Xo. ", " ...XoO. ", " .o.XoO. ", " .X.XoO. ", " .Xo.OO.. ", " .Xo. ..X. ", " .Xo. .Xo. ", " .o.. .Xo. ", " ..X+.Xo. ", " .XoO.o. ", " .XoO.+. ", " .oO... ", " ... ", " "}; mhc-1.1.1/icons/Other.xbm000066400000000000000000000004361262546231500151760ustar00rootroot00000000000000#define Other_width 16 #define Other_height 16 static unsigned char Other_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x03, 0xf0, 0x07, 0x30, 0x06, 0x00, 0x06, 0x00, 0x07, 0xc0, 0x03, 0xc0, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0x00, 0x00, }; mhc-1.1.1/icons/Other.xpm000066400000000000000000000011511262546231500152070ustar00rootroot00000000000000/* XPM */ static char * Other_xpm[] = { "16 16 9 1", " s backgroundColor c None", ". c #FFFF9E79AEBA", "X c #FFFF8A289658", "o c #FFFF75D679E7", "O c #FFFF618569A6", "+ c #FFFF4D345144", "@ c #FFFF38E338E3", "# c #FFFF28A228A2", "$ c #FFFF14511040", " ", " ", " ", " ..... ", " XXXXXXX ", " oo oo ", " OO ", " +++ ", " @@@@ ", " ## ", " $$ ", " ", " .. ", " ++ ", " ", " "}; mhc-1.1.1/icons/Party.xbm000066400000000000000000000004361262546231500152140ustar00rootroot00000000000000#define Party_width 16 #define Party_height 16 static unsigned char Party_bits[] = { 0x00, 0x00, 0xf0, 0x01, 0x08, 0x02, 0x04, 0x04, 0x8c, 0x1f, 0x94, 0x24, 0x54, 0x5c, 0x24, 0x54, 0xfc, 0x57, 0xfc, 0x57, 0xfc, 0x2f, 0xfc, 0x17, 0xfc, 0x0f, 0xfc, 0x07, 0xf8, 0x03, 0x00, 0x00, }; mhc-1.1.1/icons/Party.xpm000066400000000000000000000007471262546231500152370ustar00rootroot00000000000000/* XPM */ static char * Party_xpm[] = { "16 16 4 1", " s backgroundColor c None", ". c #000000000000", "X c #F7DEFFFFE79D", "o c #FFFFE79D2081", " ", " ..... ", " .XXXXX. ", " .XXXXXXX. ", " ..XXX...... ", " .X.XX.XX.XX. ", " .X.X.XXX...X. ", " .XX.XXXX. .X. ", " .ooooooo. .X. ", " .ooooooo. .X. ", " .ooooooo..X. ", " .ooooooo.X. ", " .ooooooo.. ", " .ooooooo. ", " ....... ", " "}; mhc-1.1.1/icons/Private.xbm000066400000000000000000000004451262546231500155270ustar00rootroot00000000000000#define Private_width 16 #define Private_height 16 static unsigned char Private_bits[] = { 0x00, 0x00, 0xc0, 0x03, 0xe0, 0x07, 0x70, 0x0e, 0x30, 0x0c, 0x30, 0x0c, 0xfc, 0x3f, 0x7c, 0x3e, 0x3c, 0x3c, 0x3c, 0x3c, 0x7c, 0x3e, 0x7c, 0x3e, 0x7c, 0x3e, 0xfc, 0x3f, 0x00, 0x00, 0x00, 0x00}; mhc-1.1.1/icons/Private.xpm000066400000000000000000000010671262546231500155460ustar00rootroot00000000000000/* XPM */ static char * Private_xpm[] = { "16 16 7 1", " s backgroundColor c None", ". c #514479E779E7", "X c #8E38C30BC71B", "o c #30C251445144", "O c #61858A288E38", "+ c #B6DAFFFFFFFF", "@ c #186130C230C2", " ", " .XXXXo ", " .Xo...Xo ", " .Xo .Xo ", " .Xo .Xo ", " .Xo .Xo ", " XXOOOOOOOOoooo ", " X++XXXXXXXXOoo ", " X+XXXX@oXXXOoo ", " X+XXX@@@oXXOoo ", " X+XXX@@@oXXOoo ", " X+XXXX@oXXXOoo ", " X+XXXX@oXXXOoo ", " X+XXXXXXXXXOoo ", " XXoooooooooooo ", " "}; mhc-1.1.1/icons/Recurrence.xbm000066400000000000000000000004441262546231500162110ustar00rootroot00000000000000#define Recurrence_width 16 #define Recurrence_height 16 static char Recurrence_bits[] = { 0xFF, 0xFF, 0x7F, 0xEF, 0xBF, 0xFC, 0x6D, 0xE7, 0xEF, 0xD7, 0xFA, 0xFF, 0xBF, 0xFB, 0x7F, 0xFF, 0xFF, 0xFF, 0xBF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, }; mhc-1.1.1/icons/Recurrence.xpm000066400000000000000000000030411262546231500162230ustar00rootroot00000000000000/* XPM */ static char *Recurrence[] = { /* columns rows colors chars-per-pixel */ "16 16 76 1 ", " c #0E5F7A", ". c #0F637E", "X c #106480", "o c #116580", "O c #116884", "+ c #136B87", "@ c #136B88", "# c #126C89", "$ c #136C89", "% c #157290", "& c #157391", "* c #157492", "= c #147493", "- c #157695", "; c #147796", ": c #157796", "> c #167897", ", c #147898", "< c #177A9A", "1 c #167B9B", "2 c #177B9B", "3 c #167C9C", "4 c #177D9E", "5 c #1880A2", "6 c #1981A2", "7 c #1A82A3", "8 c #1A82A4", "9 c #1984A6", "0 c #1986A9", "q c #1A86A9", "w c #1A87A9", "e c #1987AA", "r c #1A87AA", "t c #1B8BAF", "y c #1C8BAF", "u c #1C8CAF", "i c #1D91B6", "p c #1F95BA", "a c #1F95BB", "s c #1F96BD", "d c #1F97BD", "f c #1E99BD", "g c #209AC1", "h c #209BC2", "j c #209CC4", "k c #219CC4", "l c #229DC4", "z c #219EC5", "x c #229EC5", "c c #21A0C6", "v c #23A3CB", "b c #23A4CD", "n c #24A4CD", "m c #24A5CE", "M c #24A5CF", "N c #24ADC9", "B c #24ADCA", "V c #24AAD3", "C c #24ADD0", "Z c #25AED1", "A c #26ACD6", "S c #26ACD7", "D c #27ADD8", "F c #26AFD9", "G c #27AFDA", "H c #26B5D1", "J c #26B5D2", "K c #28B3DF", "L c #29B4E0", "P c #28B5E0", "I c #29B6E2", "U c #29B7E2", "Y c #2ABCE4", "T c #2BBBE8", "R c #2BBDE8", "E c None", /* pixels */ "EEEEEEEEEEEEEEEE", "EEEEEECHHCEEEEEE", "EEEECTTTTTTHEfcE", "EEEVIKKKKKKPFPlE", "EEhFVFmldmVVFFsE", "EEmmmsEEE3lmmmiE", "E0llsEEEE0llllyE", "E9pp0EEEE0y0003E", "E<<3EEEEEEEEEE", "EE+;@;;;;;;EEEEE", "EEE+@@@@@@++EEEE", "EEEE.oooooo.EEEE", "EEEEEE EEEEEE", "EEEEEEEEEEEEEEEE" }; mhc-1.1.1/icons/Vacation.xbm000066400000000000000000000004471262546231500156630ustar00rootroot00000000000000#define Vacation_width 16 #define Vacation_height 16 static unsigned char Vacation_bits[] = { 0x00, 0x00, 0x00, 0x3f, 0x80, 0x20, 0x80, 0x3f, 0x00, 0x12, 0x00, 0x3f, 0x80, 0x2c, 0x40, 0x2c, 0x20, 0x2c, 0xf8, 0x7f, 0xfc, 0x7f, 0xfa, 0x7f, 0xfe, 0x7f, 0xee, 0x6f, 0x38, 0x38, 0x00, 0x00, }; mhc-1.1.1/icons/Vacation.xpm000066400000000000000000000010701262546231500156720ustar00rootroot00000000000000/* XPM */ static char * Vacation_xpm[] = { "16 16 7 1", " s backgroundColor c None", ". c #FFFFFFFFFFFF", "X c #000000000000", "o c #DF7DDF7DDF7D", "O c #0000FFFFFFFF", "+ c #BEFBBEFBBEFB", "@ c #FFFFF7DE8617", " ...... ", " .XXXXXX. ", " .XoooooX. ", " .XXXXXXX. ", " ..X..X. ", " .XXXXXX. ", " .XOO++OX. ", " .XOOO++OX. ", " ..XOOOO++OX. ", " .XXXXXXXXXXXX.", " .XXXXXXXXXXXXX.", ".X@XXXXXXXXXXXX.", ".XXXXXXXXXXXXXX.", ".XXXoXXXXXXXoXX.", " ..XXX.....XXX. ", " ... ... "}; mhc-1.1.1/lib/000077500000000000000000000000001262546231500130355ustar00rootroot00000000000000mhc-1.1.1/lib/mhc.rb000066400000000000000000000060761262546231500141420ustar00rootroot00000000000000require '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 ENV["MHC_TZID"] = tzid RiCal::PropertyValue::DateTime.default_tzid = tzid end def self.default_tzid @tzid end if ENV["MHC_TZID"] self.default_tzid = ENV["MHC_TZID"] end class ConfigurationError < StandardError ; end dir = File.dirname(__FILE__) + "/mhc" autoload :Builder, "#{dir}/builder.rb" autoload :CalDav, "#{dir}/caldav.rb" autoload :Calendar, "#{dir}/calendar.rb" autoload :Command, "#{dir}/command.rb" autoload :Config, "#{dir}/config.rb" autoload :Converter, "#{dir}/converter.rb" autoload :DataStore, "#{dir}/datastore.rb" autoload :DateEnumerator, "#{dir}/date_enumerator.rb" autoload :DateFrame, "#{dir}/date_frame.rb" autoload :DateHelper, "#{dir}/date_helper.rb" autoload :EtagStore, "#{dir}/etag.rb" autoload :Event, "#{dir}/event.rb" autoload :Formatter, "#{dir}/formatter.rb" autoload :Logger, "#{dir}/logger.rb" autoload :Modifier, "#{dir}/modifier.rb" autoload :Occurrence, "#{dir}/occurrence.rb" autoload :OccurrenceEnumerator, "#{dir}/occurrence_enumerator.rb" autoload :PropertyValue, "#{dir}/property_value.rb" autoload :Query, "#{dir}/query.rb" autoload :Sync, "#{dir}/sync.rb" autoload :VERSION, "#{dir}/version.rb" autoload :PRODID, "#{dir}/version.rb" end mhc-1.1.1/lib/mhc/000077500000000000000000000000001262546231500136045ustar00rootroot00000000000000mhc-1.1.1/lib/mhc/builder.rb000066400000000000000000000042761262546231500155700ustar00rootroot00000000000000require "yaml" require "uri" ################################################################ ## load config module Mhc class Builder def initialize(config) @config = config @config = Mhc::Config.create_from_file(config) if config.is_a?(String) end def calendar(calendar_name) calendar = @config.calendars[calendar_name] raise Mhc::ConfigurationError, "calendar '#{calendar_name}' not found" unless calendar case calendar.type when "caldav" db = Mhc::CalDav::Client.new(calendar.url).set_basic_auth(calendar.user, calendar.password) when "directory" db = Mhc::CalDav::Cache.new(calendar.top_directory) when "lastnote" db = Mhc::LastNote::Client.new(calendar.name) when "mhc" db = Mhc::Calendar.new(Mhc::DataStore.new(@config.general.repository), calendar.modifiers, &calendar.filter) end return db end def sync_driver(channel_name) channel = @config.sync_channels[channel_name] raise Mhc::ConfigurationError, "sync channel '#{channel_name}' not found" unless channel directory1, directory2 = cache_directory_pair(channel) strategy = channel.strategy.to_s.downcase.to_sym db1 = calendar_with_etag_track(calendar(channel.calendar1), directory1) db2 = calendar_with_etag_track(calendar(channel.calendar2), directory2) return Mhc::Sync::Driver.new(db1, db2, strategy) end ################################################################ private def calendar_with_etag_track(calendar, etag_store_directory) etag_db = Mhc::EtagStore.new(etag_store_directory) return Mhc::Sync::StatusManager.new(calendar, etag_db) end def cache_directory_pair(channel, top_directory = File.expand_path("status/sync_channels", @config.general.repository)) base = File.expand_path(channel.name, top_directory) directory1 = File.join(base, channel.calendar1) directory2 = File.join(base, channel.calendar2) FileUtils.mkdir_p(directory1) unless FileTest.exist?(directory1) FileUtils.mkdir_p(directory2) unless FileTest.exist?(directory2) return [directory1, directory2] end end # class Builder end # module Mhc mhc-1.1.1/lib/mhc/caldav.rb000066400000000000000000000235601262546231500153710ustar00rootroot00000000000000require File.dirname(__FILE__) + '/webdav' module Net class HTTP class Report < HTTPRequest METHOD = 'REPORT' REQUEST_HAS_BODY = true RESPONSE_HAS_BODY = true end end end module Mhc class CalDav class Report attr_accessor :uid, :etag, :href, :content_type, :status, :ics def self.parse(xmldoc) info = self.new href, status, content_type, etag, ics = %w(D:href D:propstat/D:status D:propstat/D:prop/D:getcontenttype D:propstat/D:prop/D:getetag D:propstat/D:prop/caldav:calendar-data ).map{|e| xmldoc.elements[e].text rescue nil} info.href = URI.unescape(href) info.uid = File.basename(info.href, ".ics") info.status = status info.content_type = content_type info.etag = etag # unquote_string(etag) info.ics = ics return info end private_class_method def self.unquote_string(str) return str.gsub('"', "") end end # class Report class CalendarProperty attr_accessor :description, :color, :displayname, :ctag def initialize(description, color, displayname, ctag) @description, @color, @displayname, @ctag = description, color, displayname, ctag end def self.parse(xml) xml = REXML::Document.new(xml) if xml.is_a?(String) description, color, displayname, ctag = %w(caldav:calendar-description ical:calendar-color D:displayname cs:getctag ).map{|e| xml.elements[e].text rescue nil} self.new(description, color, displayname, ctag) end end class ReportCollection def initialize @db = {} @calendar_property = nil end def collection return @db end def find(uid) return @db[uid] end def uid_list return @db.keys end def update(info) @db[info.uid] = info end def calendar_property @calendar_property end def set_calendar_property(xml) @calendar_property = CalendarProperty.parse(xml) end def self.parse(xml) db = self.new xml = REXML::Document.new(xml) if xml.is_a?(String) xml.elements.each("D:multistatus/D:response") do |res| if res.elements["D:propstat/D:prop/D:resourcetype/D:collection"] db.set_calendar_property(res.elements["D:propstat/D:prop"]) else db.update(Report.parse(res)) end end return db end end # class ReportCollection class Client < WebDav::Client def report(xml, path = @top_directory, depth = 1) req = setup_request(Net::HTTP::Report, path) req['Depth'] = depth req.content_length = xml.size req.content_type = 'application/xml; charset="utf-8"' req.body = xml res = @http.request(req) #check_status_code(res, 207) return res end ## for caldav sync ## etag_report is one of: ## + {uid_string => etag_object } style hash, ## + {uid_string => etag_string } style hash, ## + [uid_etag_object] style array, ## uid_etag_object is an object which respond to #etag and #uid method. ## etag_object is an object which respond to #etag method. def report_etags(uids = nil) # XXX: handle uids ReportCollection.parse(self.propfind.body).collection # FIXME: I want to support schedule-tag (RFC6638) in the future, # but we need to prepare a right path to migrate from etag-db. # xml = <<-EOS # # # # # # # EOS # ReportCollection.parse(self.propfind(@top_directory, 1, xml).body).collection end # for caldav sync def get_with_etag(uid_or_href) res = get(uid_or_href) return [res, res['etag']] end # for caldav sync # return value : false ... failed. # return value : true ... successful but etag is not available # return value : String ... successful with new etag def put_if_match(uid, ics_string, etag) STDERR.print "CALDAV put_if_match :uid => #{uid}" STDERR.print ", :etag => #{etag}" if etag STDERR.print "... " begin res = put(ics_string, uid, etag) rescue Exception => e STDERR.print "failed: (#{e.to_s})\n" return false end STDERR.print "succeeded #{res['etag']}\n" return res['etag'] || true end def delete_if_match(uid, etag) begin res = delete(uid, etag) rescue Exception => e return false end return true end def delete(uid_or_href, ifmatch = nil) super(adjust_path(uid_or_href)) end def get(uid_or_href) super(adjust_path(uid_or_href)) end def head(uid_or_href) super(adjust_path(uid_or_href)) end def put(content, uid_or_href, ifmatch = nil) super(content, adjust_path(uid_or_href), ifmatch) end def report_calendar_multiget(href_list, path = @top_directory) xml = '' xml += <<-EOS #{href_list.map{|href| "" + href + "\n"}} EOS return ReportCollection.parse(report(xml, path).body) end def fetch_calendar_list(url, username, userpass) depth = 1 split_url = URI.split(url) host_url = split_url[0] + "://" + split_url[2] body = <<-EOF_BODY EOF_BODY res = self.propfind(url, depth, body) return [] if (res.code.to_i / 200) != 1 xml = Nokogiri::XML(res.body).remove_namespaces! blocks = xml.xpath('//multistatus/response') calendars = [] blocks.each do |block| if block.xpath('propstat/prop/calendar-color')[0].content != "" href = block.xpath('href')[0].content displayname = block.xpath('propstat/prop/displayname')[0].content color = block.xpath('propstat/prop/calendar-color')[0].content if color =~ /^#(..)(..)(..)/ color = "#" + $1 + $2 + $3 # color = double_lightness_of_hexrgb(color) end description = block.xpath('propstat/prop/calendar-description')[0].content calendars << {"url" => host_url + href.to_s, "displayname" => displayname.to_s, "color" => color.to_s, "description" => description.to_s } end end return calendars end private def adjust_path(uid_or_href) # XXX: google calendar specific? if uid_or_href =~ /^\// return uid_or_href else return File.expand_path(uid_or_href, @top_directory) end end end # class Client class Cache < WebDav::Cache def report(xml, depth = 1) raise NotImplementedError end def report_calendar_multiget(path_list) raise NotImplementedError end end # class Cache end end mhc-1.1.1/lib/mhc/calendar.rb000066400000000000000000000060331262546231500157040ustar00rootroot00000000000000# -*- coding: utf-8 -*- module Mhc class Calendar def initialize(datastore, modifiers = [], &default_scope) @datastore = datastore @modifiers = modifiers || [] @logger = @datastore.logger @default_scope = default_scope end def find(uid:) if event = @datastore.find_by_uid(uid) decorate_event(event) end end def events(date_range = nil, &scope_block) occurrences(date_range, &scope_block).map(&:event).uniq end def occurrences(date_range, &scope_block) ocs = [] @datastore.entries(date_range).each do |event| event = decorate_event(event) event.occurrences(range:date_range).each do |oc| ocs << oc if in_scope?(oc, &scope_block) end end return ocs.sort end ################################################################ ## for sync manager def report_etags(uid = nil) return find(uid) if uid date_range = (Mhc::PropertyValue::Date.today - 90).. (Mhc::PropertyValue::Date.today + 90) events(date_range) end def get_with_etag(uid) find(uid: uid) end def put_if_match(uid, ics_string, expected_etag) STDERR.print "Mhc::Calendar#put_if_match(uid:#{uid}, expected_etag:#{expected_etag})..." if ev = find(uid: uid) and ev.etag != expected_etag STDERR.print "failed: etag not match #{ev.etag} != #{expected_etag}\n" return nil end if expected_etag and (not ev) STDERR.print "failed: etag not match #{expected_etag} != nil\n" end begin ev = Mhc::Event.new_from_ics(ics_string) @datastore.update(ev) STDERR.print "succeeded #{ev.etag}\n" return true rescue Exception => e STDERR.print "failed: #{e.to_s}\n" STDERR.print "#{e.backtrace.first}\n" if $MHC_DEBUG STDERR.print "#{ics_string}\n" if $MHC_DEBUG return nil end end def delete_if_match(uid, expected_etag) STDERR.print "Mhc::Calendar#delete_if_match(uid:#{uid}, expected_etag:#{expected_etag})..." unless ev = find(uid: uid) STDERR.print "failed: uid #{uid} not found\n" return nil end if expected_etag && ev.etag != expected_etag STDERR.print "failed: etag not match #{ev.etag} != #{expected_etag}\n" return nil end begin @datastore.delete(ev) STDERR.print "succeeded: #{ev.etag}\n" return ev rescue Exception => e STDERR.print "failed: #{e.to_s}\n" return nil end end ################################################################ private ################################################################ def decorate_event(event) @modifiers.each do |deco| event = deco.decorate(event) end return event end def in_scope?(oc, &scope_block) (!@default_scope || @default_scope.call(oc)) && (!scope_block || scope_block.call(oc)) end end # class Calendar end # module Mhc mhc-1.1.1/lib/mhc/command.rb000066400000000000000000000005311262546231500155460ustar00rootroot00000000000000module Mhc module Command dir = File.dirname(__FILE__) + "/command" autoload :Completions, "#{dir}/completions.rb" autoload :Cache, "#{dir}/cache.rb" autoload :Init, "#{dir}/init.rb" autoload :Scan, "#{dir}/scan.rb" autoload :Sync, "#{dir}/sync.rb" end # module Command end # module Mhc mhc-1.1.1/lib/mhc/command/000077500000000000000000000000001262546231500152225ustar00rootroot00000000000000mhc-1.1.1/lib/mhc/command/cache.rb000066400000000000000000000005141262546231500166120ustar00rootroot00000000000000module Mhc module Command class Cache def initialize(calendar) calendar.events.each do |event| range = event.range puts "#{range.min.to_mhc_string},#{range.max.to_mhc_string},#{event.uid},#{event.subject}" end end end # class Cache end # module Command end # module Mhc mhc-1.1.1/lib/mhc/command/completions.rb000066400000000000000000000057501262546231500201120ustar00rootroot00000000000000module Mhc module Command class Completions def initialize(help, global_options, arguments, config = nil) @help, @global_options, @arguments, @config = help, global_options, arguments, config command_name = arguments.first if command_name and help[command_name] option_arguments(help, global_options, command_name) else command_arguments end end private def command_arguments print "_arguments\n" print "1:Possible commands\\::" print possible_commands + "\n" end def option_arguments(help, global_options, command_name) command_arguments print arguments(help, command_name) print options(help[command_name], global_options) end # make normal argument completion setting from usage string such as: "scan REPOSITORY" def arguments(help, command_name, position = 2) str = "" help[command_name].usage.split(/\s+/)[1..-1].each do |arg| pos = position if /^\[(.*)\]/ =~ arg arg = $1 end multi = "" if /(.*)\.\.\.$/ =~ arg arg = $1 pos = "*" multi = ":" end str << "#{pos}:#{arg}\\::#{possible_values(arg)}#{multi}\n" position += 1 end return str end # make option argument completion setting from usage options help def options(command_help, global_options, position = 2) str = "" options = command_help.options.merge(global_options) options.each do |name, opt| name = name.to_s.gsub("_", "-") if opt.type == :boolean str << "(--#{name})--#{name}[#{opt.description}]\n" else str << "(--#{name})--#{name}=-[#{opt.description}]:#{opt.banner}:#{possible_values_for_opt(opt)}\n" end end return str end def possible_commands str = "((" @help.each_value do |cmd| next if cmd.name == "completions" str << " #{cmd.name}\\:" str << cmd.description.gsub(/([()\s"';&|#\\])/, '\\\\\1') end str << "))" end def possible_values_for_opt(option) return "(" + option.enum.join(" ") + ")" if option.enum return possible_values(option.banner) end def possible_values(banner) case banner when /^CALENDAR/ "(" + @config.calendars.select{|cal| cal.type == "mhc"}.map(&:name).join(' ') + ")" when /^SYNC_CHANNEL/ "(" + @config.sync_channels.map(&:name).join(' ') + ")" when /^(FILE|CONF)/ "_files" when /^DIR/ "_files -/" when "COMMAND" possible_commands when "RANGE" "(today tomorrow thismonth nextmonth)" when /^NUM/ "_guard '[0-9]#' 'Number'" else "" end end end # class Completions end # module Command end # module Mhc mhc-1.1.1/lib/mhc/command/init.rb000066400000000000000000000074121262546231500165160ustar00rootroot00000000000000module Mhc module Command class Init SUB_DIRS = %w(draft inbox presets spool trash status/cache status/log status/sync_channels) TEMPLATE_DIR = File.expand_path("../../templates", __FILE__) def initialize(top_dir, config_path, tzid = nil, template_dir = nil) @shell = Thor.new @status = {green: 0, yellow: 0, red: 0} @config = {} # guess teimzone say "Guessing current local timezone ..." if @config[:tzid] = find_current_tzid say_status "ok", "guess timezone ... #{@config[:tzid]}", :green tzid = find_current_tzid else say_status "failed", "guess timezone... Unknown", :red end # mkdir say "Making directries under #{top_dir} ..." SUB_DIRS.each do |ent| mkdir_p(File.expand_path(ent, top_dir)) end # make config file from tamplate say "Copying config file(s) into #{config_path} ..." src = File.expand_path("config.yml.erb", TEMPLATE_DIR) dst = File.expand_path(config_path) @config[:topdir] = top_dir expand_template(src, dst) say_status_report end private def say(message, color = nil) @shell.say(message, color) end def say_status(status, message, log_status = nil) @status[log_status] += 1 @shell.say_status(status, message, log_status) end def say_status_report if (errors = @status[:red]) > 0 say "#{errors} error(s) were occurred.", :red else say "Done." end end def expand_template(template_path, dest_path) require "erb" template = ERB.new(File.open(template_path).read, nil, "-") if File.exists?(dest_path) say_status "exist", "Ignore #{dest_path}", :yellow return end begin mkdir_p(File.expand_path("..", dest_path)) File.open(dest_path, "w", 0600) do |file| file.write(template.result(binding)) end say_status "ok", "copy #{dest_path}", :green rescue StandardError => e say_status "failed", "#{e.message.split(' @').first} #{dest_path}", :red end end def mkdir_p(path) path = File.expand_path(path) if File.directory?(path) say_status "exist", "Ignore #{path}", :yellow return end begin FileUtils.mkdir_p(path) say_status "create", "#{path}", :green rescue StandardError => e say_status "failed", "#{e.message.split(' @').first} #{path}", :red end end def find_current_tzid require "digest/md5" # Debian if File.exists?("/etc/timezone") return File.open("/etc/timezone").read.chomp end # Mac if File.symlink?("/etc/localtime") && /([^\/]+\/[^\/]+)$/ =~ File.readlink("/etc/localtime") return $1 end # Red Had / CentOS if File.exists?("/etc/sysconfig/clock") && /ZONE=["']?([^"']+)/ =~ File.open("/etc/sysconfig/clock").read.chomp return $1 end # generic including FreeBSD if File.exists?("/etc/localtime") localtime = Digest::MD5.file("/etc/localtime") candidates = Dir.chdir("/usr/share/zoneinfo") do Dir.glob("**/*").select do |fn| File.file?(fn) && Digest::MD5.file(fn) == localtime end end unless candidates.empty? # take the most descriptive (has long name) one return candidates.sort {|a,b| b.length <=> a.length}.first end end return "Unknown" end end # class Init end # module Command end # module Mhc mhc-1.1.1/lib/mhc/command/scan.rb000066400000000000000000000021051262546231500164710ustar00rootroot00000000000000module Mhc module Command class Scan Encoding.default_external = "UTF-8" def initialize(calendar, range_string, format: :text, search: nil, **options) date_range = Mhc::PropertyValue::Date.parse_range(range_string) formatter = Mhc::Formatter.build(formatter: format, date_range: date_range, **options) format_range(calendar, formatter, date_range, search: search, **options) end def format_range(calendar, formatter, date_range, search: nil, **options) if options[:category] and not search search = "category:\"#{options[:category]}\"" end if search begin search_proc = Mhc::Query.new(search).to_proc rescue Mhc::Query::ParseError => e STDERR.print "Error: " + e.message.capitalize + " in search string\n" exit 1 end end calendar.occurrences(date_range, &search_proc).each do |oc| formatter << oc end print formatter.to_s end end # class Scan end # module Command end # module Mhc mhc-1.1.1/lib/mhc/command/sync.rb000066400000000000000000000010201262546231500165140ustar00rootroot00000000000000module Mhc module Command class Sync Encoding.default_external = "UTF-8" def initialize(channel_name, config) channel = config.sync_channels[channel_name] unless channel STDERR.print "Error: Not found '#{channel_name}' in ~/.mhc/config.yml\n" exit 1 end builder = Mhc::Builder.new(config) driver = builder.sync_driver(channel.name, channel.strategy) driver.sync_all end end # class Sync end # module Command end # module Mhc mhc-1.1.1/lib/mhc/config.rb000066400000000000000000000135131262546231500154010ustar00rootroot00000000000000require 'yaml' require 'pp' module Mhc class Config # Syntax table manipulation class Syntax def initialize(syntax_config) @syntax_config = syntax_config end def keyword_symbols @syntax_config.keys end def keywords keyword_symbols.map {|sym| sym.to_s.upcase } end def keyword?(word) if word.is_a?(Symbol) keyword_symbols.member?(word) else # String keywords.member?(word) end end def instance_variable_name(word) return nil unless keyword?(word) return '@' + as_symbol(word).to_s end def item_class(word) return nil unless keyword?(word) @syntax_config[as_symbol(word)] end private def as_symbol(word) word.to_s.downcase.sub(/^@+/, "").to_sym end end # class Syntax # Parse Key-Value object in YAML class Base # attr_accessor :name def self.create_from_yaml_file(yaml_file) yaml_string = File.open(File.expand_path(yaml_file)).read return create_from_yaml_string(yaml_string, yaml_file) end def self.create_from_yaml_string(yaml_string, filename = nil) hash = YAML.load(yaml_string, filename) || {} return new(hash) end def self.define_syntax(config) @syntax = Syntax.new(config) @syntax.keyword_symbols.each do |sym| attr_accessor sym # XXX: attr_reader is enough? end end def self.syntax return @syntax end def initialize(hash = {}) @original_hash = hash (hash || {}).each do |key, val| raise Mhc::ConfigurationError, "config syntax error (#{key})" unless syntax.keyword?(key) var = syntax.instance_variable_name(key) obj = create_subnode(key, val) instance_variable_set(var, obj) end end attr_reader :original_hash def get_value(dot_separated_string = nil) if dot_separated_string.to_s == "" return original_hash end key, subkey = dot_separated_string.to_s.upcase.split(".", 2) subnode = get_subnode(key) if subnode.respond_to?(:get_value) return subnode.get_value(subkey) else return subnode.to_s end end def to_yaml return self.to_hash.to_yaml end def to_hash hash = {} syntax.keywords.each do |key| var = syntax.instance_variable_name(key) obj = instance_variable_get(var) obj = obj.respond_to?(:to_hash) ? obj.to_hash : obj.to_s hash[key] = obj end return hash end private def syntax self.class.syntax end def get_subnode(key) raise Mhc::ConfigurationError, "Invalid key: #{key}" unless syntax.keyword?(key) return instance_variable_get(syntax.instance_variable_name(key)) end def create_subnode(keyword, value) item_class = syntax.item_class(keyword) if item_class.is_a?(Array) return List.new(item_class.first, value) elsif item_class == String return value.to_s else return item_class.new(value) end end end # class Base # Parse Array object in YAML class List < Base include Enumerable def initialize(item_class, array = []) @original_hash = array @configs = [] (array || []).each do |value| item = item_class.new(value) @configs << item end end def [](key) @configs.find {|c| c.name == key} end alias_method :get_subnode, :[] def <<(conf) @configs << conf end def to_hash # XXX: actually, it returns a Array return @configs.map {|c| c.respond_to?(:to_hash) ? c.to_hash : c.to_s} end def each @configs.each do |conf| yield conf end end end # List ## concrete config classes class General < Base define_syntax :tzid => String, :repository => String end # class General class SyncChannel < Base define_syntax :name => String, :calendar1 => String, :calendar2 => String, :strategy => String end # class SyncChannel class Calendar < Base define_syntax :name => String, :type => String, :user => String, :password => String, :url => String, :filter => Mhc::Query, :modifiers => [Mhc::Modifier] end # class Calendar # Top-Level Config class Top < Base define_syntax :general => General, :sync_channels => [SyncChannel], :calendars => [Calendar] def embed_values super hash self.sync_channels.each do |ch| # String -> Calendar ch.calendar1 = calendars[ch.calendar1] if calendars[ch.calendar1] ch.calendar2 = calendars[ch.calendar2] if calendars[ch.calendar2] end end end # class Top def self.create_from_file(file_name) unless File.exists?(File.expand_path(file_name)) raise Mhc::ConfigurationError, "config file '#{file_name}' not found" end begin return Top.create_from_yaml_file(file_name) rescue Psych::SyntaxError, Mhc::Query::ParseError, Mhc::Modifier::ParseError => e raise Mhc::ConfigurationError, e.message end end def self.create_from_string(string) begin return Top.create_from_yaml_string(string) rescue Psych::SyntaxError, Mhc::Query::ParseError, Mhc::Modifier::ParseError => e raise Mhc::ConfigurationError, e.message end end end # class Config end # module Mhc mhc-1.1.1/lib/mhc/converter.rb000066400000000000000000000256051262546231500161500ustar00rootroot00000000000000module Mhc class Converter class Emacs # return cfw:event structure # # (defstruct cfw:event # title ; event title [string] # start-date ; start date of the event [cfw:date] # start-time ; start time of the event (optional) # end-date ; end date of the event [cfw:date] (optional) # end-time ; end of the event (optional) # description ; event description [string] (optional) # location ; location [strting] (optional) # source ; [internal] source of the event # ) def to_calfw(ev) hash = { :title => ev.subject.to_s, :start_date => "", :start_time => "", :end_date => "", :end_time => "", :description => "", :location => "", :source => "" } to_emacs_plist(hash) end def to_emacs(obj) case obj when Array to_emacs_list(obj) when Hash to_emacs_plist(obj) else to_emacs_string(obj) end end def to_emacs_symbol(obj) ":" + obj.to_s.downcase.gsub('_', '-') end def to_emacs_string(str) # 1. quote " and \ # 2. surround by " '"' + str.to_s.toutf8.gsub(/[\"\\]/, '\\\\\&') + '"' end def to_emacs_plist(hash) wrap(hash.map{|key,val| "#{to_emacs_symbol(key)} #{to_emacs(val)}"}.join(" ")) end def to_emacs_list(array) wrap(array.map{|val| to_emacs(val)}.join(" ")) end private def wrap(obj) "(" + obj.to_s + ")" end end # class Emacs class Icalendar def to_ics(event) return to_icalendar(event).to_s end def to_ics_string(event) ical = RiCal.Calendar ical.prodid = Mhc::PRODID ical.events << to_icalendar(event) return ical.to_s end def to_icalendar(event) icalendar = RiCal.Event do |iev| iev.rrule = event.recurrence_condition.to_ics(dtstart(event), event.duration.last) if event.recurring? iev.exdates = [exdates(event)] if exdates(event) iev.rdates = [rdates(event)] if rdates(event) iev.created = created(event).utc.strftime("%Y%m%dT%H%M%SZ") iev.categories = event.categories.to_a unless event.categories.empty? iev.location = event.location.to_s unless event.location.to_s.empty? iev.last_modified = last_modified(event).utc.strftime("%Y%m%dT%H%M%SZ") iev.uid = event.uid.to_s iev.dtstart = dtstart(event) iev.dtend = dtend(event) iev.summary = event.subject.to_s iev.description = event.description.to_s iev.sequence = (event.sequence.to_i || 0) iev.dtstamp = ::Time.now.utc.strftime("%Y%m%dT%H%M%SZ") iev.add_x_property("X-SC-Recurrence-Tag", event.recurrence_tag.to_s) if event.recurrence_tag.to_s != "" iev.add_x_property("X-SC-Mission-Tag", event.mission_tag.to_s) if event.mission_tag.to_s != "" end return icalendar end ################################################################ private # DTSTART (RFC5445:iCalendar) has these two meanings: # 1) first ocurrence date of recurrence events # 2) start date of a single-shot event # # In MHC, DTSTART should be calculated as: # # if a MHC article has a Cond: field, # + DTSTART is calculated from Duration: and Cond: field. # + Additional Day: field is recognized as RDATE. # else # + DTSTART is calculated from a first entry of Days: field. # + Remains in Day: field is recognized as RDATE. # end # def dtstart(event) if event.recurring? Mhc::OccurrenceEnumerator.new(event, empty_dates, empty_dates, event.recurrence_condition, event.duration).first.dtstart else Mhc::OccurrenceEnumerator.new(event, event.dates, empty_dates, empty_condition, empty_duration).first.dtstart end end def dtend(event) if event.recurring? Mhc::OccurrenceEnumerator.new(event, empty_dates, empty_dates, event.recurrence_condition, event.duration).first.dtend else Mhc::OccurrenceEnumerator.new(event, event.dates, empty_dates, empty_condition, empty_duration).first.dtend end end def rdates(event) return nil if event.dates.empty? ocs = Mhc::OccurrenceEnumerator.new(event, event.dates, empty_dates, empty_condition, empty_duration).map {|oc| oc.dtstart} if event.recurring? ocs else ocs = ocs[1..-1] return nil if ocs.empty? return ocs end end def exdates(event) return nil if event.exceptions.empty? ocs = Mhc::OccurrenceEnumerator.new(event, event.exceptions, empty_dates, empty_condition, empty_duration).map {|oc| oc.dtstart } return ocs end def empty_duration Mhc::PropertyValue::Range.new(Mhc::PropertyValue::Date) end def empty_dates Mhc::PropertyValue::List.new(Mhc::PropertyValue::Range.new(Mhc::PropertyValue::Date.new)) end def empty_condition Mhc::PropertyValue::RecurrenceCondition.new end def created(event) if event.path File.ctime(event.path) else ::Time.utc(2014, 1, 1) end end def last_modified(event) if event.path File.mtime(event.path) else ::Time.utc(2014, 1, 1) end end end # class Icalendar class IcalendarImporter def self.parse_ics(ics) # * 3.8.1. Descriptive Component Properties # ** CATEGORIES 3.8.1.2. Categories # ** DESCRIPTION 3.8.1.5. Description # ** LOCATION 3.8.1.7. Location # ** SUMMARY 3.8.1.12. Summary # * 3.8.2. Date and Time Component Properties # ** DTEND 3.8.2.2. Date-Time End # ** DTSTART 3.8.2.4. Date-Time Start # ** DURATION 3.8.2.5. Duration # * 3.8.4. Relationship Component Properties # ** RECURRENCE-ID 3.8.4.4. Recurrence ID # * 3.8.5. Recurrence Component Properties # ** EXDATE 3.8.5.1. Exception Date-Times # ** RDATE 3.8.5.2. Recurrence Date-Times # ** RRULE 3.8.5.3. Recurrence Rule # * 3.8.7. Change Management Component Properties # ** SEQUENCE 3.8.7.4. Sequence Number # * 3.8.8. Miscellaneous Component Properties # ** X-FIELD 3.8.8.2. Non-Standard Properties # DTSTART: # Date part => X-SC-Duration: .first # Time part => X-SC-Time: .first # DTEND # Date part => # DTEND - DTSTART = 1day # DTEND - DTSTART > 1days # Day: # RRULE: # X-SC-Cond: # UNTIL: # X-SC-Duration: .last # RDATES: # X-SC-Day: # EXDATES: # X-SC-Day: !YYYYMMDD # ical = RiCal.parse_string(ics).first return nil unless ical iev = ical.events.first allday = !iev.dtstart.respond_to?(:hour) recurring = !iev.rrule.empty? # X-SC-Day: (from DTSTART, DTEND) # for recurring event, DTSTSRT is a start part of X-SC-Duration: dates = [] unless recurring date = tz_convert(iev.dtstart).strftime("%Y%m%d") if allday && (iev.dtend - iev.dtstart).to_i > 1 date += "-" + (iev.dtend - 1).to_time.strftime("%Y%m%d") end dates << date end # X-SC-Day: (from RDATE, EXDATE) dates += iev.rdate.flatten.map{|d| d.to_time.strftime("%Y%m%d")} exdates = iev.exdate.flatten.map{|d| d.to_time.strftime("!%Y%m%d")} # X-SC-Time: unless allday time = tz_convert(iev.dtstart).strftime("%H:%M") if iev.dtend time += "-" + tz_convert(iev.dtend).strftime("%H:%M") end end ev = Mhc::Event.parse "X-SC-Subject: #{iev.summary}\n" + "X-SC-Location: #{iev.location}\n" + "X-SC-Day: #{(dates + exdates).join(' ')}\n" + "X-SC-Time: #{time}\n" + "X-SC-Category: #{iev.categories.to_a.join(' ')}\n" + "X-SC-Mission-Tag: #{iev.x_sc_mission_tag.first}\n" + "X-SC-Recurrence-Tag: #{iev.x_sc_recurrence_tag.first}\n" + "X-SC-Cond: \n" + "X-SC-Duration: \n" + "X-SC-Alarm: \n" + "X-SC-Record-Id: #{iev.uid}\n" + "X-SC-Sequence: #{iev.sequence.to_i}\n\n" + iev.description.to_s + if $MHC_DEBUG_FOR_DEVELOPER # FIXME: should introduce good logger and debug scheme ical.to_s.force_encoding("ASCII-8BIT").gsub(/\r\n/, "\n") else "" end # X-SC-Cond: ev.recurrence_condition.set_from_ics(iev.rrule.first, tz_convert(iev.dtstart)) # X-SC-Duration: is only for recurring articles if recurring duration_string = tz_convert(iev.dtstart).strftime("%Y%m%d") + "-" if iev.rrule.first.to_s.match(/until=([^;]+)/i) duration_string += parse_ical_datetime($1).strftime("%Y%m%d") end ev.duration = duration_string end return ev end private def self.tz_convert(datetime, src_tzid: nil, dst_tzid: nil) return datetime unless datetime.respond_to?(:hour) dst_tzid ||= Mhc.default_tzid src_tzid ||= if datetime.respond_to?(:tzid) and datetime.tzid datetime.tzid else Mhc.default_tzid end dst_tz = TZInfo::Timezone.get(dst_tzid) src_tz = TZInfo::Timezone.get(src_tzid) utc = Time.utc(datetime.year, datetime.month, datetime.day, datetime.hour, datetime.min, datetime.sec) time1 = src_tz.local_to_utc(utc) time1.tzid = src_tzid if time1.respond_to?(:tzid) time = dst_tz.utc_to_local(time1) time.tzid = dst_tzid if time.respond_to?(:tzid) return time end def self.parse_ical_datetime(datetime_string, dst_tzid = nil) src_tzid = case datetime_string when /TZID=([^;]+)/ $1 when /\d{8}T\d{6}Z/ "UTC" else Mhc.default_tzid end dst_tzid ||= Mhc.default_tzid if /^(\d{4})(\d\d)(\d\d)(?:T(\d\d)(\d\d)(\d\d)Z?)?$/ =~ datetime_string time = Time.utc($1, $2, $3, $4, $5, $6) return tz_convert(time, src_tzid: src_tzid, dst_tzid: dst_tzid) else raise ArgumentError end end end # IcalendarImporter end # Converter end # Mhc mhc-1.1.1/lib/mhc/datastore.rb000066400000000000000000000075601262546231500161270ustar00rootroot00000000000000require "fileutils" require "pathname" module Mhc class DataStore def initialize(basedir) unless basedir and File.directory?(File.expand_path(basedir.to_s)) raise Mhc::ConfigurationError, "datastore directory '#{basedir}' not found" end @basedir = Pathname.new(File.expand_path(basedir)) @cache = Cache.new(File.expand_path("status/cache/events.pstore", @basedir)) end def entries(date_range = nil) if date_range int_range = date_range.min.absolute_from_epoch .. date_range.max.absolute_from_epoch end Enumerator.new do |yielder| ["inbox", "spool", "presets"].each do |slot| dir = File.expand_path(slot, @basedir) next unless File.directory?(dir) Dir.chdir(dir) do Dir.foreach(".") do |ent| parse_mhcc(ent).each {|ev| yielder << ev} if /\.mhcc$/ =~ ent next unless /\.mhc$/ =~ ent uid = $` cache_entry = @cache.lookup(uid, ent) if !date_range || cache_entry.involved?(int_range) yielder << Event.parse_file(File.expand_path(ent)) end end end end @cache.save end end def logger @logger ||= Mhc::Logger.new(@logfile) end def find_by_uid(uid) path = find_path(uid) return nil unless path return Event.parse_file(path) end def create(event) if find_by_uid(event.uid) raise "Already exist uid:#{uid} in #{@basedir}" end File.open(path, "w") do |f| f.write(event.dump) end end def update(event) unless path = uid_to_path(event.uid) raise "Not found uid:#{uid} in #{@basedir}" end File.open(path, "w") do |f| f.write(event.dump) end end def delete(uid_or_event) uid = if uid_or_event.respond_to?(:uid) uid_or_event.uid else uid_or_event end if path = find_path(uid) File.delete(path) else raise "Not found uid:#{uid} in #{@basedir}" end end ################################################################ private def parse_mhcc(filename) string = File.open(filename).read.scrub.gsub(/^\s*#.*$/, "").strip string.split(/\n\n\n*/).map do |header| Event.parse(header) end end def find_path(uid) glob = @basedir + ('**/' + uid + '.mhc') return Dir.glob(glob).first end def uid_to_path(uid) return @basedir + ('spool/' + uid + '.mhc') end end # class DataStore end # module Mhc module Mhc class DataStore class Cache require 'pstore' def initialize(cache_filename) @pstore = PStore.new(cache_filename) load end def lookup(uid, filename) unless c = get(uid) and File.mtime(filename).to_i <= c.mtime c = CacheEntry.new(filename) put(uid, c) end return c end def save return self unless @dirty @pstore.transaction do @pstore["root"] = @db end @dirty = false end private def get(uid) @db[uid] end def put(uid, value) @db[uid] = value @dirty = true end def load @pstore.transaction do @db = @pstore["root"] || {} end @dirty = false end end # class Cache class CacheEntry attr_reader :mtime, :range def initialize(filename) @mtime, event = File.mtime(filename).to_i, Event.parse_file(filename) @range = event.range.min.absolute_from_epoch .. event.range.max.absolute_from_epoch end def involved?(range) range.min <= @range.max && @range.min <= range.max end end # class CacheEntry end # class DataStore end # module Mhc mhc-1.1.1/lib/mhc/date_enumerator.rb000066400000000000000000000174551262546231500173230ustar00rootroot00000000000000module Mhc class EnumMerger include Enumerable alias_method :with_index, :each_with_index alias_method :with_object, :each_with_object def initialize(&block) @enumerators = [] @enumerators << Enumerator.new(&block) if block end def <<(o) @enumerators << o return self end def each rewind loop do yield self.next end end # def feed ; end def next raise StopIteration if @enumerators.empty? minimum_enumrator.next end # def next_values ; end def peek raise StopIteration if @enumerators.empty? minimum_enumrator.peek end # def peek_values ; end def rewind send_all(:rewind) end def send_all(method, *args) @enumerators.map{|e| e.send(method, *args)} end private def minimum_enumrator min_e, min_v = @enumerators.first, nil @enumerators.each do |e| v = e.peek rescue nil if v and (min_v.nil? or v < min_v) min_e, min_v = e, v end end return min_e end end # class EnumMerger class DateEnumerator < EnumMerger def initialize(start_date:, end_date:, interval: 1, &block) @start_date, @end_date, @interval = start_date, end_date, interval super(&block) end def add_yearly_by_day(start_date: @start_date, end_date: @end_date, interval: @interval, month:, nth:, wday:) self << YearlyByDay.new(start_date: start_date, end_date: end_date, interval: interval, month: month, nth: nth, wday: wday).to_enum end def add_yearly_by_monthday(start_date: @start_date, end_date: @end_date, interval: @interval, month:, mday:) self << YearlyByMonthday.new(start_date: start_date, end_date: end_date, interval: interval, month: month, mday: mday).to_enum end def add_monthly_by_day(start_date: @start_date, end_date: @end_date, interval: @interval, nth:, wday:) self << MonthlyByDay.new(start_date: start_date, end_date: end_date, interval: interval, nth: nth, wday: wday).to_enum end def add_monthly_by_monthday(start_date: @start_date, end_date: @end_date, interval: @interval, mday:) self << MonthlyByMonthday.new(start_date: start_date, end_date: end_date, interval: interval, mday: mday).to_enum end def add_weekly(start_date: @start_date, end_date: @end_date, interval: @interval, wday:) self << Weekly.new(start_date: start_date, end_date: end_date, interval: interval, wday: wday).to_enum end def add_by_range_list(start_date: @start_date, end_date: @end_date, range_list:) self << ByRangeList.new(start_date: start_date, end_date: end_date, range_list: range_list).to_enum end ################################################################ class Base include DateHelper def initialize(start_date:, end_date:, interval: 1, wkst: 1) @start_date, @end_date, @interval, @wkst = start_date, end_date, interval, wkst @frame_manager = frame_manager.new(start_date, interval, wkst) end def each head, tail = range @frame_manager.forward_to(head).each do |frame| break if frame > tail date = occurrence_in_frame(frame) next unless date break if date > tail next if date < head yield date end end private def range s = (@range_from and @start_date < @range_from) ? @range_from : @start_date e = (@range_to and @end_date > @range_to) ? @range_to : @end_date return [s, e] end def frame_manager raise "should be defined in subclasses" end def occurrence_in_frame(date) raise "should be defined in subclasses" end end # class Base ################################################################ # Enumerate yealy dates by day like: Apr 4th Tue class YearlyByDay < Base def initialize(start_date:, end_date:, interval: 1, month:, nth:, wday:) super(start_date: start_date, end_date: end_date, interval: interval) @month, @nth, @wday = month, nth, wday end private def frame_manager DateFrame::Yearly end def occurrence_in_frame(date) make_date_by_day(year: date.year, month: @month, nth: @nth, wday: @wday) rescue nil end end # class YearlyByDay ################################################################ # Enumerate yealy dates by month-day like: Apr 22 class YearlyByMonthday < Base def initialize(start_date:, end_date:, interval: 1, month:, mday:) super(start_date: start_date, end_date: end_date, interval: interval) @month, @mday = month, mday end private def frame_manager DateFrame::Yearly end def occurrence_in_frame(date) Mhc::PropertyValue::Date.new(date.year, @month, @mday) rescue nil end end # class YearlyByMonthday ################################################################ # Enumerate monthly dates by day like: 4th Tue class MonthlyByDay < Base def initialize(start_date:, end_date:, interval: 1, nth:, wday:) super(start_date: start_date, end_date: end_date, interval: interval) @nth, @wday = nth, wday end private def frame_manager DateFrame::Monthly end def occurrence_in_frame(date) make_date_by_day(year: date.year, month: date.month, nth: @nth, wday: @wday) rescue nil end end # class MonthlyByDay ################################################################ # Enumerate monthly dates by month-day like: 22 class MonthlyByMonthday < Base def initialize(start_date:, end_date:, interval: 1, mday:) super(start_date: start_date, end_date: end_date, interval: interval) @mday = mday end private def frame_manager DateFrame::Monthly end def occurrence_in_frame(date) Mhc::PropertyValue::Date.new(date.year, date.month, @mday) rescue nil end end # class MonthlyMonthday ################################################################ # Enumerate weekly dates like: Tue class Weekly < Base def initialize(start_date:, end_date:, interval: 1, wkst: 1, wday:) super(start_date: start_date, end_date: end_date, interval: interval) @wday = wday end private def frame_manager DateFrame::Weekly end # Sun Mon Tue Wed Thu Fri Sat Sun Mon Tue ... # 0 1 2 3 4 5 6 0 1 2 ... def occurrence_in_frame(date) bof = date - ((date.wday - @wkst) % 7) candidate = bof + (@wday - bof.wday) % 7 return candidate if date <= candidate return nil end end # class Weekly ################################################################ # Enumerate every n days class Daily < Base def initialize(start_date:, end_date:, interval:1) super(start_date: start_date, end_date: end_date, interval: interval) end private def frame_manager DateFrame::Daily end def occurrence_in_frame(date) return date end end # class Daily ################################################################ # Enumerate dates from list. class ByRangeList < Base def initialize(start_date:, end_date:, range_list:) super(start_date: start_date, end_date: end_date) @range_list = range_list end def each head, tail = range @range_list.each do |date_range| break if date_range.first > tail next if date_range.last < head yield date_range end end private def frame_manager DateFrame::Dummy end end # class ByRangeList end # class DateEnumerator end # module Mhc mhc-1.1.1/lib/mhc/date_frame.rb000066400000000000000000000050131262546231500162170ustar00rootroot00000000000000module Mhc module DateFrame class Dummy def initialize(start_date, interval = 1, wkst = 1) end end class Base include DateHelper def initialize(start_date, interval = 1, wkst = 1) @start_date, @interval, @wkst = start_date, interval, wkst rewind end def each loop do date = self.next yield date end end def next(cycles = 1) frame = @frame_start @frame_start = next_frame_start(cycles) return frame end def peek @frame_start end def rewind @frame_start = beginning_of_frame(@start_date) return self end # go forward to the frame in which DATE is involved def forward_to(date) rewind frames = frames_between(@frame_start, date) cycles = (frames + (@interval - 1)) / @interval self.next(cycles) if cycles > 0 return self end private def next_frame_start(cycles = 1) raise "should be defined in subclasses" end def beginning_of_frame(date) raise "should be defined in subclasses" end def frames_between(date1, date2) raise "should be defined in subclasses" end end class Yearly < Base private def next_frame_start(cycles = 1) @frame_start >> (@interval * 12 * cycles) end def beginning_of_frame(date) beginning_of_year(date) end def frames_between(date1, date2) years_between(date1, date2) end end class Monthly < Base private def next_frame_start(cycles = 1) @frame_start >> (@interval * cycles) end def beginning_of_frame(date) beginning_of_month(date) end def frames_between(date1, date2) months_between(date1, date2) end end class Weekly < Base private def next_frame_start(cycles = 1) @frame_start + (@interval * 7 * cycles) end def beginning_of_frame(date) beginning_of_week(date, @wkst) end def frames_between(date1, date2) (beginning_of_frame(date2) - beginning_of_frame(date1)) / 7 end end class Daily < Base private def next_frame_start(cycles = 1) @frame_start + (@interval * cycles) end def beginning_of_frame(date) date end def frames_between(date1, date2) date2 - date1 end end end # module DateFrame end # module Mhc mhc-1.1.1/lib/mhc/date_helper.rb000066400000000000000000000024261262546231500164110ustar00rootroot00000000000000module Mhc module DateHelper # Make a date by DAY like ``1st Wed of Nov, 1999''. # caller must make sure: # YEAR and MONTH must be valid. # NTH must be <0 or >0. # WDAY must be 0..6. # # returns nil if no date matches (for example, no 5th Saturday # exists on April 2010). # private def make_date_by_day(year:, month:, nth:, wday:) direction = nth > 0 ? 1 : -1 edge = Mhc::PropertyValue::Date.new(year, month, direction) ydiff = nth - direction xdiff = direction * ((direction * (wday - edge.wday)) % 7) mday = edge.mday + ydiff * 7 + xdiff raise ArgumentError if mday < 1 return Mhc::PropertyValue::Date.new(year, month, mday) end def beginning_of_year(date) date.class.new(date.year, 1, 1) end def beginning_of_month(date) date.class.new(date.year, date.month, 1) end def beginning_of_week(date, wkst = 1) date - ((date.wday - wkst) % 7) end def years_between(date1, date2) date2.year - date1.year end def months_between(date1, date2) (date2.year * 12 + date2.month) - (date1.year * 12 + date1.month) end def weeks_between(date1, date2) (date2 - date1 + 6) / 7 end end # module DateHelper end # module Mhc mhc-1.1.1/lib/mhc/etag.rb000066400000000000000000000022321262546231500150500ustar00rootroot00000000000000module Mhc class EtagStore def initialize(top_directory) @top_directory = top_directory end def put(key, value) if value.nil? unlink(key) else store(key, value) end end def get(uid) if value = load(uid) return value end end def uid_list keys end def report_etags(uids = nil) hash = {} uid_list.each do |uid| hash[uid] = get(uid) end return hash end private def keys Dir.glob(File.join(@top_directory, '*.etag')).map {|p| make_key(p)} end def store(key, value) File.open(make_path(key), "w") do |f| f.write(value) end end def load(key) begin File.open(make_path(key), "r") do |f| return f.read end rescue return nil end end def unlink(key) if File.exists?(path = make_path(key)) File.unlink(path) end end def make_path(key) File.join(@top_directory, key.to_s + '.etag') end def make_key(path) File.basename(path, '.etag') end end # class EtagStore end # module Mhc mhc-1.1.1/lib/mhc/event.rb000066400000000000000000000245051262546231500152600ustar00rootroot00000000000000# -*- coding: utf-8 -*- ### event.rb ## ## Author: Yoshinari Nomura ## ## Created: 1999/07/16 ## Revised: $Date: 2008-10-08 03:22:37 $ ## module Mhc # Mhc::Event defines a simple representation of calendar events. # It looks like a RFC822 message with some X- headers to represent event properties: # * X-SC-Subject: # * X-SC-Location: # * X-SC-Day: # * X-SC-Time: # * X-SC-Category: # * X-SC-Recurrence-Tag: # * X-SC-Mission-Tag: # * X-SC-Cond: # * X-SC-Duration: # * X-SC-Alarm: # * X-SC-Record-Id: # * X-SC-Sequence: # class Event ################################################################ ## initializers def initialize clear end def self.parse(string) return new.parse(string) end def self.parse_file(path, lazy = true) return new.parse_file(path, lazy) end def parse_file(path, lazy = true) STDOUT.puts "parsing #{File.expand_path(path)}" if $MHC_DEBUG clear header, body = nil, nil File.open(path, "r") do |file| header = file.gets("\n\n") body = file.gets(nil) unless lazy end @path = path if lazy parse_header(header) self.description = body if body return self end def parse(string) clear header, body = string.scrub.split(/\n\n/, 2) parse_header(header) self.description = body return self end def self.new_from_ics(ics_string) Mhc::Converter::IcalendarImporter.parse_ics(ics_string) end def path return @path end ################################################################ ## access methods to each property. ## alarm def alarm return @alarm ||= Mhc::PropertyValue::Period.new end def alarm=(string) return @alarm = alarm.parse(string) end ## category def categories return @categories ||= Mhc::PropertyValue::List.new(Mhc::PropertyValue::Text) end def categories=(string) return @categories = categories.parse(string) end def holiday? in_category?("holiday") end def in_category?(category) categories.map{|c| c.to_s.downcase}.member?(category.downcase) end ## description def description unless @description @description = Mhc::PropertyValue::Text.new if lazy? && File.file?(@path) File.open(@path, "r") do |file| file.gets("\n\n") # discard header. @description.parse(file.gets(nil)) end end end return @description end alias_method :body, :description def description=(string) return @description = description.parse(string) end ## location def location return @location ||= Mhc::PropertyValue::Text.new end def location=(string) return @location = location.parse(string) end ## record-id def record_id return @record_id ||= Mhc::PropertyValue::Text.new end def record_id=(string) return @record_id = record_id.parse(string) end def uid record_id.to_s end ## subject def subject return @subject ||= Mhc::PropertyValue::Text.new end def subject=(string) return @subject = subject.parse(string) end ## date list is a list of date range def dates return @dates ||= Mhc::PropertyValue::List.new(Mhc::PropertyValue::Range.new(Mhc::PropertyValue::Date.new)) end def dates=(string) string = string.split.select {|s| /^!/ !~ s}.join(" ") return @dates = dates.parse(string) end def obsolete_dates=(string) # STDERR.print "Obsolete X-SC-Date: header.\n" if /(\d+)\s+([A-Z][a-z][a-z])\s+(\d+)\s+(\d\d:\d\d)/ =~ string dd, mm, yy, hhmm = $1.to_i, $2, $3.to_i + 1900, $4 mm = ("JanFebMarAprMayJunJulAugSepOctNovDec".index(mm)) / 3 + 1 @dates = dates.parse("%04d%02d%02d" % [yy, mm, dd]) if hhmm and hhmm != '00:00' @time_range = time_range.parse(hhmm) end end end def exceptions return @exceptions ||= Mhc::PropertyValue::List.new(Mhc::PropertyValue::Range.new(Mhc::PropertyValue::Date.new, "!")) end def exceptions=(string) string = string.split.select {|s| /^!/ =~ s}.map{|s| s[1..-1]}.join(" ") return @exceptions = exceptions.parse(string) end ## time def time_range return @time_range ||= Mhc::PropertyValue::Range.new(Mhc::PropertyValue::Time) end def time_range=(string) @time_range = time_range.parse(string) return @time_range end ## duration def duration return @duration ||= Mhc::PropertyValue::Range.new(Mhc::PropertyValue::Date) end def duration=(string) return @duration = duration.parse(string) end ## recurrence condition def recurrence_condition return @cond ||= Mhc::PropertyValue::RecurrenceCondition.new end def recurrence_condition=(string) return @cond = recurrence_condition.parse(string) end ## recurrence-tag def recurrence_tag return @recurrence_tag ||= Mhc::PropertyValue::Text.new end def recurrence_tag=(string) return @recurrence_tag = recurrence_tag.parse(string) end ## mission-tag def mission_tag return @mission_tag ||= Mhc::PropertyValue::Text.new end def mission_tag=(string) return @mission_tag = mission_tag.parse(string) end ## sequence def sequence return @sequence ||= Mhc::PropertyValue::Integer.new.parse("0") end def sequence=(string) return @sequence = sequence.parse(string.to_s) end def occurrences(range:nil) Mhc::OccurrenceEnumerator.new(self, dates, exceptions, recurrence_condition, duration, range) end def etag return "#{uid.to_s}-#{sequence.to_s}" end def recurring? not recurrence_condition.empty? end def allday? time_range.blank? end def range min0, max0 = Mhc::PropertyValue::Date.parse("19000101"), Mhc::PropertyValue::Date.parse("99991231") if recurring? min, max = min0, max0 else min, max = dates.min, dates.max min = min.respond_to?(:first) ? min.first : min0 max = max.respond_to?(:last) ? max.last : max0 end min = duration.first if duration.first && duration.first > min max = duration.last if duration.last && duration.last < max return min..max if min && max && min <= max STDERR.puts "Warn: invalid date range? #{self.uid}" return min0..max0 end ################################################################ ### dump def dump non_xsc_header = @non_xsc_header.to_s.sub(/\n+\z/, "") non_xsc_header += "\n" if non_xsc_header != "" body = description.to_mhc_string body += "\n" if body != "" && body !~ /\n\z/ return dump_header + non_xsc_header + "\n" + body end def dump_header return "X-SC-Subject: #{subject.to_mhc_string}\n" + "X-SC-Location: #{location.to_mhc_string}\n" + "X-SC-Day: " + "#{dates.to_mhc_string} #{exceptions.to_mhc_string}".strip + "\n" + "X-SC-Time: #{time_range.to_mhc_string}\n" + "X-SC-Category: #{categories.to_mhc_string}\n" + "X-SC-Mission-Tag: #{mission_tag.to_mhc_string}\n" + "X-SC-Recurrence-Tag: #{recurrence_tag.to_mhc_string}\n" + "X-SC-Cond: #{recurrence_condition.to_mhc_string}\n" + "X-SC-Duration: #{duration.to_mhc_string}\n" + "X-SC-Alarm: #{alarm.to_mhc_string}\n" + "X-SC-Record-Id: #{record_id.to_mhc_string}\n" + "X-SC-Sequence: #{sequence.to_mhc_string}\n" end alias_method :to_mhc_string, :dump ################################################################ ### converter def to_ics Mhc::Converter::Icalendar.new.to_ics(self) end def to_icalendar Mhc::Converter::Icalendar.new.to_icalendar(self) end def to_ics_string Mhc::Converter::Icalendar.new.to_ics_string(self) end ################################################################ private def lazy? return !@path.nil? end def clear @alarm, @categories, @description, @location = [nil]*4 @record_id, @subject = [nil]*2 @dates, @exceptions, @time_range, @duration, @cond, @oc = [nil]*6 @non_xsc_header, @path = [nil]*2 return self end def parse_header_full(string) xsc, @non_xsc_header = separate_header(string) parse_xsc_header(xsc) return self end def parse_header(string) hash = {} string.scan(/^x-sc-([^:]++):[ \t]*([^\n]*(?:\n[ \t]+[^\n]*)*)/i) do |key, val| hash[key.downcase] = val.gsub("\n", " ").strip end parse_xsc_header(hash) return self end def parse_xsc_header(hash) hash.each do |key, val| case key when "day" ; self.dates = val ; self.exceptions = val when "date" ; self.obsolete_dates = val when "subject" ; self.subject = val when "location" ; self.location = val when "time" ; self.time_range = val when "duration" ; self.duration = val when "category" ; self.categories = val when "mission-tag" ; self.mission_tag = val when "recurrence-tag" ; self.recurrence_tag = val when "cond" ; self.recurrence_condition = val when "alarm" ; self.alarm = val when "record-id" ; self.record_id = val when "sequence" ; self.sequence = val else # raise NotImplementedError, "X-SC-#{key.capitalize}" # STDERR.print "Obsolete: X-SC-#{key.capitalize}\n" end end return self end ## return: X-SC-* headers as a hash and ## non-X-SC-* headers as one string. def separate_header(header) xsc, non_xsc, xsc_key = {}, "", nil header.split("\n").each do |line| if line =~ /^X-SC-([^:]+):(.*)/i xsc_key = $1.downcase xsc[xsc_key] = $2.to_s.strip elsif line =~ /^\s/ && xsc_key xsc[xsc_key] += " " + line else xsc_key = nil non_xsc += line + "\n" end end return [xsc, non_xsc] end end # class Event end # module Mhc mhc-1.1.1/lib/mhc/formatter.rb000066400000000000000000000233571262546231500161460ustar00rootroot00000000000000# -*- coding: utf-8 -*- module Mhc class FormatterNameError < StandardError; end class Formatter def self.build(formatter:, date_range:, **options) case formatter.to_sym when :text Text.new(date_range: date_range, options:options) when :mail Mail.new(date_range: date_range, options:options) when :orgtable OrgTable.new(date_range: date_range, options:options) when :emacs Emacs.new(date_range: date_range, options:options) when :icalendar ICalendar.new(date_range: date_range, options:options) when :calfw SymbolicExpression.new(date_range: date_range, options:options) when :howm Howm.new(date_range: date_range, options:options) when :json FullCalendar.new(date_range: date_range, options:options) else raise FormatterNameError.new("Unknown format: #{formatter} (#{formatter.class})") end end class Base def initialize(date_range:, options:nil) @date_range = date_range @options = options @occurrences, @events, @items = [], [], {} @event_hash = {} end def <<(occurrence) event = occurrence.event @occurrences << occurrence @events << event unless @event_hash[event] @event_hash[event] = true @items[occurrence.date] ||= [] @items[occurrence.date] << occurrence end def to_s context = {:items => @items}.merge(@options) prepare(context) string = format_header(context) + format_body(context) + format_footer(context) teardown(context) return string end ################################################################ private def prepare(context); end def teardown(context); end def pad_empty_dates @date_range.each do |date| @items[date] ||= [] end end def expand_multiple_days_occurrences @occurrences.each do |oc| next if oc.oneday? ((oc.first + 1) .. oc.last).each do |date| @items[date] ||= [] @items[date] << oc end end end def format_header(context); ""; end def format_footer(context); ""; end def format_day_header(context, date, is_holiday); ""; end def format_day_footer(context, date); ""; end def format_body(context) context[:number] = 0 @items.keys.sort.map{|date| format_day(context, date, @items[date]) }.join end def format_day(context, date, items) string = format_day_header(context, date, items.any?{|e| e.holiday?}) items = sort_items_in_day(items) items.each_with_index do |occurrence, count| context[:number] += 1 context[:number_in_day] = count + 1 string += format_item(context, date, occurrence) end return string + format_day_footer(context, date) end def format_item(context, date, item) format("%s%-11s %s%s\n", format_item_header(context, date, item), item.time_range.to_mhc_string.toutf8, item.subject.to_s.toutf8, append(enclose(item.location)).toutf8 ) end def format_item_header(context, date, item) if context[:number_in_day] == 1 date.strftime("%Y/%m/%d %a ") else " " * 15 end end ################################################################ ## helpers def append(item, separator = " ") return "" if item.to_s.empty? return separator + item.to_s end def prepend(item, separator = " ") return "" if item.to_s.empty? return item.to_s + separator end def enclose(item, bracket = "[]") return "" if item.to_s.empty? return bracket[0] + item.to_s + bracket[1] end # sort occurrences in a day # make sure all-day occurrences are prior to others def sort_items_in_day(items) items.sort do |a,b| sign_a = a.allday? ? 0 : 1 sign_b = b.allday? ? 0 : 1 if sign_a != sign_b sign_a - sign_b else a <=> b end end end end class Text < Base def prepare(context) expand_multiple_days_occurrences end end # class Text class Mail < Base private def format_header(context) mail_address = context[:mailto].to_s subject = format("MHC schedule report (%s--%s)", *context[:items].keys.minmax) header = "To: #{mail_address}\n" header += "From: #{append(mail_address, "secretary-of-")}\n" header += "Subject: #{subject}\n" header += "Content-Type: Text/Plain; charset=utf-8\n" header += "Content-Transfer-Encoding: 8bit\n" header += "\n" header += format("* mhc %s--%s\n", *context[:items].keys.minmax) end end # class Mail class SymbolicExpression < Base private def format_header(context); "("; end def format_footer(context); "(periods #{@periods}))\n"; end def format_day_header(context, date, is_holiday) date.strftime("((%2m %2d %Y) . (") end def format_item(context, date, item) unless item.oneday? format_multiple_days_item(context, date, item) return "" end format_item_line(item) end def format_multiple_days_item(context, date, item) @periods ||= "" @periods += item.first.strftime("((%2m %2d %Y) ") + item.last.strftime(" (%2m %2d %Y) ") + format_item_line(item) + ') ' end def format_day_footer(context, date); ")) "; end def format_item_line(item) '"' + format("%s%s%s", prepend(item.time_range.first.to_s).toutf8, item.subject.to_s.toutf8, append(enclose(item.location)).toutf8).gsub(/[\"\\]/, '\\\\\&') + '" ' end end class Emacs < SymbolicExpression private def prepare(context) expand_multiple_days_occurrences end def format_header(context); "("; end def format_footer(context); ")\n"; end def format_day_header(context, date, is_holiday) # (DAYS_FROM_EPOC . [year month day wday holiday-p ( format("(%d . [%d %d %d %d #{is_holiday ? 't' : 'nil'} (", date.absolute_from_epoch, date.year, date.month, date.day, date.wday) end def format_item(context, date, item) # [ RECORD CONDITION SUBJECT LOCATION (TIMEB . TIMEE) ALARM CATEGORIES PRIORITY REGION RECURRENCE-TAG] format("[(%s . [%s nil nil]) nil %s %s (%s . %s) %s (%s) nil nil %s]", elisp_string(item.path.to_s), elisp_string(item.uid.to_s), elisp_string(item.subject), elisp_string(item.location), (item.time_range.first ? (item.time_range.first.to_i / 60) : "nil"), (item.time_range.last ? (item.time_range.last.to_i / 60) : "nil"), elisp_string(item.alarm.to_s), item.categories.map{|c| elisp_string(c.to_s.downcase)}.join(" "), elisp_string(item.recurrence_tag)) end def format_day_footer(context, date) ")]) " end def elisp_string(string) '"' + string.to_s.toutf8.gsub(/[\"\\]/, '\\\\\&') + '"' end end class ICalendar < Base private def format_body(context) ical = RiCal.Calendar ical.prodid = Mhc::PRODID @events.each do |event| ical.events << event.to_icalendar end return ical.to_s end end class OrgTable < Base private def format_header(context) format("* mhc %s--%s\n", *context[:items].keys.minmax) end def format_item(context, date, item) # | No | Mission | Recurrence | Subject | Path | Date | format(" | %4d | %s | %s | %s | %s | [%04d-%02d-%02d%s] |\n", context[:number], item.mission_tag.to_s.toutf8, item.recurrence_tag.to_s.toutf8, item.subject.to_s.toutf8, item.path.to_s, date.year, date.month, date.mday, append(item.time_range.to_s)) end end # class OrgTable class Howm < Base private def format_header(context) format("= mhc %s--%s\n", *context[:items].keys.minmax) end def format_item(context, date, item) string = format("[%04d-%02d-%02d %5s]%1s %s\n", date.year, date.month, date.mday, item.time_range.first.to_s, mark_todo(item.categories.to_mhc_string), item.subject) if item.description.to_s != "" string += item.description.to_s.gsub(/^/, " ") + "\n" end return string end def mark_todo(category) case category when /done/i "." when /todo/i "+" else "@" end end end # class Howm class FullCalendar < Base require "json" def format_body(context) events = [] @occurrences.each do |oc| class_name = [] class_name += oc.categories.map{|c| "mhc-category-#{c.to_s.downcase}"} class_name << (oc.allday? ? "mhc-allday" : "mhc-time-range") events << { id: oc.record_id, allDay: oc.allday?, title: oc.subject, start: oc.dtstart.iso8601, end: oc.dtend.iso8601, className: class_name } end return events.to_json end end # class FullCalendar end # module Formatter end # module Mhc mhc-1.1.1/lib/mhc/logger.rb000066400000000000000000000041011262546231500154040ustar00rootroot00000000000000module Mhc ################################################################ # Log maintenance functions. # # M 2000-04-25 00:06:08 <20.nom@.nomcom> ~nom/Mail/schedule/2000/04/1 Luncheon # D 2000-04-25 00:06:08 <20.nom@.nomcom> ~nom/Mail/schedule/2000/04/1 Luncheon # S 2000-04-25 00:06:08 user_id # class Logger def initialize(filename) @filename = filename end def add_entry(entry) file = File.open(@filename, "a+") file.print "#{entry}\n" file.fsync if file.respond_to?("fsync") file.close end def each_entry begin file = File.open(@filename) while line = file.gets yield(LogEntry.new(line.chomp)) end file.close rescue end end def entries() arry = [] each_entry{|e| arry << e } return arry end def shrink_entries(user_id) hash = {} each_entry{|e| if e.status == 'S' and e.rec_id == user_id hash.clear else hash[e.rec_id] = e end } return hash.values end end class LogEntry attr :status attr :mtime attr :rec_id attr :path attr :subject def initialize(status, mtime = nil, rec_id = nil, path = nil, subject = nil) if mtime.nil? init_from_string(status) else @status, @mtime, @rec_id, @path, @subject = status, mtime, rec_id, path, subject end end def to_s return [ @status, @mtime.strftime("%Y-%m-%d %H:%M:%S"), @rec_id, @path, @subject ].join(' ') end ################ private ################ def init_from_string(line) str = line.chomp status, yymmdd, hhmmss, rec_id, path, subject = str.split yy, mm, dd = yymmdd.split('-') h, m, s = hhmmss.split(':') mtime = Time.local(yy.to_i, mm.to_i, dd.to_i, h .to_i, m .to_i, s .to_i) @status, @mtime, @rec_id, @path, @subject = status, mtime, rec_id, path, subject end end end mhc-1.1.1/lib/mhc/modifier.rb000066400000000000000000000060531262546231500157330ustar00rootroot00000000000000module Mhc class Modifier class ParseError < StandardError; end attr_accessor :name def initialize(name) @name = name end def to_s @name.to_s end def decorate(event) if deco = Decorator.find_subclass(@name.to_sym) deco.new(event) else raise Mhc::Modifier::ParseError, "Unknown Decorator #{@name}" end end class Decorator require 'forwardable' extend Forwardable def_delegators :@event, :path, :alarm, :categories, :description, :body, :location, :priority, :record_id, :occurrences, :uid, :subject, :dates, :exceptions, :time_range, :duration, :recurrence_condition, :recurrence_tag, :mission_tag, :sequence, # :occurrences, :dtstart, :dtend, :rdates, :exdates, :etag, :recurring?, :allday? def self.find_subclass(snake_name) @subclasses ||= {} if c = @subclasses[snake_name] return c end class_name = snake_name.to_s.capitalize.gsub(/_([a-z\d]+)/){ $1.capitalize }.to_sym return nil unless const_defined?(class_name) const = const_get(class_name) if const.class == Class and const.superclass == self return @subclasses[snake_name] = const end return nil end def initialize(event) @event = event end def to_ics Mhc::Converter::Icalendar.new.to_ics(self) end def to_icalendar Mhc::Converter::Icalendar.new.to_icalendar(self) end def to_ics_string Mhc::Converter::Icalendar.new.to_ics_string(self) end def occurrences(range:nil) Mhc::OccurrenceEnumerator.new(self, dates, exceptions, recurrence_condition, duration, range) end class HideDetails < Decorator def subject return Mhc::PropertyValue::Text.new.parse("BUSY") end def location return nil end def description return nil end alias_method :body, :description end # class HideDetails class HideDescription < Decorator def description return nil end alias_method :body, :description end # class HideDescription class HideLocation < Decorator def location return nil end end # class HideLocation class HideTimeRange < Decorator def allday? return true end def time_range # create empty time_range Mhc::PropertyValue::Range.new(Mhc::PropertyValue::Time) end end # class HideTimeRange class ReplaceSubjectByCategory < Decorator def subject categories = @event.categories return "BUSY" if categories.empty? return categories.first.to_s.capitalize end end # class ReplaceSubjectByCategory end # class Decorator end # class Modifier end # module Mhc mhc-1.1.1/lib/mhc/occurrence.rb000066400000000000000000000032611262546231500162630ustar00rootroot00000000000000require 'forwardable' module Mhc class Occurrence include Comparable extend Forwardable def_delegators :@event, :path, :alarm, :categories, :description, :body, :location, :priority, :record_id, :uid, :subject, :time_range, :recurrence_tag, :mission_tag, :allday?, :holiday? attr_reader :event def initialize(event, date_range) @event = event if date_range.respond_to?(:first) @start_date = date_range.first @end_date = date_range.last else @start_date = date_range @end_date = date_range end end def date @start_date end def dtstart if allday? @start_date else time_range.first.to_datetime(@start_date) end end def dtend if allday? @end_date + 1 else time_range.last.to_datetime(@end_date) end end def first @start_date end def last @end_date end def days @end_date - @start_date + 1 end def oneday? @start_date == @end_date end def to_mhc_string if allday? return "#{dtstart.to_mhc_string}" if oneday? return "#{@start_date.to_mhc_string}-#{@end_date.to_mhc_string}" else return dtstart.strftime("%Y%m%d %H:%m-") + ((@start_date == @end_date) ? dtend.strftime("%H:%m") : dtend.strftime("%Y%m%dT%H:%m")) end end alias_method :to_s, :to_mhc_string def <=>(o) if o.respond_to?(:dtstart) return self.dtstart <=> o.dtstart else return self.dtstart <=> o end end end # class Occurrence end # module Mhc mhc-1.1.1/lib/mhc/occurrence_enumerator.rb000066400000000000000000000077311262546231500205320ustar00rootroot00000000000000module Mhc class OccurrenceEnumerator include Enumerable # ; The FREQ rule part is REQUIRED, # ; but MUST NOT occur more than once. # # FREQ = (DAILY|WEEKLY|MONTHLY|YEARLY) # # ; The UNTIL or COUNT rule parts are OPTIONAL, # ; but they MUST NOT occur in the same 'recur'. # # UNTIL = (date|date-time) # COUNT = \d+ # # ; The other rule parts are OPTIONAL, # ; but MUST NOT occur more than once. # # INTERVAL = \d+ # positive value default is 1 # BYDAY = ([+-]\d{1,2})?(SU|MO|TU|WE|TH|FR|SA),... # 1 to 53 # BYMONTHDAY = [+-]\d{1,2},... # 1 to 31 # BYYEARDAY = [+-]\d{1,3},... # 1 to 366 # BYWEEKNO = [+-]\d{1,3},... # 1 to 53 # BYMONTH = \d{1,2},... # 1 to 12 # BYSETPOS = [+-]\d+,... # 1 to 366 # WKST = (SU|MO|TU|WE|TH|FR|SA) # def initialize(event, dates, exceptions, recurrence_condition, duration, date_range = nil) @event = event # Since some articles with RECURRENCE_CONDITION and without DURATION # makes infinit entries, we have to clip the range by some artificial values # It will make 101 enum entries from 1970-1-1 to now+50 years: # # X-SC-Subject: New Year's Day # X-SC-Cond: Jan 1 # date_range = (Date.new(1970, 1, 1) .. Date.new(Date.today.year + 50)) unless date_range # If we have both DURATION and RANGE, we can take narrower term # by the combination of the both. date_range = duration.narrow(date_range.first, date_range.last) # range.last is effective in narrowing the end_date, # however, we can't adopt range.first to the start_date. # Original start_date derived from DURATION is required for calculating # the start point of recurrence loop in case the # loop interval is larger than one. # # At moment, we will have over-scanning entries even if the range.first # is set narrower than duration.first # # we need some good way to pass the both duration.first and range.first # to the down-stream enumerators. # end_date = date_range.last start_date = duration.first || date_range.first @enumerator = Mhc::DateEnumerator.new(start_date: start_date, end_date: date_range.last) condition_to_enumerator(@enumerator, recurrence_condition, start_date, date_range.last) @enumerator.add_by_range_list(range_list: dates) @exceptions = exceptions.map{|range| range.to_a }.flatten @date_range = date_range end def each @enumerator.each do |date_or_range| if date_or_range.respond_to?(:first) first_date = date_or_range.first last_date = date_or_range.last else first_date = date_or_range last_date = date_or_range end if last_date < @date_range.first or @date_range.last < first_date next end next if @exceptions.include?(first_date) yield Mhc::Occurrence.new(@event, date_or_range) end end private def condition_to_enumerator(enumerator, cond, start_date, end_date) if cond.yearly? cond.cond_mon.each do |mon| cond.cond_ord.each do |ord| cond.cond_wek.each do |wek| enumerator.add_yearly_by_day(month: mon, nth: ord, wday: wek) end end cond.cond_num.each do |num| enumerator.add_yearly_by_monthday(month: mon, mday: num) end end elsif cond.monthly? cond.cond_ord.each do |ord| cond.cond_wek.each do |wek| enumerator.add_monthly_by_day(nth: ord, wday: wek) end end cond.cond_num.each do |num| enumerator.add_monthly_by_monthday(mday: num) end elsif cond.weekly? cond.cond_wek.each do |wek| enumerator.add_weekly(wday: wek) end end return enumerator end end # class OccurrenceEnumerator end # module Mhc mhc-1.1.1/lib/mhc/property_value.rb000066400000000000000000000016031262546231500172110ustar00rootroot00000000000000module Mhc module PropertyValue class ParseError < StandardError; end class Base def self.parse(string) return self.new.parse(string) end def parse(string) @value = string return self end def to_mhc_string return @value.to_s end alias_method :to_s, :to_mhc_string end dir = File.dirname(__FILE__) + "/property_value" autoload :Date, "#{dir}/date.rb" autoload :Integer, "#{dir}/integer.rb" autoload :List, "#{dir}/list.rb" autoload :Period, "#{dir}/period.rb" autoload :Range, "#{dir}/range.rb" autoload :RecurrenceCondition, "#{dir}/recurrence_condition.rb" autoload :Text, "#{dir}/text.rb" autoload :Time, "#{dir}/time.rb" end # modlue PropertyValue end # module Mhc mhc-1.1.1/lib/mhc/property_value/000077500000000000000000000000001262546231500166645ustar00rootroot00000000000000mhc-1.1.1/lib/mhc/property_value/date.rb000066400000000000000000000117111262546231500201270ustar00rootroot00000000000000# -*- coding: utf-8 -*- require "date" module Mhc module PropertyValue class Date < ::Date DAYS_OF_MONTH = [0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] def self.parse(string) if /^(\d{4})(\d{2})(\d{2})$/ =~ string # don't use super(string) because it's slow. new($1.to_i, $2.to_i, $3.to_i) else return nil # raise ParseError end end def self.parse_relative(date_string) case (date_string.downcase) when 'today' return self.today when 'tomorrow' return self.today.succ when /^\d{8}$/ return self.parse(date_string) when /^\d{6}$/ return self.parse(date_string + '01') when /^thismonth$/ return self.today.first_day_of_month when /^nextmonth$/ return self.today.first_day_of_month.next_month else raise ParseError, "invalid date string '#{date_string}'" end end def self.parse_range(range_string) case range_string # all when /^all$/ return self.parse("19700101")..self.today + 365*10 # 10 years ahead # yyyymmdd-yyyymmdd when /^([^+-]+)-([^+-]+)$/ return parse_relative($1)..parse_relative($2) # yyyymmdd+2w when /^([^+-]+)\+(\d+)([dwm])$/ date = parse_relative($1) return date..date.succ_by($3, $2.to_i).prev_day when /^(thismonth|nextmonth|\d{6})$/ date = parse_relative($1) return date..date.last_day_of_month when /^([^+-]+)$/ date = parse_relative($1) return date..date else raise ParseError, "invalid date range string '#{range_string}'" end end def succ_by(unit = :d, number = 1) case unit.to_sym when :d return self + number.to_i when :w return self + (number.to_i * 7) when :m return self >> number.to_i end end def parse(string) if /^\d{8}$/ =~ string self.class.parse(string) else return nil # raise ParseError end end def add_time(time = nil) if time return ::Time.local(year, month, mday, time.hour, time.minute) else return ::Time.local(year, month, mday, 0, 0) end end def to_mhc_string return strftime("%Y%m%d") end alias_method :to_s, :to_mhc_string def last_week_of_month? return mday > days_of_month - 7 end def week_number_of_month return (mday - 1) / 7 + 1 end def days_of_month return DAYS_OF_MONTH[month] + (month == 2 && leap? ? 1 : 0) end def first_day_of_month return self.class.new(year, month, 1) end def last_day_of_month return self.class.new(year, month, -1) end def each_day_in_month for d in (1 .. days_of_month) yield self.class.new(year, month, d) end end def today? return self.class.today == self end def absolute_from_epoch return (self - Date.new(1970, 1, 1)).to_i end # # Make a date by DAY like ``1st Wed of Nov, 1999''. # caller must make sure: # YEAR and MONTH must be valid. # NTH must be <0 or >0. # WDAY must be 0..6. # # returns nil if no date was match (for example, # no 5th Saturday exists on April 2010). # def self.new_by_day(year, month, nth, wday) return nil if nth < -5 or nth > 5 or nth == 0 direction = nth > 0 ? 1 : -1 edge = Date.new(year, month, direction) y_offset = nth - direction x_offset = wday_difference(edge.wday, wday, direction) mday = edge.mday + y_offset * 7 + x_offset return new(year, month, mday) # May raise ArgumentError end def next_monthday(month, mday) year = self.year + (month < self.month ? 1 : 0) return self.class.new(year, month, mday) end def next_day(month, nth, wday) year = self.year + (month < self.month ? 1 : 0) year += 1 while !(date = self.class.new_by_day(year, month, nth, wday)) return date end def to_ics return strftime("%Y%m%d") end private # # Returns diff of days between 2 wdays: FROM and TO. # Each FROM and TO is one of 0(=Sun) ... 6(Sat). # # DIRECTION must be -1 or 1, which represents search direction. # # Sun Mon Tue Wed Thu Fri Sat Sun Mon Tue ... # 0 1 2 3 4 5 6 0 1 2 ... # # returns 3 if FROM, TO, DIRECTION = 4, 0, 1 # returns -4 if FROM, TO, DIRECTION = 4, 0, -1 # def wday_difference(from, to, direction) return direction * ((direction * (to - from)) % 7) end end # class Date end # module PropertyValue end # module Mhc mhc-1.1.1/lib/mhc/property_value/integer.rb000066400000000000000000000004301262546231500206430ustar00rootroot00000000000000module Mhc module PropertyValue class Integer < Base def parse(string) @value = string.to_i if /^\d+$/ =~ string return self end def to_i @value.to_i end end # class Integer end # module PropertyValue end # module Mhc mhc-1.1.1/lib/mhc/property_value/list.rb000066400000000000000000000014001262546231500201570ustar00rootroot00000000000000module Mhc module PropertyValue class List < Base include Enumerable ITEM_SEPARATOR = " " def initialize(item_class) @list = [] @item_class = item_class end def each @list.each do |value| yield value end end def include?(o) @list.include?(o) end def empty? @list.empty? end def parse(string) string.strip.split(ITEM_SEPARATOR).each do |str| item = @item_class.parse(str) @list << item if item end return self end def to_mhc_string @list.map{|item| item.to_mhc_string}.join(ITEM_SEPARATOR) end end # class List end # module PropertyValue end # module Mhc mhc-1.1.1/lib/mhc/property_value/period.rb000066400000000000000000000023311262546231500204720ustar00rootroot00000000000000module Mhc module PropertyValue class Period < Base UNIT2MIN = {'minute' => 1, 'hour' => 60, 'day' => 60*24} UNITS = UNIT2MIN.keys REGEXP = /(\d+)\s*(#{UNITS.join("|")})s?/ def self.parse(string) return new.parse(string) end def parse(string) if REGEXP =~ string @minutes = (UNIT2MIN[$2] * $1.to_i) end return self end def to_mhc_string return "" unless @minutes value, unit_size, unit_name = @minutes, 1, "minute" UNIT2MIN.each do |unit,minutes| if @minutes % minutes == 0 value = @minutes / minutes unit_size = minutes unit_name = unit end end return "#{value} #{unit_name}" + (value > 1 ? "s" : "") end def alarm_trigger duration = nil if @alarm seconds = @alarm duration = "-P" duration += "#{seconds /= 86400}D" if seconds >= 86400 duration += "T#{seconds /= 3600}H" if seconds >= 3600 duration += "T#{seconds /= 60}M" if seconds >= 60 end return duration end end # class Period end # module PropertyValue end # module Mhc mhc-1.1.1/lib/mhc/property_value/range.rb000066400000000000000000000047021262546231500203100ustar00rootroot00000000000000module Mhc module PropertyValue class Range < Base include Comparable ITEM_SEPARATOR = "-" attr_reader :first, :last def initialize(item_class, prefix = nil, first = nil, last = nil) @item_class, @prefix = item_class, prefix @first, @last = first, last end # our Range acceps these 3 forms: # (1) A-B : first, last = A, B # (2) A : first, last = A, A # (3) A- : first, last = A, nil # (4) -B : first, last = nil, B # # nil means range is open (infinite). # def parse(string) @first, @last = nil, nil first, last = string.split(ITEM_SEPARATOR, 2) last = first if last.nil? # single "A" means "A-A" @first = @item_class.parse(first) unless first.to_s == "" @last = @item_class.parse(last) unless last.to_s == "" return self.class.new(@item_class, @prefix, @first, @last) end def to_a array = [] i = first while i <= last array << i i = i.succ end return array end def each i = first while i <= last yield(i) i = i.succ end end def narrow(from, to) from = @first if from.nil? or (@first and from < @first) to = @last if to.nil? or (@last and to > @last) self.class.new(@item_class, @prefix, from, to) end def <=>(o) o = o.first if o.respond_to?(:first) safe_comp(self.first, o) end def infinit? return @first.nil? || @last.nil? end def blank? @first.nil? && @last.nil? end def to_mhc_string first = @first.nil? ? "" : @first.to_mhc_string last = @last.nil? ? "" : @last.to_mhc_string if first == last return @prefix.to_s + first else return @prefix.to_s + [first, last].join(ITEM_SEPARATOR) end end alias_method :to_s, :to_mhc_string private def cover?(item) return false if @first && item < @first return false if @last && item > @last return true end def safe_comp(a, o) # nil is minimum return (a <=> o) if a and o return -1 if !a and o return 1 if a and !o return 0 if !a and !o end end # class Range end # module PropertyValue end # module Mhc mhc-1.1.1/lib/mhc/property_value/recurrence_condition.rb000066400000000000000000000224041262546231500234160ustar00rootroot00000000000000module Mhc module PropertyValue class RecurrenceCondition < Base # :stopdoc: MON_LABEL = %w(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) MON_VALUE = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12] MON_L2V = Hash[*MON_LABEL.zip(MON_VALUE).flatten] MON_V2L = MON_L2V.invert ORD_LABEL = %w(1st 2nd 3rd 4th 5th Last) ORD_VALUE = [1, 2, 3, 4, 5, -1] ORD_L2V = Hash[*ORD_LABEL.zip(ORD_VALUE).flatten] ORD_V2L = ORD_L2V.invert WEK_LABEL = %w(Sun Mon Tue Wed Thu Fri Sat) WEK_VALUE = [0, 1, 2, 3, 4, 5, 6] WEK_L2V = Hash[*WEK_LABEL.zip(WEK_VALUE).flatten] WEK_V2L = WEK_L2V.invert WEK_V2I = Hash[*WEK_VALUE.zip(%w(SU MO TU WE TH FR SA)).flatten] MON_REGEXP = /^#{MON_LABEL.join('|')}$/oi ORD_REGEXP = /^#{ORD_LABEL.join('|')}$/oi WEK_REGEXP = /^#{WEK_LABEL.join('|')}$/oi NUM_REGEXP = /^\d+$/oi # :startdoc: def cond_mon; return @cond_mon; end def cond_ord; return @cond_ord; end def cond_wek; return @cond_wek; end def cond_num; return @cond_num; end def initialize @cond_mon, @cond_ord, @cond_wek, @cond_num = [], [], [], [] end def parse(string) o = self string.split.grep(MON_REGEXP) {|mon| o.cond_mon << MON_L2V[mon.capitalize]} string.split.grep(ORD_REGEXP) {|ord| o.cond_ord << ORD_L2V[ord.capitalize]} string.split.grep(WEK_REGEXP) {|wek| o.cond_wek << WEK_L2V[wek.capitalize]} string.split.grep(NUM_REGEXP) {|num| o.cond_num << num.to_i} return o end #-- # MON NUM ORD WEK RFC2445-TYPE (!: invalid) # ------------------------------------------------------------------ # - - - - ! EMPTY # - - - Y WEEKLY BYDAY=wek # - - Y - ! MONTHLY BYDAY=ord*ALL # - - Y Y MONTHLY BYDAY=ord*wek # - Y - - MONTHLY BYMONTHDAY=num # - Y - Y MONTHLY BYMONTHDAY=num,BYDAY=wek # - Y Y - ! MONTHLY BYMONTHDAY=num,BYDAY=ord*ALL # - Y Y Y MONTHLY BYMONTHDAY=num,BYDAY=ord*wek # Y - - - ! YEARLY BYMONTH=mon,BYDAY=ALL # Y - - Y YEARLY BYMONTH=mon,BYDAY=wek # Y - Y - ! YEARLY BYMONTH=mon,BYDAY=ord*ALL # Y - Y Y YEARLY BYMONTH=mon,BYDAY=ord*wek # Y Y - - YEARLY BYMONTH=mon,BYMONTHDAY=num # Y Y - Y YEARLY BYMONTH=mon,BYMONTHDAY=num,BYDAY=wek # Y Y Y - ! YEARLY BYMONTH=mon,BYMONTHDAY=num,BYDAY=ord*ALL # Y Y Y Y YEARLY BYMONTH=mon,BYMONTHDAY=num,BYDAY=ord*wek #++ def frequency return :none if empty? return :daily if daily? return :weekly if weekly? return :monthly if monthly? return :yearly if yearly? end def daily? false end def weekly? !yearly? && !monthly? && !cond_wek.empty? end def monthly? !yearly? && (!cond_num.empty? || !cond_ord.empty?) end def yearly? !cond_mon.empty? end def valid? frequency != :none end def empty? [@cond_mon, @cond_ord, @cond_wek, @cond_num].all?{|cond| cond.empty?} end # convert RRULE to X-SC-Cond: # # Due to the over-killing complexity of iCalendar (RFC5545) # format, converting RRULE to X-SC-* format has some restrictions: # # * Not allowed elements: # * BYSECOND # * BYMINUTE # * BYHOUR # * COUNT # * BYYEARDAY (-366 to 366) # * BYWEEKNO (-53 to 53) # * BYSETPOS (-366 to 366) # * Recurrence-ID (not part of RRULE) # # * Restricted elements: # # * INTERVAL: # * it should be 1 # # * BYMONTHDAY: # * it should be (1..31) # # * WKST: # * it should be MO # # * FREQ: # * should be one of WEEKLY, MONTHLY, YEARLY # * should be MONTHLY if BYDAY has (1|2|3|4|-1) # * should be WEEKLY if BYDAY does not have (1|2|3|4|-1) # # * BYDAY: # * should be a list of (1|2|3|4|-1)?(MO|TU|WE|TH|FR|SA|SU) # # * Every week should have the same number-prefix set: # WE,SU is OK => Wed Sun # 3WE,3SU is OK => 3rd Wed Sun # 2WE,3WE,2SU,3SU is OK => 2nd 3rd Sun Wed # 3WE,2SU is NG # 3WE,SU is NG # # * Fully converted elements: # # * UNTIL # * YYYYMMDD should goes to X-SC-Duration: -YYYYMMDD # # * BYMONTH # * (1..12)* => (Jan|Feb|Mar|Jul|Aug|Sep|Oct|Nov|Dec)* # def validate_rrule(rrule) interval = (rrule =~ /INTERVAL=(\d+)/i) ? $1.to_i : 1 return true if rrule.to_s == "" return 1 if rrule =~ /(BYSECOND|BYMINUTE|BYHOUR|COUNT|BYYEARDAY|BYWEEKNO|BYSETPOS)/i return 2 unless (rrule =~ /FREQ=MONTHLY/i and interval == 12) || interval == 1 return 3 if rrule =~ /BYMONTHDAY=([^;]+)/i and $1.split(",").map(&:to_i).any?{|i| i < 1 or i > 31} return 4 if rrule =~ /WKST=([^;]+)/i and $1 !~ /MO/ return 5 if rrule =~ /FREQ=([^;]+)/i and $1 !~ /WEEKLY|MONTHLY|YEARLY/i return 6 if rrule =~ /BYDAY=([^;]+)/i and $1 =~ /\d/ and rrule !~ /FREQ=MONTHLY/i return 7 if rrule =~ /BYDAY=([^;]+)/i and $1 !~ /\d/ and rrule !~ /FREQ=WEEKLY/i return 8 if rrule =~ /BYDAY=([^;]+)/i and $1 !~ /((1|2|3|4|-1)?(MO|TU|WE|TH|FR|SA|SU))+/i return true end def set_from_ics(rrule, dtstart) if (errno = validate_rrule(rrule)) != true raise "Unsupported RRULE string (errno=#{errno}): #{rrule}" end ################ ## BYMONTH (cond_mon) cond_mon = [] if rrule =~ /BYMONTH=([^;]+)/ $1.split(",").each do |mon| cond_mon << mon.to_i end end ################ ## BYDAY (cond_ord, cond_wek) cond_ord = [] cond_wek = [] week = {} if rrule =~ /BYDAY=([^;]+)/ $1.scan(/(1|2|3|4|-1)?(MO|TU|WE|TH|FR|SA|SU)/).each do |o,w| week[w] ||= [] week[w] << o.to_i # unpefixed week is replaced as 0 end # Every week should have the same number-prefix set: return 9 unless week.values.all?{|orders| orders.sort == week.values.first.sort} order = week.values.first.sort # * Number-prefixed week cannot coexist with unprefixed week # WE,SU is OK => Wed Sun # WE,3SU is NG return 10 if order.length > 1 and order.member?(0) # 0 means non-numberd prefix order.delete(0) cond_ord = order week.each do |w, o| cond_wek << WEK_V2I.invert[w] end end ################ ## BYMONTHDAY (cond_num) cond_num = [] if rrule =~ /BYMONTHDAY=([^;]+)/i $1.split(",").each do |n| cond_num << n.to_i end end ################ # Special cases interval = (rrule =~ /INTERVAL=(\d+)/i) ? $1.to_i : 1 # special case of yearly: repeat with 12 months interval # BYMONTH should be taken from DTSTART if interval == 12 and rrule =~ /FREQ=MONTHLY/i and cond_mon.empty? cond_mon << dtstart.month end # if RRULE has only FREQ=YEARLY phrase, # BYMONTH and BYMONTHDAY should be taken from DTSTART # if rrule =~ /FREQ=YEARLY/i cond_mon << dtstart.month if cond_mon.empty? cond_num << dtstart.day if cond_num.empty? and cond_wek.empty? end @cond_mon, @cond_ord, @cond_wek, @cond_num = cond_mon, cond_ord, cond_wek, cond_num return self end def to_mhc_string return (cond_mon.map{|mon| MON_V2L[mon]} + cond_ord.map{|ord| ORD_V2L[ord]} + cond_wek.map{|wek| WEK_V2L[wek]} + cond_num.map{|num| num.to_s} ).join(" ") end def to_ics(dtstart = nil, until_date = nil) return nil unless valid? ord_wek = (cond_ord.empty? ? [""] : cond_ord).product(cond_wek) day = ord_wek.map {|o,w| o.to_s + WEK_V2I[w] }.join(',') if until_date if dtstart.respond_to?(:hour) tz = TZInfo::Timezone.get(ENV["MHC_TZID"] || 'UTC') localtime = Mhc::PropertyValue::Time.new.parse(dtstart.strftime("%H:%M")).to_datetime(until_date).to_time until_str = tz.local_to_utc(localtime).strftime("%Y%m%dT%H%M%SZ") # puts "until_str local (tz=#{tz.name}) : #{localtime.strftime("%Y%m%dT%H%M%S")} utc: #{until_str}" else until_str = until_date.strftime("%Y%m%d") end end ics = "FREQ=#{frequency.to_s.upcase};INTERVAL=1;WKST=MO" ics += ";BYMONTH=#{cond_mon.join(',')}" unless cond_mon.empty? ics += ";BYDAY=#{day}" unless day.empty? ics += ";BYMONTHDAY=#{cond_num.join(',')}" unless cond_num.empty? ics += ";UNTIL=#{until_str}" unless until_date.nil? return ics end end # class RecurrenceCondition end # module PropertyValue end # module Mhc mhc-1.1.1/lib/mhc/property_value/text.rb000066400000000000000000000004041262546231500201730ustar00rootroot00000000000000module Mhc module PropertyValue class Text < Base require "nkf" def to_mhc_string return NKF.nkf("-w", @value.to_s) end alias_method :to_s, :to_mhc_string end # class Text end # module PropertyValue end # module Mhc mhc-1.1.1/lib/mhc/property_value/time.rb000066400000000000000000000017561262546231500201600ustar00rootroot00000000000000class DateTime alias_method :to_mhc_string, :to_s end module Mhc module PropertyValue class Time < Base include Comparable def parse(string) if /^(\d+):(\d+)$/ =~ string @sec = ($1.to_i) * 3600 + ($2.to_i) * 60 end return self end def days; (@sec ) / 86400 ;end def hour; (@sec % 86400) / 3600 ;end def minute; (@sec % 3600) / 60 ;end def <=>(o) return @sec <=> o.to_i end def to_mhc_string return format("%02d:%02d", hour, minute) end alias_method :to_s, :to_mhc_string def to_i return @sec end def to_a return [hour, minute] end def to_datetime(date = Mhc::PropertyValue::Date.new(1970, 1, 2)) date = date + days time = ::DateTime.new(date.year, date.month, date.day, hour, minute, 0, DateTime.now.zone) # make local DateTime end end end # module PropertyValue end # module Mhc mhc-1.1.1/lib/mhc/query.rb000066400000000000000000000125001262546231500152740ustar00rootroot00000000000000module Mhc class Query def initialize(query_string) @expression = Expression.new(Context.new(query_string)) @query_string = query_string end def to_proc return @expression.to_proc end def to_s @query_string.to_s end class ParseError < StandardError; end # # Expression :: Term ('|' Term)* # class Expression def initialize(context) @terms = [Term.new(context)] @terms << Term.new(context) while context.eat_if(:orop) end def to_proc @procs = @terms.map(&:to_proc) return lambda {|ev| @procs.any? {|p| p.call(ev)}} end end # class Expression # # Term :: Factor ('&' Factor)* # class Term def initialize(context) @factors = [Factor.new(context)] @factors << Factor.new(context) while context.eat_if(:andop) end def to_proc @procs = @factors.map(&:to_proc) return lambda {|ev| @procs.all? {|p| p.call(ev)}} end end # class Term # # Factor :: '!'* ( '(' Expression ')' || RelationalExpression ) # class Factor def initialize(context) @expected_value = true @expected_value = !@expected_value while context.eat_if(:negop) if context.eat_if(:lparen) @value = Expression.new(context) context.expect(:rparen) else @value = RelationalExpression.new(context) end end def to_proc @proc = @value.to_proc return lambda {|ev| @proc.call(ev) == @expected_value} end end # class Factor # # RelationalExpression :: Symbol Operator (Argument || '[' Argument Argument* ']') # class RelationalExpression KEYWORDS = [:subject, :category, :body, :location, :recurrence_tag] def initialize(context) @name = context.expect(:symbol).value.downcase.to_sym raise ParseError, "unknown keyword '#{@name}'" unless KEYWORDS.member?(@name) context.expect(:sepop) # Currently, operator is only ":" @arguments = [] if context.eat_if(:lbracket) loop do @arguments << Argument.new(context) break if context.eat_if(:rbracket) end else @arguments << Argument.new(context) end end def to_proc case @name when :category @arguments = @arguments.map{|arg| arg.value.downcase} return lambda {|ev| !(ev.categories.map{|c| c.to_s.downcase} & @arguments).empty?} when :recurrence_tag @arguments = @arguments.map{|arg| arg.value.downcase} return lambda {|ev| !!@arguments.find{|v| ev.send(@name).to_s.downcase.toutf8 == v}} else @arguments = @arguments.map{|arg| Regexp.quote(arg.value)} return lambda {|ev| !!@arguments.find{|v| ev.send(@name).to_s.toutf8.match(v)}} end end end # class RelationalExpression # # Argument :: Symbol || String # class Argument def initialize(context) token = context.expect(:symbol, :string) @type = token.type @value = token.value end def value case @type when :string @value[1..-2] else @value end end end # class Argument class Context TOKENS = { symbol: /[a-zA-Z_][a-zA-Z_\d]*/, string: /"(?:[^"\\]|\\.)*"/, negop: /!/, andop: /&/, orop: /\|/, sepop: /:/, lparen: /\(/, rparen: /\)/, lbracket: /\[/, rbracket: /\]/ }.map{|type,regexp| "(?<#{type}>#{regexp})"}.join("|") TOKEN_REGEXP = Regexp.new('^\s*(' + TOKENS + ')') def initialize(string) @tokens = tokenize(string) end def eat_if(*expected_types) expected_types.each do |expected_type| if @tokens.first and @tokens.first.type == expected_type return @tokens.shift end end return nil end def expect(*expected_types) token = eat_if(*expected_types) and return token raise ParseError, "#{expected_types.map(&:upcase).join(' or ')} expected before #{@tokens.first.value rescue 'END'}" end def debug_dump @tokens.map{|token| "#{token.type} => #{token.value}"}.join(", ") end private def tokenize(string) tokens = [] loop do token, string = get_token(string) break if token.nil? tokens << token end raise ParseError, "can not tokenize '#{string}'" unless string.length == 0 return tokens end def get_token(string) if match = TOKEN_REGEXP.match(string) name = match.names.find{|name| match[name]} value = match[name] remain = match.post_match.strip return [Token.new(name, value), remain] end return [nil, string] end end # class Context class Token attr_reader :type, :value def initialize(type, string) @type, @value = type.to_sym, string end end # class Token class Test attr_reader :categories, :subject def initialize(categories = [], subject = "", body = "") @categories = categories @subject = subject @body = body end end end end mhc-1.1.1/lib/mhc/sync.rb000066400000000000000000000026421262546231500151110ustar00rootroot00000000000000################################################################ # # We assume a CalDAV server as a remote side. # CalDAV has no ability to provide such information. # It only provides ETag mechanism, which is defined # in HTTP protocol (see rfc2616). # # So, we have to maintain a ETag cache (replica) on local and # manage difference between the cache and the remote. # Using the ETag information: # # (1) get uid-etag list via PROPFIND (WebDav) method # # make a set: R_SET = [(r_uid, r_etag)..] # r_uid: unique id of a remote article. # r_etag: corresponding etag of r_uid. # # (2) get uid-etag list via local cache. # # make a set: L_SET = [(l_uid, l_etag)..] # # (3) for each uid: [uid| (uid, etag) <- L_SET + R_SET] # # (A) if (uid, _) is missed in L_SET # -> SET_MARK(uid, M) # # (B) if (uid, _) is missed in R_SET # -> SET_MARK(uid, D) # # (C) if (uid, _) exists in both R_SET and L_SET # if l_etag != r_etag # -> SET_MARK(uid, M) # if l_etag == r_etag # -> SET_MARK(uid, N) # module Mhc module Sync dir = File.dirname(__FILE__) + "/sync" autoload :Driver, "#{dir}/driver.rb" autoload :Status, "#{dir}/status.rb" autoload :StatusManager, "#{dir}/status_manager.rb" autoload :Strategy, "#{dir}/strategy.rb" autoload :Log, "#{dir}/syncinfo.rb" end # module Sync end # module Mhc mhc-1.1.1/lib/mhc/sync/000077500000000000000000000000001262546231500145605ustar00rootroot00000000000000mhc-1.1.1/lib/mhc/sync/driver.rb000066400000000000000000000064671262546231500164150ustar00rootroot00000000000000module Mhc module Sync ## # Sync Driver takes two calendar databases to sync. # # Each record in calendar has to respond to: # * Record#unmodified? # * Record#deleted? # * Record#etag # * Record#etag= # * Record#ex_etag # class Driver def initialize(db1, db2, strategy) @db1 = db1 @db2 = db2 @strategy = Strategy::Factory.create(strategy) end def sync_all(dry_run = false, max_count = 50) list_cache = uid_list items = count_sync_items(list_cache) if items > max_count STDERR.print "Too many (#{items}) articles to sync... abort\n" return false unless dry_run end list_cache.each do |uid| sync(uid, dry_run) end return true end private def count_sync_items(sync_uid_list) sync_uid_list.map{|uid| sync(uid, true, true)}.count{|s| s != :ignore} end def sync(uid, dry_run = false, quiet = false) info1 = @db1.syncinfo(uid) info2 = @db2.syncinfo(uid) unless @strategy.whatnow(info1, info2) == :ignore or quiet STDERR.print "ABOUT#{dry_run ? '(DRY_RUN)' : ''} #{uid} => #{@strategy.whatnow(info1, info2)} " STDERR.print "(#{info1.sync_status} vs #{info2.sync_status})\n" end return @strategy.whatnow(info1, info2) if dry_run case @strategy.whatnow(info1, info2) when :ignore #ignore(side1, side2) when :conflict merge(uid, @db1, @db2) when :delete1 delete(uid, @db1, @db2) when :delete2 delete(uid, @db2, @db1) when :copy1_to_2 copy(uid, @db1, @db2) when :copy2_to_1 copy(uid, @db2, @db1) when :overwrite1_to_2 copy(uid, @db1, @db2, :overwrite) when :overwrite2_to_1 copy(uid, @db2, @db1, :overwrite) when :move1_to_2 move(uid, @db1, @db2) when :move2_to_1 move(uid, @db2, @db1) end end def uid_list (@db1.uid_list + @db2.uid_list).sort.uniq end def merge(uid, db1, db2) # Not yet implemented s1 = db1.get(uid) s2 = db2.get(uid) STDERR.print("Conflict: UID=#{uid} ... did nothing.\n") end def delete(uid, db, db2) info = db.syncinfo(uid) info2 = db2.syncinfo(uid) if db.delete(uid) info.mark_synced(nil) info2.mark_synced(nil) end end def copy(uid, db1, db2, overwrite = false) ev = db1.get(uid) STDERR.print "COPYING:#{overwrite ? ' (overwrite)' : ''} #{ev.uid}\n" db2.delete(uid) if overwrite if new_info = db2.put(ev, overwrite) db1.syncinfo(uid).mark_synced(ev.etag) db2.syncinfo(uid).mark_synced(new_info.etag) else STDERR.print "COPY: failed.\n" end end def move(uid, db1, db2) ev = db1.get(uid) info = db1.syncinfo(uid) STDERR.print "MOVING: #{ev.uid}\n" if new_info = db2.put(ev) db2.syncinfo(uid).mark_synced(new_info.etag) db1.delete(uid) info.mark_synced(nil) else STDERR.print "MOVE: failed.\n" end end end # class Driver end # module Sync end # module Mhc mhc-1.1.1/lib/mhc/sync/status.rb000066400000000000000000000031061262546231500164300ustar00rootroot00000000000000module Mhc module Sync ## # status # class Status def initialize(uid, manager, wrapped_record = nil) @uid, @manager, @wrapped_record = uid, manager, wrapped_record end def uid return @uid end def etag @manager.etag(@uid) end def ex_etag @manager.ex_etag(@uid) end def sync_status return :norecord if !etag and !ex_etag return :created if etag and !ex_etag return :deleted if !etag and ex_etag return :unmodified if etag == ex_etag return :modified if etag != ex_etag end def modified? sync_status == :modified end def created? sync_status == :created end def unmodified? sync_status == :unmodified end def norecord? sync_status == :norecord end def deleted? sync_status == :deleted end def mark_synced(etag = self.etag) @manager.mark_synced(uid, etag) return self end ### as a calendar DB redord def to_ics_string # LastNote or mhc is assumed. if @wrapped_record.respond_to?(:to_ics_string) result = @wrapped_record.to_ics_string return result end # HTTP::Response from caldav server is assumed. if @wrapped_record.respond_to?(:body) return @wrapped_record.body end return nil # Nil or unsupport object class. XXX donot put. end end # class Status end # module Sync end # module Mhc mhc-1.1.1/lib/mhc/sync/status_manager.rb000066400000000000000000000107761262546231500201350ustar00rootroot00000000000000module Mhc module Sync ## # It wraps existing database to adds ability to manage etag cache for sync status tracking. # The downstream database is supposed to respond to: # # 1. report_etags # report_etags(uids = nil) # returns one of: # => {uid_string => etag_object } # Hash # => {uid_string => etag_string } # Hash # => [uid_etag_object] # Array # # uid_etag_object is an object which respond to #etag and #uid method. # etag_object is an object which respond to #etag method. # # 2. get_with_etag # get_with_etag(uid) # # => [RECORD, etag] # # Each RECORD has to respond to #to_ics_string or #body that # returns iCalendar-conformed string. # # 3. put_if_match # put_if_match(uid, ics_string, expected_etag) # # => put ics_string if "ETAG" equals to expected_etag # # 4. delete_if_match # delete_if_match(uid, expected_etag) # # => delete uid if "ETAG" equals to expected_etag # # expected_etag is a string for sync. if expected_etag is omitted # (or nil), put_if_match and delete_if_match will ignore # conflictions. # class StatusManager def initialize(real_db, etag_db) @db, @etag_db = real_db, etag_db refresh_status end def syncinfo(uid) Status.new(uid, self) end def uid_list (@db_status.keys + @etag_status.keys).sort.uniq end ## # delegation to original DB with sync-status check. # # To make sure any kind of update is safe, # you may want to check current_record.ex_etag == current_record.etag # (means current_record.unmodified? is true) like: # # if current_record.unmodified? # @db.put(new_record) # end # # However, this will not work. Because this check-and-update # must be an atomic operation. # So, instead, we have to do: # # @db.put_if_match(new_record, current_record.ex_etag) # def get(uid) res, etag = @db.get_with_etag(uid) @db_status[uid] = etag if etag return Status.new(uid, self, res) end def put(modified_record, overwrite = false) current_record = syncinfo(modified_record.uid) expected_etag = overwrite ? nil : current_record.ex_etag if @db.put_if_match(current_record.uid, modified_record.to_ics_string, expected_etag) ## XXX: put_if_match should return the new etag value, and we ## have to use it as a new etag for the current record. ## However, some CalDAV servers (Google Calendar) do not ## return any etag on PUT. ## So, we have to PROPFIND immediately after the ## PUT. This is a small crack on atomicity refresh_status(current_record.uid) # refresh propfind cache. current_record.mark_synced return Status.new(current_record.uid, self) else return nil # put failed. end end def delete(uid) current_record = syncinfo(uid) if @db.delete_if_match(current_record.uid, current_record.ex_etag) refresh_status(current_record.uid) current_record.mark_synced return Status.new(current_record.uid, self) else return nil end end # propfind with cache def refresh_status(uids = :all) ### XXX: care fore UIDs for partial update. @db_status = make_hash(@db.report_etags) @etag_status = make_hash(@etag_db.report_etags) end def etag(uid) if @db_status[uid].respond_to?(:etag) return @db_status[uid].etag else return @db_status[uid] end end def ex_etag(uid) @etag_status[uid] end def mark_synced(uid, etag) @etag_db.put(uid, etag) return self end private ## etag_report is one of: ## + {uid_string => etag_object } style hash, ## + {uid_string => etag_string } style hash, ## + [uid_etag_object] style array, ## uid_etag_object is an object which respond to #etag and #uid method. ## etag_object is an object which respond to #etag method. def make_hash(etag_report) return etag_report if etag_report.respond_to?(:keys) hash = {} etag_report.map {|o| hash[o.uid] = o.etag} if etag_report return hash end end # class StatusManager end # module Sync end # module Mhc mhc-1.1.1/lib/mhc/sync/strategy.rb000066400000000000000000000214521262546231500167530ustar00rootroot00000000000000module Mhc module Sync module Strategy class Factory def self.create(strategy) case strategy.to_sym when :mirror return Mirror.new when :sync return Sync.new when :import return Import.new else raise NotImplementedError, "#{strategy} #{strategy.class}" end end end # Our Sync mechanism is very simple, because # we can assume every article is independent # with eath other. It will work well with # iCalendar basis articles. # # We simply follow the rule on the table below: # # Side 2 # |---+---------+------------+------------+-------| # S | | M | U | N | D | # i |---+---------+------------+------------+-------| # d | M | CNF | OW 1->2 | CP 1->2 | CNF | # e | U | OW 2->1 | - | ?? CP 1->2 | DEL 1 | # 1 | N | CP 2->1 | ?? CP 2->1 | - | - | # | D | CNF | DEL 2 | - | - | # |---+---------+------------+------------+-------| # # M, U, N, and D indicate status changes on each article after # the last sync: # # + M :: Modified (or Created) # + U :: Unchanged # + N :: No Record # + D :: Deleted # # Each entry in the table means: # + -- :: No operation (ignore) # + ?? :: Not occurred in normal cases # + OW :: Overwrite # + CP :: Copy # + DEL :: Delete # + CNF :: Conflict # # Before applying the rule to our repository, # we have to set the marks (M, U, N or D) to all articles # in each side. # # strategy = Mhc::Sync::Strategy.create(strategy_name) # strategy name is one of: # * :empty ... ignore on every status # * :mirror ... mirror from side1 to side2 # * :sync ... sync articles of side1 and side2 # # and strategy.whatnow(side1, side2) returns a symbol one of: # * :ignore :: Already synced, ignoreable # * :conflict :: Conflicted # * :delete1 :: Should delete the article of side1 # * :delete2 :: Should delete the article of side2 # * :copy1_to_2 :: Should copy the article of side1 to side2 # * :copy2_to_1 :: Should copy the article of side2 to side1 # * :overwrite1_to_2 :: Should overwrite the article of side1 to side2 # * :overwrite2_to_1 :: Should overwrite the article of side2 to side1 # # side1 and side2 have to respond to: # #nil?, # #modified?, #unmodified?, #norecord?, #deleted? # class Base def whatnow(side1, side2) # do nothing actions = { "MM" => :ignore, "MU" => :ignore, "MN" => :ignore, "MD" => :ignore, "UM" => :ignore, "UU" => :ignore, "UN" => :ignore, "UD" => :ignore, "NM" => :ignore, "NU" => :ignore, "NN" => :ignore, "ND" => :ignore, "DM" => :ignore, "DU" => :ignore, "DN" => :ignore, "DD" => :ignore, } return actions[status_pair(side1, side2)] end private # * Char (M,U,N,D) indicates status change on each article # after the last sync: # # + M :: Modified # + U :: Unchanged # + N :: No Record # + D :: Deleted # def status_signature(info) return "N" if info.nil? return "M" if info.modified? || info.created? return "U" if info.unmodified? return "N" if info.norecord? return "D" if info.deleted? return "?" # NOTREACHED I hope end def status_pair(side1, side2) return status_signature(side1) + status_signature(side2) end end # class Base # * Sync side1 and side2 # # simply follow the rule on the table below: # # Side 2 # |---+---------+------------+------------+-------| # S | | M | U | N | D | # i |---+---------+------------+------------+-------| # d | M | CNF | CP 1->2 | CP 1->2 | CNF | # e | U | CP 2->1 | - | ?? - | DEL 1 | # 1 | N | CP 2->1 | ?? - | - | - | # | D | CNF | DEL 2 | - | - | # |---+---------+------------+------------+-------| # # + M :: Modified (or Created) # + U :: Unchanged # + N :: No Record # + D :: Deleted # # + -- :: No operation (ignore) # + ?? :: Not occurred in normal cases # + OW :: Overwrite # + CP :: Copy # + DEL :: Delete # + CNF :: Conflict # class Sync < Base def whatnow(side1, side2) actions = { "MM" => :conflict, "MU" => :copy1_to_2, "MN" => :copy1_to_2, "MD" => :conflict, "UM" => :copy2_to_1, "UU" => :ignore, "UN" => :ignore, "UD" => :delete1, "NM" => :copy2_to_1, "NU" => :ignore, "NN" => :ignore, "ND" => :ignore, "DM" => :conflict, "DU" => :delete2, "DN" => :ignore, "DD" => :ignore, } return actions[status_pair(side1, side2)] end end # class Sync # * Mirror side1 to side2 # # simply follow the rule on the table below: # # Side 2 # |---+---------+----------+------------+---------| # S | | M | U | N | D | # i |---+---------+----------+------------+---------| # d | M | OW 1->2 | OW 1->2 | CP 1->2 | CP 1->2 | # e | U | OW 1->2 | -- | ?? -- | CP 1->2 | # 1 | N | DEL 2 | ?? -- | -- | -- | # | D | DEL 2 | DEL 2 | -- | -- | # |---+---------+----------+------------+---------| # # + M :: Modified (or Created) # + U :: Unchanged # + N :: No Record # + D :: Deleted # # + -- :: No operation (ignore) # + ?? :: Not occurred in normal cases # + OW :: Overwrite # + CP :: Copy # + DEL :: Delete # class Mirror < Base def whatnow(side1, side2) actions = { "MM" => :overwrite1_to_2, "MU" => :overwrite1_to_2, "MN" => :copy1_to_2, "MD" => :copy1_to_2, "UM" => :overwrite1_to_2, "UU" => :ignore, "UN" => :ignore, "UD" => :copy1_to_2, "NM" => :delete2, "NU" => :ignore, "NN" => :ignore, "ND" => :ignore, "DM" => :delete2, "DU" => :delete2, "DN" => :ignore, "DD" => :ignore, } return actions[status_pair(side1, side2)] end end # class Mirror # * Import from side1 to side2 # # Import newly created articles on side1 into side2 # All articles in side1 will be deleted after imported into side2. # # Side 2 # |---+---------+----------+------------+---------| # S | | M | U | N | D | # i |---+---------+----------+------------+---------| # d | M | ?? DEL1 | ?? DEL1 | MV 1->2 | ?? DEL1 | # e | U | ?? DEL1 | ?? DEL1 | ?? DEL1 | ?? DEL1 | # 1 | N | -- | -- | -- | -- | # | D | -- | -- | -- | -- | # |---+---------+----------+------------+---------| # # + M :: Modified (or Created) # + U :: Unchanged # + N :: No Record # + D :: Deleted # # + -- :: No operation (ignore) # + ?? :: Not occurred in normal cases # + MV :: Move # + DEL :: Delete # class Import < Base def whatnow(side1, side2) actions = { "MM" => :delete1, "MU" => :delete1, "MN" => :move1_to_2, "MD" => :delete1, "UM" => :delete1, "UU" => :delete1, "UN" => :delete1, "UD" => :delete1, "NM" => :ignore, "NU" => :ignore, "NN" => :ignore, "ND" => :ignore, "DM" => :ignore, "DU" => :ignore, "DN" => :ignore, "DD" => :ignore, } return actions[status_pair(side1, side2)] end end # class Import end # module Strategy end # module Sync end # module Mhc mhc-1.1.1/lib/mhc/sync/syncinfo.rb000066400000000000000000000042141262546231500167360ustar00rootroot00000000000000################################################################ # Log maintenance functions. # # M 2000-04-25 00:06:08 <20.nom@.nomcom> ~nom/Mail/schedule/2000/04/1 Luncheon # D 2000-04-25 00:06:08 <20.nom@.nomcom> ~nom/Mail/schedule/2000/04/1 Luncheon # S 2000-04-25 00:06:08 user_id # module Mhc class Log def initialize(filename) @filename = filename end def add_entry(entry) file = File.open(@filename, "a+") file.print "#{entry}\n" file.fsync if file.respond_to?("fsync") file.close end def each_entry begin file = File.open(@filename) while line = file.gets yield(MhcLogEntry.new(line.chomp)) end file.close rescue end end def entries() arry = [] each_entry{|e| arry << e } return arry end def shrink_entries(user_id) hash = {} each_entry{|e| if e.status == 'S' and e.rec_id == user_id hash.clear else hash[e.rec_id] = e end } return hash.values end end # class Log end # module Mhc ################ module Mhc class LogEntry attr :status attr :mtime attr :rec_id attr :path attr :subject def initialize(status, mtime = nil, rec_id = nil, path = nil, subject = nil) if mtime.nil? init_from_string(status) else @status, @mtime, @rec_id, @path, @subject = status, mtime, rec_id, path, subject end end def to_s return [ @status, @mtime.strftime("%Y-%m-%d %H:%M:%S"), @rec_id, @path, @subject ].join(' ') end ################ private ################ def init_from_string(line) str = line.chomp status, yymmdd, hhmmss, rec_id, path, subject = str.split yy, mm, dd = yymmdd.split('-') h, m, s = hhmmss.split(':') mtime = ::Time.local(yy.to_i, mm.to_i, dd.to_i, h .to_i, m .to_i, s .to_i) @status, @mtime, @rec_id, @path, @subject = status, mtime, rec_id, path, subject end end # class LogEntry end # module Mhc mhc-1.1.1/lib/mhc/templates/000077500000000000000000000000001262546231500156025ustar00rootroot00000000000000mhc-1.1.1/lib/mhc/templates/config.yml.erb000066400000000000000000000130141262546231500203400ustar00rootroot00000000000000################################################################ # config.yml file for MHC created by mhc init command. # <% repository = @config[:topdir] || '~/mhc' tzid = @config[:tzid] || 'Unknown' -%> --- ################################################################ GENERAL: ################################################################ # TZID defines timezone of all articles. # It must be in the form of "Asia/Tokyo". # ``mhc init'' is clever enough to set your timezone automatically, # but, you may want to change this value. # Valid names for TZID is: # http://en.wikipedia.org/wiki/List_of_tz_database_time_zones TZID: "<%= @config[:tzid] || 'Unknown' %>" # All MHC articles and status files are placed under this directory: REPOSITORY: "<%= @config[:topdir] || '~/mhc' %>" ################################################################ SYNC_CHANNELS: ################################################################ # Each sync channel binds two CALENDARS (see below) for # data-synchronization. Currently, STRATEGY allows: # # + "mirror" :: mirrors CALENDAR1 to CALENDAR2. # CALENDAR1 must be a local MHC calendar, # and CALENDAR2 must be a Google Calendar. # Note that articles between past 90 days and future 90 # days in MHC will be mirrored to the target Google # Calendar. 90 is hard-coded in lib/mhc/calendar.rb for # now. Other articles out of the range in Google # Calendar will be DELETED. # + "import" :: imports newly created (non-recurring) articles # on CALENDAR1 into CALENDAR2. # CALENDAR1 must be a Google Calendar, # and CALENDAR2 must be a local MHC calendar. # All articles in CALENDAR1 will be DELETED after # the import. # # True two-way sync is not yet implemented. - NAME: business CALENDAR1: business CALENDAR2: google_business STRATEGY: mirror - NAME: family CALENDAR1: family CALENDAR2: google_family STRATEGY: mirror # ``google_inbox'' is a spool-like calendar on Google Calendar. # After create some articles into google_inbox with Android client, # doing ``mhc sync inbox'' on your PC will import the articles into MHC. # All articles in google_inbox will be DELETED after the import. - NAME: inbox CALENDAR1: google_inbox CALENDAR2: master STRATEGY: import ################################################################ CALENDARS: ################################################################ ################################################################ ## MHC local # First entry under CALENDARS: is your default calendar. # It must be a local MHC calendar, which has ``TYPE: mhc'' entry. # Master calendar (default) - &mhc_default NAME: master TYPE: mhc # This ``business'' is a sample calendar, which is derived from # ``master'' calendar with some filters and modifiers. Filters hide # or select articles from master calendar. Modifiers decorate # articles by preset decorators: hide_details, hide_description, # hide_location, hide_time_range. You can write your original # decorators (written in Ruby) in plugins/ directory located at the # same place with this file. - <<: *mhc_default NAME: business FILTER: '!category:private & !subject:"TODO"' MODIFIERS: - hide_description - hide_location - replace_subject_by_category # Another sample, supposed to be published to your family's Google # Calendar. - <<: *mhc_default NAME: family FILTER: 'category:[birthday holiday private]' MODIFIERS: - hide_description ################################################################ ## Google Calendar # Currently, Google Calendar stuffs work only as destinations # for sync with MHC calendars. # # Since MHC uses standard CalDAV protocol, I believe # it works with other CalDAV-based network calendars such as # iCloud, but I did not confirmed. # # Google Calendar URL for CalDAV is in the form of: # https://www.google.com/calendar/dav/{calendar_id}/events # # calendar_id: # for primary calendar is just your email address. # for others will be in the form of: # [long-string-of-characters]@group.calendar.google.com # # You can get them by clicking the down arrow next to your # calendar at calendar.google.com and selecting 'Calendar Settings'. # Be sure to use HTTPS in your URL, as an http address will not work. # # for more details about Google Calendar settings: # http://www.google.com/support/calendar/bin/answer.py?answer=99358 # and click Sunbird section. # # Fill in the blanks indicated as ***, and invoke the command: # # % mhc sync {sync_channel_name} # # {sync_channel_name} must exist in the section of SYNC_CHANNELS: # # Before the first try, I recommend you to make a new calendar on your # Google Calendar dedicated to MHC. and backup your local spool of # MHC. # Displayname: MHC - &google_default NAME: google_personal TYPE: caldav USER: "***@gmail.com" PASSWORD: "***" URL: "https://calendar.google.com/calendar/dav/***@group.calendar.google.com/events/" # Displayname: For Colleagues - <<: *google_default NAME: google_business URL: "https://calendar.google.com/calendar/dav/***@group.calendar.google.com/events/" # Displayname: For Family - <<: *google_default NAME: google_family URL: "https://calendar.google.com/calendar/dav/***@group.calendar.google.com/events/" # Displayname: Spool calendar to which Android adds articles - <<: *google_default NAME: google_inbox URL: https://calendar.google.com/calendar/dav/**************************@group.calendar.google.com/events/ mhc-1.1.1/lib/mhc/version.rb000066400000000000000000000001321262546231500156120ustar00rootroot00000000000000module Mhc VERSION = "1.1.1" PRODID = "-//Quickhack.net//MHC #{Mhc::VERSION}//EN" end mhc-1.1.1/lib/mhc/webdav.rb000066400000000000000000000174131262546231500154070ustar00rootroot00000000000000#!/usr/bin/env ruby require "net/https" require "uri" require "rexml/document" require "fileutils" require "pathname" module Mhc class WebDav # WebDAV protocol: RFC4918 # see http://tools.ietf.org/html/rfc4918 # class Client attr_reader :top_directory def initialize(base_url, proxy_host = nil, proxy_port = nil) uri = URI.parse(base_url) @top_directory = uri.path @http = Net::HTTP.new(uri.host, uri.port, proxy_host, proxy_port) @http.use_ssl = true if uri.scheme == "https" @http.verify_mode = OpenSSL::SSL::VERIFY_PEER end def set_basic_auth(user, password) @auth_user, @auth_password = user, password return self end # 8.1 PROPFIND def propfind(path = @top_directory, depth = 1, xml_body = nil) req = setup_request(Net::HTTP::Propfind, path) req['Depth'] = depth if xml_body req.content_type = 'application/xml; charset="utf-8"' req.content_length = xml_body.size req.body = xml_body end res = @http.request(req) if $MHC_DEBUG STDERR.print "\n* PROPFIND RESPONSE:\n" STDERR.print dump_response(res, true) end check_status_code(res, 207) # Multi-Status return res end # 8.2 PROPPATCH def proppatch raise NotImplementedError end # 8.3 MKCOL def mkcol(path) req = setup_request(Net::HTTP::Mkcol, path) res = @http.request(req) check_status_code(res, 201) # Created return res end # 8.4 GET def get(path) req = setup_request(Net::HTTP::Get, path) res = @http.request(req) check_status_code(res, 200) # OK return res end # 8.4 HEAD def head(path) req = setup_request(Net::HTTP::Head, path) res = @http.request(req) check_status_code(res, 200) # OK return res end # 8.5 POST def post(content, dest_path) req = setup_request(Net::HTTP::Post, dest_path) req.content_length = content.size req.body = content res = @http.request(req) check_status_code(res, [201, 204]) # Created or No content return res end # 8.6 DELETE def delete(path, ifmatch = nil) req = setup_request(Net::HTTP::Delete, path) req['If-Match'] = ifmatch if ifmatch res = @http.request(req) check_status_code(res, 204) return res end # 8.7 PUT def put(content, dest_path, ifmatch = nil) req = setup_request(Net::HTTP::Put, dest_path) req.content_length = content.size req['If-Match'] = ifmatch if ifmatch req.content_type = "text/calendar; charset=utf-8" # xxx req.body = content res = @http.request(req) if $MHC_DEBUG STDERR.print "\n* PUT RESPONSE:\n" STDERR.print dump_response(res) STDERR.print "* HEAD RESPONSE:\n" STDERR.print dump_response(head(dest_path)) end check_status_code(res, [201, 204]) # Created or No content return res end # 8.8 COPY def copy(src_path, dest_path) req = setup_request(Net::HTTP::Copy, src_path) req['Destination'] = dest_path res = @http.request(req) check_status_code(res, 204) # No Content return res end # 8.9 MOVE def move(src_path, dest_path) req = setup_request(Net::HTTP::Move, src_path) req['Destination'] = dest_path res = @http.request(req) check_status_code(res, 204) # No Content return res end # 8.10 LOCK def lock(path) raise NotImplementedError end # 8.11 UNLOCK def unlock(path) raise NotImplementedError end ################################################################ private def check_status_code(res, required_status) unless ([required_status].flatten.map{|c| c.to_s}).member?(res.code) header = "Invalid HttpResponse" raise Exception.new("#{res.code} #{header} #{res.message} #{res.body}") end end def setup_request(request, *args) req = request.new(*args) req.basic_auth @auth_user, @auth_password # XXX: should implement re-connection mechanism for Keep-Alive: # http://d.hatena.ne.jp/daftbeats/20080321/1206092975 req["Connection"] = "Keep-Alive" return req end def fetch(uri_str, limit = 10) raise StandardError, 'HTTP redirect too deep' if limit == 0 response = Net::HTTP.get_response(URI.parse(uri_str)) case response when Net::HTTPSuccess response when Net::HTTPRedirection fetch(response['location'], limit - 1) else response.value end end def dump_response(res, include_body = false) string = "" res.each do |name, value| string += " #{name}: #{value}\n" end string += res.body + "\n" if include_body return string end end # class Client class Cache class DirectoryNotFoundError < StandardError end def initialize(top_directory) set_top_directory(top_directory) end def set_top_directory(path) raise DirectoryNotFoundError unless File.directory?(path) @local_top_pathname = Pathname.new(path) return self end def set_propfind_cache(path, xml) File.open(local_cache_path(path), "w") do |f| f.write(xml) end end def set_basic_auth(user, password) # nothing to do return self end # 8.1 PROPFIND def propfind(path, depth = 1, xml_body = nil) File.read(local_cache_path(path)) rescue nil end # 8.2 PROPPATCH def proppatch raise NotImplementedError end # 8.3 MKCOL def mkcol(path) File.mkdir(local_path(path)) end # 8.4 GET def get(path) File.read(local_path(path)) end # 8.4 HEAD def head(path) raise NotImplementedError end # 8.5 POST def post(content, dest_path) raise NotImplementedError end # 8.6 DELETE def delete(path) File.unlink(local_path(path)) end # 8.7 PUT def put(content, dest_path) make_directory_or_higher(File.dirname(local_path(dest_path))) File.open(local_path(dest_path), "w") do |f| f.write(content) end end # 8.8 COPY def copy(src_path, dest_path) raise NotImplementedError end # 8.9 MOVE def move(src_path, dest_path) raise NotImplementedError end # 8.10 LOCK def lock(path) raise NotImplementedError end # 8.11 UNLOCK def unlock(path) raise NotImplementedError end private def make_directory_or_higher(directory) unless File.directory?(directory) parent = File.dirname(directory) make_directory_or_higher(parent) print "mkdir #{directory}\n" return Dir.mkdir(directory) end end def local_pathname(path) pathname = Pathname.new(path) raise "path (#{path.to_s})should be absolute." unless pathname.absolute? (@local_top_pathname + ("./" + pathname)).cleanpath end def local_path(path) local_pathname(path).to_s end def local_cache_path(path) if File.directory?(local_path(path)) (local_pathname(path) + "propfind-cache.xml").cleanpath.to_s else local_path(path) end end end # class Cache end # class WebDav end # module Mhc mhc-1.1.1/mhc.gemspec000066400000000000000000000024301262546231500144020ustar00rootroot00000000000000# coding: utf-8 lib = File.expand_path('../lib', __FILE__) git = File.expand_path('../.git', __FILE__) $LOAD_PATH.unshift(lib) unless $LOAD_PATH.include?(lib) require 'mhc/version' Gem::Specification.new do |spec| spec.name = "mhc" spec.version = Mhc::VERSION spec.authors = ["Yoshinari Nomura"] spec.email = ["nom@quickhack.net"] spec.summary = %q{Message Harmonized Calendaring} spec.description = %q{Message Harmonized Calendaring.} spec.homepage = "http://www.quickhack.net/mhc" spec.license = "BSD" spec.files = if Dir.exist?(git) `git ls-files -z`.split("\x0") else Dir['**/*'] end spec.executables = spec.files.grep(%r{^bin/}) { |f| File.basename(f) } spec.test_files = spec.files.grep(%r{^(test|spec|features)/}) spec.require_paths = ["lib"] spec.add_runtime_dependency "thor", ">= 0.19.1" spec.add_runtime_dependency "ri_cal", ">= 0.8.8" spec.add_runtime_dependency "tzinfo", ">= 1.2.2" spec.add_runtime_dependency "tzinfo-data", ">= 1.2015.4" spec.add_development_dependency "bundler", "~> 1.5" spec.add_development_dependency "rake" spec.add_development_dependency "rspec" end mhc-1.1.1/samples/000077500000000000000000000000001262546231500137335ustar00rootroot00000000000000mhc-1.1.1/samples/DOT.mhc-config.yml000066400000000000000000000101741262546231500171200ustar00rootroot00000000000000################################################################ # Setup config file ~/.mhc/config.yml # # Google Calendar URL for CalDAV is in the form of: # https://www.google.com/calendar/dav/{calendar_id}/events # # calendar_id: # for primary calendar is just your email address. # for others will be in the form of: # [long-string-of-characters]@group.calendar.google.com # # You can get them by clicking the down arrow next to your # calendar at calendar.google.com and selecting 'Calendar Settings'. # Be sure to use HTTPS in your URL, as an http address will not work. # # for more details about Google Calendar settings: # http://www.google.com/support/calendar/bin/answer.py?answer=99358 # and click Sunbird section. # # Fill in the blanks indicated as *****, # and invoke the command: # # % mhc sync personal # # Articles in past 90 days and future 90 days in MHC # will be mirrored to target Google Calendar. # (Hard-coded in lib/mhc/calendar.rb for now) # Also other articles in Google Calendar will be DELETED. # # Before the first try, I recommend you to # make a new calendar on your Google Calendar, # and backup MHC folder ~/Mai/schedule. # # Currently, the type of STRATEGY in SYNC_CHANNELS allows: # + "mirror" :: mirrors MHC to Google Calendar. # + "import" :: imports newly created (non-recurring) articles # on Google Calendar into MHC. # All articles in Google will be deleted after the import. # # We are planning to support the true two-way sync "sync" soon. # --- ################################################################ GENERAL: ################################################################ TZID: "Asia/Tokyo" REPOSITORY: ~/MHC ################################################################ SYNC_CHANNELS: ################################################################ - NAME: personal CALENDAR1: personal CALENDAR2: google_personal STRATEGY: mirror - NAME: family CALENDAR1: family CALENDAR2: google_family STRATEGY: mirror - NAME: business CALENDAR1: business CALENDAR2: google_business STRATEGY: mirror # After create some articles into google_inbox with Android client, # doing ``mhc sync inbox'' on my Mac will import the articles into my MHC. # All articles in google_inbox will be deleted, after the import. - NAME: inbox CALENDAR1: google_inbox CALENDAR2: master STRATEGY: import ################################################################ CALENDARS: ################################################################ ################################################################ ## MHC local # MHC: Master calendar (default) - &mhc_default NAME: master TYPE: mhc # MHC: Personal calendar mirroed to my Android - <<: *mhc_default NAME: personal FILTER: '!category:[birthday japanese]' # MHC: Published calendar to my colleagues - <<: *mhc_default NAME: business FILTER: '!category:[private japanese] & category:[lecture seminar conference meeting work event party trip holiday reserved task]' MODIFIERS: - hide_description - hide_location - replace_subject_by_category # MHC: Published calendar to my family - <<: *mhc_default NAME: family FILTER: '!category:[birthday japanese] & category:[work event party trip holiday private]' MODIFIERS: - hide_description ################################################################ ## Google Calendar # Displayname: MHC - &google_default NAME: google_personal TYPE: caldav USER: *********@gmail.com PASSWORD: *************** URL: https://calendar.google.com/calendar/dav/**************************@group.calendar.google.com/events/ # Displayname: For Family - <<: *google_default NAME: google_family URL: https://calendar.google.com/calendar/dav/**************************@group.calendar.google.com/events/ # Displayname: For Colleagues - <<: *google_default NAME: google_business URL: https://calendar.google.com/calendar/dav/**************************@group.calendar.google.com/events/ # Displayname: Android to create articles into: - <<: *google_default NAME: google_inbox URL: https://calendar.google.com/calendar/dav/**************************@group.calendar.google.com/events/ mhc-1.1.1/samples/japanese-holidays.mhcc000066400000000000000000000136711262546231500201770ustar00rootroot00000000000000## ## Japanese Holidays ## ## Place this as REPOSITORY/presets/japanese-holidays.mhcc ## X-SC-Subject: 元日 X-SC-Category: Holiday Japanese X-SC-Duration: 19480101- X-SC-Cond: 1 Jan X-SC-Record-Id: E2BAB555-3CEB-4508-96AD-1B59AA24ADC3 X-SC-Subject: 成人の日 X-SC-Category: Holiday Japanese X-SC-Cond: 15 Jan X-SC-Duration: 19480115-19990115 X-SC-Record-Id: EA9F4BA5-7D5A-4794-AFB3-6AB68FCA9719 X-SC-Subject: 成人の日 X-SC-Category: Holiday Japanese X-SC-Cond: 2nd Mon Jan X-SC-Duration: 20000110- X-SC-Record-Id: 0BC2CBD0-D81E-4315-B9A8-E112C8E3DC1C X-SC-Subject: 建国記念の日 X-SC-Category: Holiday Japanese X-SC-Cond: 11 Feb X-SC-Duration: 19670211- X-SC-Record-Id: AC1B378C-BAFE-4B6E-AF9C-78C2377E8AA4 X-SC-Subject: 天皇誕生日 X-SC-Category: Holiday Japanese X-SC-Cond: 29 Apr X-SC-Duration: 19480429-19980429 X-SC-Record-Id: B78EAAEE-9963-4573-9EC7-0879F8940AEE X-SC-Subject: みどりの日 X-SC-Category: Holiday Japanese X-SC-Cond: 29 Apr X-SC-Duration: 19890429-20060429 X-SC-Record-Id: B78EAAEE-9963-4573-9EC7-0879F8940AEE X-SC-Subject: 昭和の日 X-SC-Category: Holiday Japanese X-SC-Cond: 29 Apr X-SC-Duration: 20070429- X-SC-Record-Id: A458E14C-960C-4F01-AF73-8ACB1B51A6A1 X-SC-Subject: 憲法記念日 X-SC-Category: Holiday Japanese X-SC-Cond: 3 May X-SC-Duration: 19480503- X-SC-Record-Id: BA89778E-E8CC-4588-B5C3-56F86483DEC1 X-SC-Subject: みどりの日 X-SC-Category: Holiday Japanese X-SC-Cond: 4 May X-SC-Duration: 20070504- X-SC-Record-Id: 47938EDA-41A5-4E51-BDCB-2D3B60F49D71 X-SC-Subject: こどもの日 X-SC-Category: Holiday Japanese X-SC-Cond: 5 May X-SC-Duration: 19480505- X-SC-Record-Id: 4AE5568A-2DFE-4B6B-92E5-C4BFADFB2CCF X-SC-Subject: 海の日 X-SC-Category: Holiday Japanese X-SC-Cond: 20 Jul X-SC-Duration: 19960720-20020720 X-SC-Record-Id: 5E03776A-4280-4337-85C0-F1322A3AAE6E X-SC-Subject: 海の日 X-SC-Category: Holiday Japanese X-SC-Cond: 3rd Mon Jul X-SC-Duration: 20030701- X-SC-Record-Id: BD4156C2-5546-4146-8297-09CF4210A346 X-SC-Subject: 山の日 X-SC-Category: Holiday Japanese X-SC-Cond: 11 Aug X-SC-Duration: 20160811- X-SC-Record-Id: FC7C481B-7BF5-4639-B700-3B60CB99E05D X-SC-Subject: 敬老の日 X-SC-Category: Holiday Japanese X-SC-Cond: 15 Sep X-SC-Duration: 19660915-20020915 X-SC-Record-Id: 29BC6E4E-0D70-4EF8-8AF0-7000254D3CDB X-SC-Subject: 敬老の日 X-SC-Category: Holiday Japanese X-SC-Cond: 3rd Mon Sep X-SC-Duration: 20030915- X-SC-Record-Id: F303C1C9-01B0-437C-A2E2-BCD1ADD901F2 X-SC-Subject: 体育の日 X-SC-Category: Holiday Japanese X-SC-Cond: 10 Oct X-SC-Duration: 19661010-19991010 X-SC-Record-Id: AFABC42C-2E9D-4093-A4AF-DA12D4D4B9D7 X-SC-Subject: 体育の日 X-SC-Category: Holiday Japanese X-SC-Cond: 2nd Mon Oct X-SC-Duration: 20001009- X-SC-Record-Id: C17D9CA5-28AF-4826-AD33-8B75473E5B52 X-SC-Subject: 文化の日 X-SC-Category: Holiday Japanese X-SC-Cond: 3 Nov X-SC-Duration: 19481103- X-SC-Record-Id: A76779D2-BB44-4ED5-ACF9-B646E10C7313 X-SC-Subject: 勤労感謝の日 X-SC-Category: Holiday Japanese X-SC-Cond: 23 Nov X-SC-Duration: 19481123- X-SC-Record-Id: 97E6F125-2625-44A9-8D43-A6FCA9670D8D X-SC-Subject: 天皇誕生日 X-SC-Category: Holiday Japanese X-SC-Cond: 23 Dec X-SC-Duration: 19891223- X-SC-Record-Id: 51D42B0D-EF46-4D65-B62A-6ED2F0D1F0B5 ## 毎年変わる祝日と振替休日 X-SC-Subject: 春分の日 X-SC-Day: 19960320 19970320 19980321 19990321 20000320 20010320 20020321 20030321 20040320 20050320 20060321 20070321 20080320 20090320 20100321 20110321 20120320 20130320 20140321 20150321 20160320 20170320 20180321 20190321 20200320 20210320 20220321 20230321 20240320 20250320 20260320 20270321 20280320 20290320 20300320 20310321 X-SC-Category: Holiday Japanese X-SC-Record-Id: 37616252-E6E5-4C69-9965-3F7B0236A0D8 X-SC-Subject: 秋分の日 X-SC-Day: 19960923 19970923 19980923 19990923 20000923 20010923 20020923 20030923 20040923 20050923 20060923 20070923 20080923 20090923 20100923 20110923 20120922 20130923 20140923 20150923 20160922 20170923 20180923 20190923 20200922 20210923 20220923 20230923 20240922 20250923 20260923 20270923 20280922 20290923 20300923 20310923 X-SC-Category: Holiday Japanese X-SC-Record-Id: 54A339AD-F7FD-4E56-9B70-2D09F840E94D X-SC-Subject: 振替休日 X-SC-Day: 19730430 19730924 19740506 19740916 19741104 19751124 19761011 19780102 19780116 19790212 19790430 19801124 19810504 19820322 19821011 19840102 19840116 19840430 19840924 19850506 19850916 19851104 19861124 19870504 19880321 19890102 19890116 19900212 19900430 19900924 19901224 19910506 19910916 19911104 19920504 19931011 19950102 19950116 19960212 19960506 19960916 19961104 19970721 19971124 19980504 19990322 19991011 20010212 20010430 20010924 20011224 20020506 20020916 20021104 20031124 20050321 20060102 20070212 20070430 20070924 20071224 20080506 20081124 20090506 20100322 20120102 20120430 20121224 20130506 20131104 20140506 20141124 20150506 20160321 20170102 20180212 20180430 20180924 20181224 20190506 20190812 20191104 20200506 20230102 20240212 20240506 20240812 20240923 20241104 20250506 20251124 20260506 20270322 20290212 20290430 20290924 20291224 20300506 20300812 20301104 20310506 20311124 20330321 20340102 20350212 20350430 20350924 20351224 20360506 20361124 20370506 20400102 20400430 20401224 20410506 20410812 20411104 20420506 20421124 20430506 20440321 20450102 20460212 20460430 20460924 20461224 20470506 20470812 20471104 20480506 20500321 X-SC-Category: Holiday Japanese X-SC-Record-Id: E2D696DF-EB49-44D7-B06C-812B10BD99A2 X-SC-Subject: 国民の休日 X-SC-Category: Holiday Japanese X-SC-Day: 19880504 19890504 19900504 19910504 19930504 19940504 19950504 19960504 19990504 20000504 20010504 20020504 20040504 20050504 20060504 20090922 20150922 20260922 20320921 20370922 20430922 20490921 20540922 20600921 20650922 20710922 20770921 20880921 20940921 20990922 X-SC-Record-Id: 46953810-BD72-45DE-BC11-104CBE970CFF ## Make sure you have at least one blank line for each entry (改行で終わる) ## EOF mhc-1.1.1/samples/mhc-completions.zsh000066400000000000000000000002651262546231500175650ustar00rootroot00000000000000compdef _mhc mhc _mhc () { local curcontext="$curcontext" local line state _opts _opts=("${(@f)$(mhc completions -- ${(Q)words[2,-1]})}") $_opts && return 0 return 1 } mhc-1.1.1/spec/000077500000000000000000000000001262546231500132215ustar00rootroot00000000000000mhc-1.1.1/spec/mhc_spec.rb000066400000000000000000000537061262546231500153420ustar00rootroot00000000000000require 'spec_helper' ### Rspec file for MHC describe Mhc do it 'should have a version number' do expect(Mhc::VERSION).not_to be_nil end end describe Mhc::PropertyValue::Date do it "should parse 'today'" do expect(Mhc::PropertyValue::Date.parse_relative("today")).to eq(Date.today) end end describe Mhc::Converter::Emacs do it "should convert a Ruby Hash to Emacs plist" do hash = { :title => "\\a\"", :start_date => "b\"b", :start_time => "c", :end_date => "d", :end_time => "e", :description => "f", :location => "g", :source => "h" } expect(Mhc::Converter::Emacs.new.to_emacs(hash)).to eq '(:title "\\\\a\\"" :start-date "b\\"b" :start-time "c" :end-date "d" :end-time "e" :description "f" :location "g" :source "h")' end end describe Mhc::Event do before :all do ENV["MHC_TZID"] = 'UTC' Mhc.default_tzid = ENV["MHC_TZID"] end before :each do time_now = ::Time.utc(2014, 1, 1) allow(::Time).to receive(:now).and_return(time_now) end it "should parse a string and dump to the same string" do str = <<-EOF.strip_heredoc X-SC-Subject: Weekly Event on Monday and Thursday X-SC-Location: Office X-SC-Day: !20140410 X-SC-Time: 12:40-14:10 X-SC-Category: Work X-SC-Mission-Tag: TEST-Mission X-SC-Recurrence-Tag: TEST X-SC-Cond: Mon Thu X-SC-Duration: 20140401-20140430 X-SC-Alarm: 5 minutes X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 X-SC-Sequence: 0 this is description EOF ev = Mhc::Event.parse(str) expect(ev.dump).to eq str end it "should parse a string and dump to the same string even if all values are empty" do str = <<-EOF.strip_heredoc X-SC-Subject: X-SC-Location: X-SC-Day: X-SC-Time: X-SC-Category: X-SC-Mission-Tag: X-SC-Recurrence-Tag: X-SC-Cond: X-SC-Duration: X-SC-Alarm: X-SC-Record-Id: X-SC-Sequence: 0 EOF ev = Mhc::Event.parse(str) expect(ev.dump).to eq str end it "should parse a string and dump to the same string even if some fields has hanging strings" do str = <<-EOF.strip_heredoc X-SC-Subject: Autumnal Equinox Day X-SC-Location: X-SC-Day: 19960923 19970923 19980923 19990923 20000923 20010923 20020923 20030923 20040923 20050923 20060923 20070923 20080923 20090923 20100923 20110923 20120922 20130923 20140923 20150923 20160922 20170923 20180923 20190923 20200922 20210923 20220923 20230923 20240922 20250923 20260923 20270923 20280922 20290923 20300923 20310923 X-SC-Time: X-SC-Category: Holiday Japanese X-SC-Mission-Tag: X-SC-Recurrence-Tag: X-SC-Cond: X-SC-Duration: X-SC-Alarm: X-SC-Record-Id: 54A339AD-F7FD-4E56-9B70-2D09F840E94D X-SC-Sequence: 0 EOF dump_str = <<-EOF.strip_heredoc X-SC-Subject: Autumnal Equinox Day X-SC-Location: X-SC-Day: 19960923 19970923 19980923 19990923 20000923 20010923 20020923 20030923 20040923 20050923 20060923 20070923 20080923 20090923 20100923 20110923 20120922 20130923 20140923 20150923 20160922 20170923 20180923 20190923 20200922 20210923 20220923 20230923 20240922 20250923 20260923 20270923 20280922 20290923 20300923 20310923 X-SC-Time: X-SC-Category: Holiday Japanese X-SC-Mission-Tag: X-SC-Recurrence-Tag: X-SC-Cond: X-SC-Duration: X-SC-Alarm: X-SC-Record-Id: 54A339AD-F7FD-4E56-9B70-2D09F840E94D X-SC-Sequence: 0 EOF ev = Mhc::Event.parse(str) expect(ev.dump).to eq dump_str end it "should occur weekly on Monday and Thursday from 2014-04-01 to 2014-04-30 with exception of 2014-04-10 (Thu)" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: Weekly Event on Monday and Thursday X-SC-Location: Office X-SC-Day: !20140410 X-SC-Time: 12:40-14:10 X-SC-Category: Work X-SC-Cond: Mon Thu X-SC-Duration: 20140401-20140430 X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 EOF from = Mhc::PropertyValue::Date.new(2014,04,7) to = Mhc::PropertyValue::Date.new(2014,04,24) # range.first is effective in narrowing the scan region so we will not have "2014-04-03" expect(ev.occurrences(range:from..to).take(30).map{|occurrence| occurrence.date.to_s}).to eq \ ["20140407", "20140414", "20140417", "20140421", "20140424"] end it "should occur yearly on March 21" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: Yearly Event on 21 March X-SC-Location: Office X-SC-Day: X-SC-Time: 12:40-14:10 X-SC-Category: Work X-SC-Cond: Mar 21 X-SC-Duration: 20140401-20200401 X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 EOF expect(ev.occurrences.take(30).map{|o| o.date.to_s}).to eq \ ["20150321", "20160321", "20170321", "20180321", "20190321", "20200321"] end it "should show single day in X-SC-Day:" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: Party X-SC-Day: 20140509 X-SC-Time: 18:00-22:00 X-SC-Record-Id: 1653B99D-DED2-4758-934F-B868BFCA9E9F EOF expect(ev.occurrences.take(30).map{|o| o.date.to_s}).to eq \ ["20140509"] end it "should show three enumerated days listed in X-SC-Day:" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: Three enumerated events in X-SC-Day: X-SC-Day: 20140203 20140509 20140831 20140901-20140902 X-SC-Duration: 20140101-20141231 X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 EOF expect(ev.occurrences.take(30).map{|o| o.to_s}).to eq \ ["20140203", "20140509", "20140831", "20140901-20140902"] end it "should show three day's event even if scan range is started from the middle of event" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: Three day's event X-SC-Day: 20140514-20140516 EOF from = Mhc::PropertyValue::Date.new(2014, 5, 15) to = Mhc::PropertyValue::Date.new(2014, 5, 16) expect(ev.occurrences(range:from..to).take(30).map{|o| o.to_s}).to eq \ ["20140514-20140516"] end it "should produce a list of occurrences, and each occurrence has different date" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: TEST X-SC-Time: 10:00-12:00 X-SC-Day: 20140203 20140509 20140831 X-SC-Duration: 20140101-20141231 X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 EOF expect(ev.occurrences.take(30).map{|o| "#{o.date} #{o.time_range} #{o.subject}"}).to eq \ ["20140203 10:00-12:00 TEST", "20140509 10:00-12:00 TEST", "20140831 10:00-12:00 TEST"] end it "should return true when #allday? is called if X-SC-Time: is blank" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: TEST X-SC-Time: X-SC-Day: 20140203 20140509 20140831 X-SC-Duration: 20140101-20141231 X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 EOF expect(ev.occurrences.take(30).all? {|o| o.allday? }).to eq true end it "should return false when #allday? is called if X-SC-Time: is not blank" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: TEST X-SC-Time: 10:00-12:00 X-SC-Day: 20140203 20140509 20140831 X-SC-Duration: 20140101-20141231 X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 EOF expect(ev.occurrences.take(30).all? {|o| not o.allday? }).to eq true end it "should return almost infinit number of entries: 1970-1-1 to 50 years future, if X-SC-Duration: is empty" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: New Year Day X-SC-Cond: 1 Jan X-SC-Duration: X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 EOF times = Date.today.year + 50 - Date.new(1970, 1, 1).year + 1 expect(ev.occurrences.map{|o| o.date.to_s}.length).to eq times end it "should return ``yearly by monthday'' icalendar rrule string" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: New Year Day X-SC-Cond: 1 Jan X-SC-Duration: X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 EOF expect(ev.recurrence_condition.to_ics).to eq "FREQ=YEARLY;INTERVAL=1;WKST=MO;BYMONTH=1;BYMONTHDAY=1" end it "should return ``yearly by day'' icalendar rrule string" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: Mother's Day X-SC-Cond: 2nd Sun May X-SC-Duration: X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 EOF expect(ev.recurrence_condition.to_ics).to eq "FREQ=YEARLY;INTERVAL=1;WKST=MO;BYMONTH=5;BYDAY=2SU" end it "should return ``weekly'' icalendar rrule string" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: Wednesday and Sunday Weekly event X-SC-Cond: Wed Sun X-SC-Duration: 20140401-20140424 X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 EOF expect(ev.recurrence_condition.to_ics(nil, ev.duration.last)).to eq "FREQ=WEEKLY;INTERVAL=1;WKST=MO;BYDAY=WE,SU;UNTIL=20140424" end it "should return icalendar VEVENT string with RRULE field" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: Wednesday and Sunday Weekly event X-SC-Cond: Wed Sun X-SC-Category: Work X-SC-Location: Office X-SC-Duration: 20140401-20140424 X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 this is description EOF expect(ev.to_ics).to eq <<-'EOF'.strip_heredoc BEGIN:VEVENT CREATED;VALUE=DATE-TIME:20140101T000000Z DTEND;VALUE=DATE:20140403 DTSTART;VALUE=DATE:20140402 DTSTAMP;VALUE=DATE-TIME:20140101T000000Z CATEGORIES:Work LAST-MODIFIED;VALUE=DATE-TIME:20140101T000000Z UID:FEDA4C97-21C2-46AA-A395-075856FBD5C3 DESCRIPTION:this is description\n SUMMARY:Wednesday and Sunday Weekly event RRULE:FREQ=WEEKLY;INTERVAL=1;WKST=MO;BYDAY=WE,SU;UNTIL=20140424 LOCATION:Office SEQUENCE:0 END:VEVENT EOF end it "should return icalendar VEVENT string taking DTSTART from the first entry of X-SC-Day: and RDATE from remains" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: thee events on 20140203 20140509 20140831 X-SC-Day: 20140203 20140509 20140831 X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 this is description EOF expect(ev.to_ics).to eq <<-'EOF'.strip_heredoc BEGIN:VEVENT RDATE;VALUE=DATE:20140509,20140831 CREATED;VALUE=DATE-TIME:20140101T000000Z DTEND;VALUE=DATE:20140204 DTSTART;VALUE=DATE:20140203 DTSTAMP;VALUE=DATE-TIME:20140101T000000Z LAST-MODIFIED;VALUE=DATE-TIME:20140101T000000Z UID:FEDA4C97-21C2-46AA-A395-075856FBD5C3 DESCRIPTION:this is description\n SUMMARY:thee events on 20140203 20140509 20140831 SEQUENCE:0 END:VEVENT EOF end it "should return icalendar VEVENT string taking EXDATE from the entries of X-SC-Day: !YYYYMMDD" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: Wednesdays in 2014-04 (2, 9, 16, ..., 30) with exceptions of 2, 16 X-SC-Cond: Wed X-SC-Duration: 20140401-20140430 X-SC-Day: !20140402 !20140416 X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 this is description EOF expect(ev.to_ics).to eq <<-'EOF'.strip_heredoc BEGIN:VEVENT EXDATE;VALUE=DATE:20140402,20140416 CREATED;VALUE=DATE-TIME:20140101T000000Z DTEND;VALUE=DATE:20140403 DTSTART;VALUE=DATE:20140402 DTSTAMP;VALUE=DATE-TIME:20140101T000000Z LAST-MODIFIED;VALUE=DATE-TIME:20140101T000000Z UID:FEDA4C97-21C2-46AA-A395-075856FBD5C3 DESCRIPTION:this is description\n SUMMARY:Wednesdays in 2014-04 (2\, 9\, 16\, ...\, 30) with exceptions of 2\, 16 RRULE:FREQ=WEEKLY;INTERVAL=1;WKST=MO;BYDAY=WE;UNTIL=20140430 SEQUENCE:0 END:VEVENT EOF end it "should return icalendar VEVENT string taking EXDATE from the entries of X-SC-Day: !YYYYMMDD and X-SC-Time:" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: CS1 X-SC-Time: 08:40-10:10 X-SC-Category: Lecture X-SC-Day: !20140514 X-SC-Cond: Wed X-SC-Duration: 20140409-20140723 X-SC-Record-Id: 69CFD0DF-4058-425B-8C2B-40D81E6A2392 EOF expect(ev.to_ics).to eq <<-'EOF'.strip_heredoc BEGIN:VEVENT EXDATE;VALUE=DATE-TIME:20140514T084000Z CREATED;VALUE=DATE-TIME:20140101T000000Z DTEND;VALUE=DATE-TIME:20140409T101000Z DTSTART;VALUE=DATE-TIME:20140409T084000Z DTSTAMP;VALUE=DATE-TIME:20140101T000000Z CATEGORIES:Lecture LAST-MODIFIED;VALUE=DATE-TIME:20140101T000000Z UID:69CFD0DF-4058-425B-8C2B-40D81E6A2392 DESCRIPTION: SUMMARY:CS1 RRULE:FREQ=WEEKLY;INTERVAL=1;WKST=MO;BYDAY=WE;UNTIL=20140723T084000Z SEQUENCE:0 END:VEVENT EOF end it "should return icalendar VEVENT over 24h event" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: CS1 X-SC-Time: 12:00-10:10 X-SC-Day: 20140508-20140509 X-SC-Record-Id: 69CFD0DF-4058-425B-8C2B-40D81E6A2392 EOF expect(ev.to_ics).to eq <<-'EOF'.strip_heredoc BEGIN:VEVENT CREATED;VALUE=DATE-TIME:20140101T000000Z DTEND;VALUE=DATE-TIME:20140509T101000Z DTSTART;VALUE=DATE-TIME:20140508T120000Z DTSTAMP;VALUE=DATE-TIME:20140101T000000Z LAST-MODIFIED;VALUE=DATE-TIME:20140101T000000Z UID:69CFD0DF-4058-425B-8C2B-40D81E6A2392 DESCRIPTION: SUMMARY:CS1 SEQUENCE:0 END:VEVENT EOF end it "should return icalendar VEVENT two day's allday event" do ev = Mhc::Event.parse <<-EOF.strip_heredoc X-SC-Subject: CS1 X-SC-Day: 20140508-20140509 X-SC-Record-Id: 69CFD0DF-4058-425B-8C2B-40D81E6A2392 EOF expect(ev.to_ics).to eq <<-'EOF'.strip_heredoc BEGIN:VEVENT CREATED;VALUE=DATE-TIME:20140101T000000Z DTEND;VALUE=DATE:20140510 DTSTART;VALUE=DATE:20140508 DTSTAMP;VALUE=DATE-TIME:20140101T000000Z LAST-MODIFIED;VALUE=DATE-TIME:20140101T000000Z UID:69CFD0DF-4058-425B-8C2B-40D81E6A2392 DESCRIPTION: SUMMARY:CS1 SEQUENCE:0 END:VEVENT EOF end it "should convert 2014-03-11 10:30-12:00 (+0900 Asia/Tokyo) event to UTC Event" do ev = Mhc::Event.new_from_ics <<-EOF.strip_heredoc BEGIN:VCALENDAR PRODID;X-RICAL-TZSOURCE=TZINFO:-//Quickhack.net//MHC 0.25.0//EN CALSCALE:GREGORIAN VERSION:2.0 BEGIN:VEVENT CREATED;VALUE=DATE-TIME:20140101T000000Z DTSTART;TZID=Asia/Tokyo;VALUE=DATE-TIME:20100311T103000 DTEND;TZID=Asia/Tokyo;VALUE=DATE-TIME:20100311T120000 DTSTAMP;VALUE=DATE-TIME:20140101T000000Z LAST-MODIFIED;VALUE=DATE-TIME:20140101T000000Z UID:69CFD0DF-4058-425B-8C2B-40D81E6A2392 DESCRIPTION:This is Description. SUMMARY:CS1 SEQUENCE:0 END:VEVENT END:VCALENDAR EOF expect(ev.dump).to eq <<-'EOF'.strip_heredoc X-SC-Subject: CS1 X-SC-Location: X-SC-Day: 20100311 X-SC-Time: 01:30-03:00 X-SC-Category: X-SC-Mission-Tag: X-SC-Recurrence-Tag: X-SC-Cond: X-SC-Duration: X-SC-Alarm: X-SC-Record-Id: 69CFD0DF-4058-425B-8C2B-40D81E6A2392 X-SC-Sequence: 0 This is Description. EOF end it "should convert 2014-10-18 22:00-23:00 (Asia/Tokyo) iCalendar to 2014-10-18 15:00-16:00 (Europe/Paris) MHC Event" do Mhc.default_tzid = "Europe/Paris" ev = Mhc::Event.new_from_ics <<-EOF.strip_heredoc BEGIN:VCALENDAR PRODID;X-RICAL-TZSOURCE=TZINFO:-//Quickhack.net//MHC 0.25.0//EN CALSCALE:GREGORIAN VERSION:2.0 BEGIN:VEVENT DTSTART;TZID=Asia/Tokyo;VALUE=DATE-TIME:20141018T220000 DTEND;VALUE=DATE-TIME:20141018T140000Z UID:69CFD0DF-4058-425B-8C2B-40D81E6A2392 DESCRIPTION:This is Description. SUMMARY:CS1 SEQUENCE:0 END:VEVENT END:VCALENDAR EOF expect(ev.dump).to eq <<-'EOF'.strip_heredoc X-SC-Subject: CS1 X-SC-Location: X-SC-Day: 20141018 X-SC-Time: 15:00-16:00 X-SC-Category: X-SC-Mission-Tag: X-SC-Recurrence-Tag: X-SC-Cond: X-SC-Duration: X-SC-Alarm: X-SC-Record-Id: 69CFD0DF-4058-425B-8C2B-40D81E6A2392 X-SC-Sequence: 0 This is Description. EOF end it "should create all-day event 20140508-20140509 from iCalendar" do ev = Mhc::Event.new_from_ics <<-EOF.strip_heredoc BEGIN:VCALENDAR PRODID;X-RICAL-TZSOURCE=TZINFO:-//Quickhack.net//MHC 0.25.0//EN CALSCALE:GREGORIAN VERSION:2.0 BEGIN:VEVENT CREATED;VALUE=DATE-TIME:20140101T000000Z DTEND;VALUE=DATE:20140510 DTSTART;VALUE=DATE:20140508 DTSTAMP;VALUE=DATE-TIME:20140101T000000Z LAST-MODIFIED;VALUE=DATE-TIME:20140101T000000Z UID:69CFD0DF-4058-425B-8C2B-40D81E6A2392 DESCRIPTION:This is Description. SUMMARY:CS1 SEQUENCE:0 END:VEVENT END:VCALENDAR EOF expect(ev.dump).to eq <<-'EOF'.strip_heredoc X-SC-Subject: CS1 X-SC-Location: X-SC-Day: 20140508-20140509 X-SC-Time: X-SC-Category: X-SC-Mission-Tag: X-SC-Recurrence-Tag: X-SC-Cond: X-SC-Duration: X-SC-Alarm: X-SC-Record-Id: 69CFD0DF-4058-425B-8C2B-40D81E6A2392 X-SC-Sequence: 0 This is Description. EOF end it "should create recurrence condition from iCalendar string" do ev = Mhc::Event.new_from_ics <<-EOF.strip_heredoc BEGIN:VCALENDAR PRODID;X-RICAL-TZSOURCE=TZINFO:-//Quickhack.net//MHC 0.25.0//EN CALSCALE:GREGORIAN VERSION:2.0 BEGIN:VEVENT CREATED;VALUE=DATE-TIME:20140101T000000Z DTEND;VALUE=DATE:20140403 DTSTART;VALUE=DATE:20140402 DTSTAMP;VALUE=DATE-TIME:20140101T000000Z CATEGORIES:Work LAST-MODIFIED;VALUE=DATE-TIME:20140101T000000Z UID:FEDA4C97-21C2-46AA-A395-075856FBD5C3 DESCRIPTION:this is description\n SUMMARY:Wednesday and Sunday Weekly event RRULE:FREQ=WEEKLY;INTERVAL=1;WKST=MO;BYDAY=WE,SU;UNTIL=20140424 LOCATION:Office SEQUENCE:0 END:VEVENT END:VCALENDAR EOF expect(ev.dump).to eq <<-'EOF'.strip_heredoc X-SC-Subject: Wednesday and Sunday Weekly event X-SC-Location: Office X-SC-Day: X-SC-Time: X-SC-Category: Work X-SC-Mission-Tag: X-SC-Recurrence-Tag: X-SC-Cond: Wed Sun X-SC-Duration: 20140402-20140424 X-SC-Alarm: X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 X-SC-Sequence: 0 this is description EOF end it "should create recurrence condition from iCalendar string with RDATE" do Mhc.default_tzid = "Asia/Tokyo" ev = Mhc::Event.new_from_ics <<-EOF.strip_heredoc BEGIN:VCALENDAR BEGIN:VEVENT RDATE;TZID=Asia/Tokyo;VALUE=DATE-TIME:20141114T124500 EXDATE;TZID=Asia/Tokyo;VALUE=DATE-TIME:20141022T124500,20141119T124500,20 141231T124500,20150107T124500 CREATED;VALUE=DATE-TIME:20140924T004619Z DTEND;TZID=Asia/Tokyo;VALUE=DATE-TIME:20141001T141500 DTSTART;TZID=Asia/Tokyo;VALUE=DATE-TIME:20141001T124500 DTSTAMP;VALUE=DATE-TIME:20141017T061129Z CATEGORIES:Lecture LAST-MODIFIED;VALUE=DATE-TIME:20140924T004619Z UID:FEDA4C97-21C2-46AA-A395-075856FBD5C3 DESCRIPTION:this is description\n SUMMARY:PP RRULE:FREQ=WEEKLY;INTERVAL=1;WKST=MO;BYDAY=WE;UNTIL=20150128T034500Z LOCATION:Room11 SEQUENCE:4 END:VEVENT END:VCALENDAR EOF expect(ev.dump).to eq <<-'EOF'.strip_heredoc X-SC-Subject: PP X-SC-Location: Room11 X-SC-Day: 20141114 !20141022 !20141119 !20141231 !20150107 X-SC-Time: 12:45-14:15 X-SC-Category: Lecture X-SC-Mission-Tag: X-SC-Recurrence-Tag: X-SC-Cond: Wed X-SC-Duration: 20141001-20150128 X-SC-Alarm: X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 X-SC-Sequence: 4 this is description EOF end it "should create duration-end considering timezone" do Mhc.default_tzid = "Asia/Tokyo" ev = Mhc::Event.new_from_ics <<-EOF.strip_heredoc BEGIN:VCALENDAR BEGIN:VEVENT EXDATE;TZID=Asia/Tokyo;VALUE=DATE-TIME:20140514T084000,20140723T084000 DTEND;TZID=Asia/Tokyo;VALUE=DATE-TIME:20140409T101000 DTSTART;VALUE=DATE-TIME:20140408T234000Z CATEGORIES:Lecture UID:FEDA4C97-21C2-46AA-A395-075856FBD5C3 DESCRIPTION:this is description\n SUMMARY:CS1 RRULE:FREQ=WEEKLY;INTERVAL=1;WKST=MO;BYDAY=WE;UNTIL=20140729T234000Z LOCATION:Room11 SEQUENCE:4 END:VEVENT END:VCALENDAR EOF expect(ev.dump).to eq <<-'EOF'.strip_heredoc X-SC-Subject: CS1 X-SC-Location: Room11 X-SC-Day: !20140514 !20140723 X-SC-Time: 08:40-10:10 X-SC-Category: Lecture X-SC-Mission-Tag: X-SC-Recurrence-Tag: X-SC-Cond: Wed X-SC-Duration: 20140409-20140730 X-SC-Alarm: X-SC-Record-Id: FEDA4C97-21C2-46AA-A395-075856FBD5C3 X-SC-Sequence: 4 this is description EOF end end describe RiCal do it "creates RiCal::Event form ics string" do Mhc.default_tzid = "Asia/Tokyo" ics = RiCal.parse_string <<-EOF.strip_heredoc BEGIN:VCALENDAR BEGIN:VEVENT EXDATE;TZID=Asia/Tokyo;VALUE=DATE-TIME:20140514T084000,20140723T084000 DTEND;TZID=Asia/Tokyo;VALUE=DATE-TIME:20140409T101000 DTSTART;VALUE=DATE-TIME:20140408T234000Z CATEGORIES:Lecture UID:FEDA4C97-21C2-46AA-A395-075856FBD5C3 DESCRIPTION:this is description\n SUMMARY:CS1 RRULE:FREQ=WEEKLY;INTERVAL=1;WKST=MO;BYDAY=WE;UNTIL=20140729T234000Z LOCATION:Room11 SEQUENCE:4 END:VEVENT END:VCALENDAR EOF iev = ics.first.events.first expect(iev.occurrences.first.dtstart.tzid).to eq "UTC" end end describe Mhc::DateFrame::Yearly do end describe Mhc::DateFrame::Monthly do end describe Mhc::DateFrame::Weekly do end describe Mhc::DateFrame::Daily do end mhc-1.1.1/spec/spec_helper.rb000066400000000000000000000003141262546231500160350ustar00rootroot00000000000000$LOAD_PATH.unshift File.expand_path('../../lib', __FILE__) require 'mhc' class String def strip_heredoc indent = scan(/^[ \t]*(?=\S)/).min.size rescue 0 gsub(/^[ \t]{#{indent}}/, '') end end mhc-1.1.1/xpm/000077500000000000000000000000001262546231500130735ustar00rootroot00000000000000mhc-1.1.1/xpm/close.xpm000066400000000000000000000006461262546231500147340ustar00rootroot00000000000000/* XPM */ static char *magick[] = { /* columns rows colors chars-per-pixel */ "25 10 2 1", "* c Purple", " c None", /* pixels */ "**** ** ***** **** ****", "**** ** ***** **** ****", "** ** ** ** ** ** ", "** ** ** ** ** ** ", "** ** ** ** **** ****", "** ** ** ** **** ****", "** ** ** ** ** ** ", "** ** ** ** ** ** ", "**** **** ***** **** ****", "**** **** ***** **** ****" }; mhc-1.1.1/xpm/delete.xpm000066400000000000000000000005631262546231500150670ustar00rootroot00000000000000/* XPM */ static char *delete[] = { /* width height num_colors chars_per_pixel */ " 16 10 2 1", /* colors */ ". c None", "# c Red", /* pixels */ "###....####.##..", "####...####.##..", "#####..##...##..", "##.###.##...##..", "##..##.####.##..", "##..##.####.##..", "##.###.##...##..", "#####..##...##..", "####...####.####", "###....####.####" }; mhc-1.1.1/xpm/exit.xpm000066400000000000000000000005641262546231500145770ustar00rootroot00000000000000/* XPM */ static char *magick[] = { /* columns rows colors chars-per-pixel */ "20 10 2 1", "* c Purple", " c None", /* pixels */ "**** ** ** ** ****", "**** ** ** ** ****", "** ** ** ** ** ", "** ** ** ** ** ", "**** *** ** ** ", "**** *** ** ** ", "** ** ** ** ** ", "** ** ** ** ** ", "**** ** ** ** ** ", "**** ** ** ** ** " }; mhc-1.1.1/xpm/month.xpm000066400000000000000000000005371262546231500147530ustar00rootroot00000000000000/* XPM */ static char *magick[] = { /* columns rows colors chars-per-pixel */ "18 10 2 1", "* c Brown", " c None", /* pixels */ "******************", "* *", "* ** ** ** ** *", "* ** ** ** ** *", "* *", "* ** ** ** ** *", "* ** ** ** ** *", "* *", "* ** ** ** ** *", "******************" }; mhc-1.1.1/xpm/next.xpm000066400000000000000000000005401262546231500145760ustar00rootroot00000000000000/* XPM */ static char *magick[] = { /* columns rows colors chars-per-pixel */ "18 10 2 1", "* c Brown", " c None", /* pixels */ " ********* ", " *********** ", " ************* ", " ***************", " ************* ", " *********** ", " ********* ", " ", " ", " ", }; mhc-1.1.1/xpm/next2.xpm000066400000000000000000000005361262546231500146650ustar00rootroot00000000000000/* XPM */ static char *magick[] = { /* columns rows colors chars-per-pixel */ "18 10 2 1", "* c Blue", " c None", /* pixels */ " ********* ", " *********** ", "** ************* ", "** ***************", "** ************* ", "** *********** ", "** ********* ", "** ", "******** ", "****** " }; mhc-1.1.1/xpm/next_year.xpm000066400000000000000000000005671262546231500156270ustar00rootroot00000000000000/* XPM */ static char * next_year_xpm[] = { /* columns rows colors chars-per-pixel */ "18 10 2 1", /*US*/ " c None", ". c Brown", /* pixels */ " ... ... ", " ..... ... ", " ....... ... ", " ......... ...", " ....... ... ", " ..... ... ", " ... ... ", " ", " ", " "}; mhc-1.1.1/xpm/open.xpm000066400000000000000000000005471262546231500145700ustar00rootroot00000000000000/* XPM */ static char *open[] = { /* width height num_colors chars_per_pixel */ " 15 10 2 1", /* colors */ ". c None", "* c Red", /* pixels */ " * *****", " ***** *****", " ******* *****", "** * ** *****", "** * ** *****", "** ***** *****", "** ** * *", "** ** ** **", " ******* *** ", " ***** * " }; mhc-1.1.1/xpm/prev.xpm000066400000000000000000000005371262546231500146020ustar00rootroot00000000000000/* XPM */ static char *magick[] = { /* columns rows colors chars-per-pixel */ "18 10 2 1", "* c Brown", " c None", /* pixels */ " ********* ", " *********** ", " ************* ", "*************** ", " ************* ", " *********** ", " ********* ", " ", " ", " " }; mhc-1.1.1/xpm/prev2.xpm000066400000000000000000000005361262546231500146630ustar00rootroot00000000000000/* XPM */ static char *magick[] = { /* columns rows colors chars-per-pixel */ "18 10 2 1", "* c Blue", " c None", /* pixels */ " ********* ", " *********** ", " ************* **", "*************** **", " ************* **", " *********** **", " ********* **", " **", " ********", " ******" }; mhc-1.1.1/xpm/prev_year.xpm000066400000000000000000000005671262546231500156250ustar00rootroot00000000000000/* XPM */ static char * prev_year_xpm[] = { /* columns rows colors chars-per-pixel */ "18 10 2 1", /*US*/ " c None", ". c Brown", /* pixels */ " ... ... ", " ... ..... ", " ... ....... ", "... ......... ", " ... ....... ", " ... ..... ", " ... ... ", " ", " ", " "}; mhc-1.1.1/xpm/save.xpm000066400000000000000000000006711262546231500145630ustar00rootroot00000000000000/* XPM */ static char *save[] = { /* width height num_colors chars_per_pixel */ " 23 10 2 1", /* colors */ "* c Black", " c None", /* pixels */ "**** ****** ** ** ****", "**** ****** ** ** ****", "** ** ** ** ** ** ", "** ** ** ** ** ** ", "**** ****** ** ** ****", "**** ****** ** ** ****", " ** ****** ** ** ** ", " ** ** ** ****** ** ", "**** ** ** **** ****", "**** ** ** ** ****" }; mhc-1.1.1/xpm/today.xpm000066400000000000000000000005631262546231500147450ustar00rootroot00000000000000/* XPM */ static char *magick[] = { /* columns rows colors chars-per-pixel */ "20 10 2 1", " c None", "* c Black", /* pixels */ " *************** ", " *****************", " *****************", " ***** ****", "*********** ****", " ********* ****", " ******* ****", " ***** *********", " *** *********", " * *********" };