;;; snap.el --- save/load snapshot of application to/from text

;; Copyright (c) 2003, 2004, 2005 by HIRAOKA Kazuyuki <khi@users.sourceforge.jp>
;; $Id: snap.el,v 1.19 2005/05/23 17:59:40 hira Exp $
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; The GNU General Public License is available by anonymouse ftp from
;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
;; USA.

;;; Commentary:

;; Usage:
;;
;; (1) M-x snap-record on application, e.g. Wanderlust.
;; (2) Yank (C-y) on any buffer, e.g. *scratch* or ~/memo.txt.
;; (3) M-x snap-play on yanked text ==> snapshot (1) is restored.

;; Supported applications:
;;
;; - Wanderlust (Summary buffer)
;; - Help
;; - Bookmark
;; - Man
;; - Info
;; - Emacs-wiki
;; - Navi2ch (Article buffer)
;; - w3m
;; - Dired
;; - BBDB
;; - BibTeX
;; - howm-search ( C-c , g )
;; - Shell
;; - occur (experimental, using fake cgi-extension)
;; - snap:///  (only message it's version)
;;
;; For unsupported buffers,
;; file name and current position are recorded.

;; Internal:
;;
;; Format of snapshot string is "snap://MAJOR-MODE/SPELL".
;; Format and meaning of SPELL depend on MAJOR-MODE.
;; For example,
;; snap://wl-summary-mode/+ME/hira/<20031101192305.AFA8C43EDC@hoge.fuga.piyo>
;; is a snapshot string of wl-summary-mode for the spell
;; +ME/hira/<20031101192305.AFA8C43EDC@hoge.fuga.piyo>,
;; which indicates
;; message-id <20031101192305.AFA8C43EDC@hoge.fuga.piyo>
;; in the folder +ME/hira.
;;
;; Please define snap-record:MAJOR-MODE and snap-play:MAJOR-MODE
;; if you want to support your favorite application.
;; (snap-record:MAJOR-MODE) returns SPELL string for current snapshot.
;; (snap-play:MAJOR-MODE SPELL) restores snapshot from SPELL string.

;; Abbreviation (experimental):
;;
;; You can add abbreviation rules of snap strings
;; to the variable `snap-abbrev'. See its docstring for details.

;; Fake cgi-extension (experimental):
;;
;; When `snap-record-cgi' is not nil, you can use a
;; Fake cgi like "snap://MAJOR-MODE/SPELL??g=110&s=str&q=word&x=",
;; which calls snap-play::g, snap-play::s, snap-play::q and
;; snap-play::x.  At this experimental stage, format of url is not
;; strict like RFC and not *escaped*. (and I have no idea for doing it
;; :-) An example of the problem is
;; "snap://occur-mode/dired-mode/~/??q=drwx??g=2", but it still works
;; because of longest-match tricks.  See `snap-cgi-decode'
;;
;; Supported cgi-functions:
;; g=110  goto-line
;; s=str  search string
;; q=word occur word
;; x=     dired-x

;; Repair (experimental):
;;
;; When you fail snap-play, you can try M-x snap-repair
;; to repair snapshot text.
;; This can happen, e.g. when you move mails to other folders.
;;
;; You have to write your own 'my-snap-search-mail' function
;; which receives message-id and returns its file name.
;; My version requires namazu and howm.
;; - namazu: full text search engine <http://www.namazu.org/index.html.en>
;; - howm: note-taking tool <http://howm.sourceforge.jp/>
;; (defvar my-namazu-mail-dir (expand-file-name "~/PATH/NMZ/Mail"))
;; (defun my-snap-search-mail (message-id)
;;   (let* ((query (format "+message-id:%s" message-id))
;;          (args `("-l" "-n" "1" ,query ,my-namazu-mail-dir)))
;;     (car (howm-view-call-process "namazu" args))))

;; ChangeLog:
;;
;; [2005-05-24] snap-record-string never cause error again.
;;              This is necessary for my another tool, atode.el.
;;              http://howm.sourceforge.jp/a/atode.el
;; [2005-05-19] BBDB, BibTeX, Shell ,occur, howm-search are supported.
;;              fix: `snap-play' and extend fake cgi and `snap-expand-alist'.
;;              And set `snap-record-default-format'. (thx > Ma)
;; [2005-03-03] snap-record-string doesn't cause error any more.
;; [2004-11-16] fix: second -> cadr (thx > Toorisugari)
;; [2004-09-11] Emacs-wiki, Navi2ch, w3m, Dired are supported. (thx > Ma)
;; [2004-04-21] fix: Error when action-lock is not available (thx > Nanashi)
;; [2004-04-18] Goto occurrence when it is unique match.
;; [2004-04-10] Help, Bookmark, Man, Info are supported. (thx > Ma)
;; [2004-02-25] action-lock
;; [2004-02-23] fix: Error on CVS latest Wanderlust (thx > hirose31)
;; [2004-01-16] Jump to specified position
;; [2003-11-09] fix: All modes said 'not supported'.
;; [2003-11-08] First upload
;; [2003-11-05] First version

;; Bug?
;; - thing-at-point fails to recognize "snap:///file#1: snap:///"

;;; Code:

(require 'thingatpt)

(defvar snap-version "$Id: snap.el,v 1.19 2005/05/23 17:59:40 hira Exp $")
(defvar snap-prt "snap://")
(defvar snap-format (concat snap-prt "%s/%s"))
(defvar snap-regexp (concat (regexp-quote snap-prt) "\\([^/\r\n]*\\)/\\(.*\\)"))
(defvar snap-mode-pos 1)
(defvar snap-spell-pos 2)
(defvar snap-root-dir "/")
(defvar snap-record-string-no-error t
  "For private use by other packages.
It indicates that old bug on `snap-record-string' is already fixed.")
(defvar snap-spell-format "%s??%s"
  "Note: You can change this default to \"%s?%s\" like a cgi.  But you
will face to ploblem; how to deal with
\"snap://w3m-mode/http://www.google.com?q=1?q=2\".")
(defvar snap-cgi-format "%s=%s")
(defvar snap-spell-regexp "\\(.*\\)[?][?]\\([a-z][=].*\\)"
  "Note: Longest match of first part is important for the case:
\"snap://occur-mode/dired-mode/~/??q=drwx??g=2\"")
(defvar snap-nocgi-pos 1)
(defvar snap-cgi-pos 2)
(defvar snap-cgi-separator "&")
(defvar snap-record-cgi nil
  "List of recorded cgi types in `snap-record'")
;;; for test use:
;;; (setq snap-record-cgi '("g" "s" "q"))

(defvar snap-abbrev nil
  "List of rules on abbreviation for snap string.
Each rule is a list of three strings: ABBREV, MODE, and SPELL-HEAD.
snap://ABBREV/xxx is expanded as snap://MODE/SPELL-HEADxxx.

Example:
 ;; snap://l/file ==> snap://dired-mode/usr/local/meadow/1.15/lisp/file
 ;; snap://s/dir  ==> snap://shell-mode/~/#dir
 (setq snap-abbrev
       '((\"l\" \"dired-mode\" \"usr/local/meadow/1.15/lisp/\")
         (\"s\" \"shell-mode\" \"~/\#\")))
")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; main

(defun snap-record ()
  "Convert snapshot of application to string, and put it to kill-ring."
  (interactive)
  (let ((snap (snap-record-string)))
    (when (null snap)
      (error "This buffer is not supported."))
    (kill-new snap)
    (message "%s" snap)))

(defun snap-play ()
  "Restore snapshot of application from string at point."
  (interactive)
  (let ((snap (thing-at-point 'snap)))
    ;; avoid (snap-play-string nil)
    (and snap (snap-play-string snap))))

(defun snap-repair ()
  (interactive)
  (let ((snap (thing-at-point 'snap))
        (beg (match-beginning 0))
        (end (match-end 0)))
    (let ((repaired (snap-repair-string snap)))
      (goto-char beg)
      (delete-region beg end)
      (insert repaired)
      (message "Repaired."))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; util

(defun snap-record-string ()
  (let ((long (snap-record-string-exact)))
    (and long (snap-shrink-string long))))
(defun snap-play-string (snap)
  (snap-play-string-exact (snap-expand-string snap)))

(defun snap-shrink-string (snap)
  "String SNAP is shrinked according to rules in `snap-abbrev'.
When several rules are applicable, the shortest result is returned."
  (let ((candidates (mapcar (lambda (rule)
                              (snap-shrink-string-by-rule snap rule))
                            snap-abbrev)))
    (if candidates
        (car (sort candidates (lambda (x y) (< (length x) (length y)))))
      snap)))

(defun snap-shrink-string-by-rule (snap rule)
  (apply (lambda (abbrev mode spell-head)
           (apply (lambda (o-mode o-spell)
                    (let ((reg (concat "^" (regexp-quote spell-head))))
                      (if (and (string= mode o-mode)
                               (string-match reg o-spell))
                          (snap-encode abbrev (substring o-spell (match-end 0)))
                        snap)))
                  (snap-decode snap)))
         rule))

(defun snap-expand-string (snap)
  (apply (lambda (a-mode a-spell)
           (let ((rule (assoc a-mode snap-abbrev)))
             (if rule
                 (apply (lambda (abbrev mode spell-head)
                          (snap-encode mode (concat spell-head a-spell)))
                        rule)
               snap)))
         (snap-decode snap)))

(defun snap-record-string-exact ()
  "Convert snapshot of application to string.
Nil is returned for unsupported buffer."
  (let* ((mode major-mode)
         (recorder (or (snap-op 'record mode t)
                       (progn (setq mode "") (snap-op 'record mode))))
         (spell (funcall recorder)))
    (and spell
         (snap-encode mode spell
                      (delq nil (mapcar #'snap-record-cgi snap-record-cgi))))))

(defun snap-play-string-exact (snap)
  "Restore snapshot of application from string. "
  (let* ((x (snap-decode snap snap-record-cgi))
         (mode (car x))
         (spell (cadr x))
         (cgi (cddr x))
         (player (snap-op 'play mode)))
    (funcall player spell)
    (mapcar (lambda (z)
              (apply (lambda (var val)
                       (funcall (snap-op 'play (concat ":" var)) val))
                     z))
            cgi)))

(defun snap-record-cgi (op)
  (let ((s (funcall (snap-op 'record (concat ":" op)))))
    (if s
        (snap-cgi-encode op s)
      nil)))

(defun snap-spell-decode (spell)
  ;; suppose: spell has no-property
  ;; Example:
  ;; (snap-spell-decode "body#tag1?g=1&q=2??g=op1&q=?q=&x=#tag2&x")
  ;; => ("body#tag1?g=1&q=2" ("g" "op1") ("q" "?q") ("x" "#tag2&x"))
  (if (string-match snap-spell-regexp spell)
      (cons (match-string snap-nocgi-pos spell)
            (snap-cgi-decode (match-string snap-cgi-pos spell)))
    (list spell)))

(defun snap-cgi-decode (cgi)
  ;; (snap-cgi-decode "a=1&b=c&d&e=&f")
  ;; => '(("a" "1") ("b" "c&d") ("e" "&f"))
  (let* ((f-regexp (snap-cgi-encode "\\([a-z]\\)" "\\(.*\\)"))
         (s-regexp (concat "^\\(.*\\)" snap-cgi-separator f-regexp))
         ;; using longest-match of the first part.
         (rest cgi)
         (olist '()))
    (while (string-match s-regexp rest)
      (setq olist (cons (list (match-string 2 rest) (match-string 3 rest)) olist))
      (setq rest (match-string 1 rest)))
    (if (string-match f-regexp rest)
        (setq olist (cons (list (match-string 1 rest) (match-string 2 rest)) olist))
      (message "unknown error"))
    olist))

(defun snap-repair-string (snap)
  (let* ((x (snap-decode snap))
         (mode (car x))
         (spell (cadr x)))
    (let ((repairer (snap-op 'repair mode)))
      (snap-encode mode (funcall repairer spell)))))

(defun snap-encode (mode spell &optional cgi-list)
  (when cgi-list
    (setq spell
          (format snap-spell-format
                  spell
                  (mapconcat #'identity cgi-list
                             snap-cgi-separator))))
  (format snap-format mode spell))

(defun snap-spell-encode (spell cgi)
  (format snap-spell-format spell cgi))

(defun snap-cgi-encode (op str)
  (format snap-cgi-format op str))

(defun snap-decode (snap &optional cgi-p)
  (when (not (string-match snap-regexp snap))
    (error "Wrong snapshot format: %s" snap))
  (let ((mode (match-string-no-properties snap-mode-pos snap))
        (spell (match-string-no-properties snap-spell-pos snap)))
    (if cgi-p
        (cons mode (snap-spell-decode spell))
      (list mode spell))))

(defun snap-op (op mode &optional no-err)
  (let ((f (intern-soft (format "snap-%s:%s" op mode))))
    (cond ((functionp f) f)
          (no-err nil)
          (t (error "%s is not supported." mode)))))

;;; for thing-at-point
(defun forward-snap (arg)
  (interactive "p")
  (if (natnump arg)
      (re-search-forward snap-regexp nil 'move arg)
    (progn
      (skip-chars-forward "^ \t\r\n")
      (while (< arg 0)
        (if (re-search-backward snap-regexp nil 'move)
            (skip-chars-backward "^ \t\r\n"))
        (setq arg (1+ arg))))))

;;; You need your own 'my-snap-search-mail'
;;; which receives message-id and returns its file name.
(defun snap-search-mail (message-id)
  (message "Searching...")
  (or (my-snap-search-mail message-id)
      (error "Not found: %s" message-id)))

(defun snap-line-number ()
  (let ((raw (count-lines (point-min) (point))))
    ;; see (describe-function 'count-lines)
    (if (bolp)
        (+ raw 1)
      raw)))

;;; check
(let ((snap-abbrev '(("l" "dired-mode" "usr/meadow/1.15/lisp/")
                     ("s" "shell-mode" "~/#")))
      (qa '(("snap://l/file" "snap://dired-mode/usr/meadow/1.15/lisp/file")
            ("snap://s/dir" "snap://shell-mode/~/#dir"))))
  (mapcar (lambda (z)
            (apply (lambda (short long)
                     (if (and (string= short (snap-shrink-string long))
                              (string= (snap-expand-string short) long))
                         t
                       (error "incorrect snap-abbrev: %s %s" short long)))
                   z))
          qa))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; applications

;;; <Application>
;;; <Sample>

;;; (Default)
;;; snap:///~/elisp/snap.el#177:(defun snap-record: ()

(defvar snap-record-default-format "%s#%s:%s")
                                        ;see also `snap-record:occur-mode'
(defun snap-record: ()
  (let ((raw-path (buffer-file-name)))
    (if (null raw-path)
        nil
      (let* ((line (snap-line-number))
             (text (save-excursion
                     (beginning-of-line)
                     (looking-at "^[ \t]*\\(.*\\)")
                     (match-string-no-properties 1)))
             ;; not snap:////etc but snap:///etc
             (relative-path (file-relative-name raw-path snap-root-dir))
             ;; not snap:///home/foo but snap:///~foo
             (abbrev-path (abbreviate-file-name raw-path))
             ;; use shorter one
             (path (if (< (length relative-path) (length abbrev-path))
                       relative-path
                     abbrev-path)))
        (format snap-record-default-format path line text)))))

(defun snap-play: (spell)
  (cond
   ((or (null spell) (string= spell ""))
    (message "snap-version %s" snap-version))
   ((string-match "\\([^#\r\n]+\\)\\(#\\([0-9]+\\):\\(.*\\)\\)?" spell)
    (let ((path (match-string-no-properties 1 spell))
          (positionp (match-string-no-properties 2 spell))
          (line (match-string-no-properties 3 spell))
          (text (match-string-no-properties 4 spell)))
      (find-file (expand-file-name path snap-root-dir))
      (when positionp
        (snap-play-search: (concat "^[ \t]*" (regexp-quote text) "$")
                           (string-to-number line)))))
   (t
    (error "not supported: %s" spell))))

(defun snap-play-search: (regexp line-number)
  (goto-line line-number)
  (cond ((looking-at regexp) t)
        ((snap-occur-p regexp) (snap-occur regexp line-number))
        (t (message "No match."))))

(defun snap-occur-p (regexp)
  (save-excursion
    (goto-char (point-min))
    (re-search-forward regexp nil t)))

(defun snap-occur (regexp line-number)
  (occur regexp 0)
  (switch-to-buffer "*Occur*") ;; why needed??
  (let ((hits (snap-looking-at-number)))
    (forward-line)
    (if (= hits 1)
        (snap-occur-goto-occurence)
      (snap-occur-goto-line line-number))))

(defun snap-occur-goto-occurence ()
  (message "Line number is obsolete.")
  (occur-mode-goto-occurrence)
  ;; I prefer bol.
  (beginning-of-line))

(defun snap-occur-goto-line (line-number)
  (while (let* ((n (snap-looking-at-number))
                (stop (and n (>= n line-number))))
           (and (not stop)
                (= (forward-line) 0)))
    ;; nothing to do
    nil)
  (if (not (snap-looking-at-number))
      (forward-line -1)))

(defun snap-looking-at-number ()
  (and (looking-at "[ \t]*\\([0-9]+\\)")
       (string-to-number (match-string-no-properties 1))))

;;; Wanderlust
;;; snap://wl-summary-mode/+ME/hira/<20031101192305.AFA8C43EDC@hoge.fuga.piyo>

(defun snap-record:wl-summary-mode ()
  (let ((n (wl-summary-message-number)))
    (and (numberp n)
         (let* ((folder wl-summary-buffer-elmo-folder)
                (fld-name (elmo-folder-name-internal folder))
                (id (elmo-message-field folder n 'message-id)))
           (snap-encode:wl-summary-mode fld-name id)))))

(defun snap-play:wl-summary-mode (spell)
  (let ((prefix-arg 4))
    (wl prefix-arg)) ;; skip folder checking
  (let* ((state (snap-decode:wl-summary-mode spell))
         (fld-name (car state))
         (id (cadr state))
         (summary-buf (wl-summary-get-buffer-create fld-name)))
    (wl-summary-goto-folder-subr fld-name
                                 (wl-summary-get-sync-range
                                  (wl-folder-get-elmo-folder fld-name))
                                 nil nil t)
    (wl-summary-jump-to-msg-by-message-id id)
    (wl-summary-redisplay)))

(defun snap-repair:wl-summary-mode (spell)
  (let* ((state (snap-decode:wl-summary-mode spell))
         (id (cadr state))
         (found-file (snap-search-mail id))
         (folder (snap:wl-file-folder found-file)))
    (when (null folder)
      (error "No folder for %s" found-file))
    (snap-encode:wl-summary-mode folder id)))

(defun snap-encode:wl-summary-mode (folder-name message-id)
  (concat folder-name "/" message-id))

(defun snap-decode:wl-summary-mode (spell)
  (and (string-match "\\(.*\\)/\\([^/]*\\)" spell)
       (let ((fld-name (match-string-no-properties 1 spell))
             (id (match-string-no-properties 2 spell)))
         (list fld-name id))))

(defun snap:wl-file-folder (file)
  (setq file (file-truename file))
  (let ((buf (current-buffer)))
    (wl 4)
    (goto-char (point-min))
    (wl-folder-open-all)
    (prog1
        (catch 'found
          (while (not (eobp))
            (let* ((name (wl-folder-get-entity-from-buffer))
                   (folder (wl-folder-search-entity-by-name
                            name
                            wl-folder-entity 'folder))
                   (ef (and folder (wl-folder-get-elmo-folder folder)))
                   (dir (and ef
                             (eq (elmo-folder-type-internal ef) 'localdir)
                             (elmo-localdir-folder-directory-internal ef))))
              (when (and dir
                         (string-match (format "^%s"
                                               (regexp-quote
                                                (file-truename dir)))
                                       file))
                (throw 'found name))
              (forward-line)))
          nil)
      (switch-to-buffer buf))))

;;; Help
;;; snap://help-mode/f/find-file

(defun snap-record:help-mode ()
  (let ((function (car help-xref-stack-item))
        (variable (car (cdr help-xref-stack-item))))
    (cond
     ((equal function 'describe-function) (format "f/%s" variable))
     ((equal function 'describe-variable) (format "v/%s" variable))
     (help-xref-stack-item help-xref-stack-item)
     (t ""))))

(defun snap-play:help-mode (spell)
  (if (string-match "\\([^/\n \t]+\\)/\\(.+\\)" spell)
      (let ((function (match-string 1 spell))
            (variable (match-string 2 spell)))
        (cond
         ((or (string-match "^f.*" function)
              (string-match "descrive-function" function))
          (describe-function (intern variable)))
         ((or (string-match "^v.*" function)
              (string-match "descrive-variable" function))
          (describe-variable (intern variable)))
         (t
          (message "Not support this method %s" spell))))
    (message "I can't all %s" spell)))

;;; Bookmark
;;; snap://bookmark-bmenu-mode/kuzu

(defun snap-record:bookmark-bmenu-mode ()
  (bookmark-bmenu-bookmark))

(defun snap-play:bookmark-bmenu-mode (spell)
  (if (equal spell "")
      (progn
        (bookmark-bmenu-list)
        (switch-to-buffer "*Bookmark List*"))
    (bookmark-jump spell)))

;;; Man
;;; snap://Man-mode/printf/3

(defvar snap-man-spacer "/")

(defun snap-record:Man-mode ()
  (let ((buf (buffer-name)))
    (cond
     ((string-match "^[*]Man[ \t]+\\([^ \t]+\\)[ \t]+\\([^ \t]+\\)[*]" buf)
      (concat (match-string 2 buf) snap-man-spacer (match-string 1 buf)))
     ((string-match "^[*]Man[ \t]+\\([^ \t]+\\)[*]" buf)
      (concat (match-string 1 buf)))
     (t
      (error "not support buffer-name of man-mode: %s" buf)))))

(defun snap-play:Man-mode (spell)
  (let* ((strs (split-string spell (regexp-quote snap-man-spacer)))
         (str-com (car strs))
         (str-sec (mapconcat 'concat (cdr strs) snap-man-spacer)))
    (if (equal str-sec "")
        (man (concat str-com))
      (man (concat  str-com "(" str-sec ")")))))

;;; Info
;;; snap://Info-mode/cvs#Tracking sources

(defvar snap-info-spacer "#")

(defun snap-record:Info-mode ()
  (let ((str-file (if Info-current-file
                      (file-name-nondirectory Info-current-file)
                    ""))
        (str-node (or Info-current-node "")))
    (concat str-file snap-info-spacer str-node)))

(defun snap-play:Info-mode (spell)
  (require 'info)
  (let* ((strs (split-string spell (regexp-quote snap-info-spacer)))
         (str-file (or (car strs) "dir"))
         (str-node (mapconcat 'concat (cdr strs) snap-info-spacer)))
    (Info-goto-node (concat "(" str-file ")" str-node))))

;;; Emacs-wiki
;;; snap://emacs-wiki-mode/WelcomePage#title

(defun snap-record:emacs-wiki-mode ()
  (let ((raw-path (buffer-file-name)))
    (if (null raw-path)
        nil
      (format "%s" (file-name-nondirectory raw-path)))))

(defun snap-play:emacs-wiki-mode (spell)
  (require 'emacs-wiki)
  (emacs-wiki-visit-link spell))

;;; Navi2ch
;;; snap://navi2ch-article-mode/pc5.2ch.net/test/read.cgi/tech/1068351911/100-200
;;; snap://navi2ch-article-mode/http://pc5.2ch.net/test/read.cgi/tech/1068351911/150

(defvar snap-navi2ch-set-offline t)

(defun snap-record:navi2ch-article-mode ()
  (save-match-data
    (let* ((n (navi2ch-article-get-current-number))
           (s (navi2ch-article-to-url navi2ch-article-current-board
                                      navi2ch-article-current-article
                                      n n t)))
      (when (string-match "^http://" s)
        (setq s (substring s (match-end 0))))
      s)))

(defun snap-play:navi2ch-article-mode (spell)
  (require 'navi2ch)
  (when snap-navi2ch-set-offline
    (setq navi2ch-offline t))
  (navi2ch-goto-url (if (string-match "^http://" spell)
                        spell
                      (concat "http://" spell))))

;;; w3m
;;; snap://w3m-mode/http://www

(defun snap-record:w3m-mode ()
  w3m-current-url)

(defun snap-play:w3m-mode (spell)
  (w3m spell))

;;; Dired
;;; snap://dired-mode/~/

(defun snap-record:dired-mode ()
  dired-directory)

(defun snap-play:dired-mode (spell)
  (find-file spell))

;;; BBDB
;;; snap://bbdb-mode/name

(defun snap-play:bbdb-mode (spell)
  (if (featurep 'bbdb-com)
      (bbdb spell nil)
    (message "bbdb is not loaded")))

(defun snap-record:bbdb-mode ()
  (let ((bbdb-record (bbdb-current-record)))
    (car (bbdb-record-net bbdb-record))))

;;; Bibtex
;;; snap://bibtex-mode/file#bibtex-key

(defvar snap-bibtex-spacer "#")
(defun snap-play:bibtex-mode (spell)
  (if (string-match "^\\(.*\\)#\\(.*\\)$" spell)
      (let ((k (match-string 2 spell)))
        (find-file (match-string 1 spell))
        (and k
             (not (snap-bibtex-search k))
             (message "No such bibtex-key \"%s\"" k)))
    (find-file spell)))
(defun snap-bibtex-search (k)
  (let ((regexp (concat "^@.*" k)))
    (goto-char (point-max))
    (while (and (re-search-backward regexp nil t)
                (not (string= k (snap-bibtex-key)))))
    (string= k (snap-bibtex-key))))
(defun snap-bibtex-key ()
  (save-excursion                       ;c.f. `bibtex-clean-entry'
    (let ((case-fold-search t)
          (eob (bibtex-end-of-entry)))
      (bibtex-beginning-of-entry)
      (if (re-search-forward
           bibtex-reference-head eob t)
          (buffer-substring-no-properties
           (match-beginning bibtex-key-in-head)
           (match-end bibtex-key-in-head))))))
(defun snap-record:bibtex-mode ()
  (let ((f (snap-record:))
        (k (snap-bibtex-key)))
    (if k
        (concat f snap-bibtex-spacer k)
      f)))

;;; Shell
;;; snap://shell-mode/~/#pwd

;;; ToDo directory with # is not allowed!

(defvar snap-shell-spacer "#")
(defvar snap-shell-buffer-name "*shell*snap*")

(defun snap-record:shell-mode ()
  "record now directory and a command now inputed"
  (let ((pm (process-mark (get-buffer-process (current-buffer))))
        (p (point)))
    ;; c.f. comint-kill-input
    (concat default-directory
            (if (> p (marker-position pm))
                (concat snap-shell-spacer (buffer-substring-no-properties pm p))))))
(defun snap-play:shell-mode (spell)
  "1. start shell-mode for snap 2.  insert a command (without
execution)"
  (string-match "\\([^#\r\n]+\\)#?\\(.*\\)" spell)
  (let ((default-directory (match-string-no-properties 1 spell))
        (c (or (match-string-no-properties 2 spell) ""))
        nn no)
    (if (not (comint-check-proc "*shell*"))
        (shell)
      ;;duplicate shell
      (set-buffer "*shell*")
      (setq no (rename-buffer "*shell*" t))
      (shell)
      (setq nn (rename-buffer snap-shell-buffer-name t))
      (set-buffer no)
      (rename-buffer "*shell*" t)
      (set-buffer nn)
      )
    (insert c)))

;;; Occur
;;; snap://occur-mode/dired-mode/~/??q=drwx??g=2
;;; by using "snap://MAJOR-MODE/SPELL??q=word"

(defvar snap-occur-cgi-string "q")
(defun snap-record:occur-mode ()
  (let* ((b occur-buffer)
         (s (car occur-command-arguments))
         (snap-record-cgi nil)
         (snap-record-default-format "%s")
         (x (snap-decode (save-excursion (set-buffer b) (snap-record-string))))
         (mode (car x))
         (spell (cadr x))
         (snap (snap-encode mode (snap-spell-encode spell (snap-cgi-encode snap-occur-cgi-string s)))))
    (if (string-match (concat "^" snap-prt) snap)
        (substring snap (match-end 0))
      snap)))

(defun snap-play:occur-mode (spell)
  (save-window-excursion
    (snap-play-string (concat snap-prt spell)))
  (if (get-buffer "*Occur*")
      (switch-to-buffer "*Occur*")
    (message "maybe failed to match")))

;;; Howm
;;; snap://howm-view-summary-mode/word
;;; snap://howm-view-contents-mode/word
                                        ; checked on howm-test-050518

(defun snap-record:howm-view-summary-mode ()
  (howm-view-name))
(defun snap-record:howm-view-contents-mode ()
  (howm-view-name))
(defun snap-play:howm-view-summary-mode (spell)
  ;; completion-p is always nil in my case.
  (message "howm searching %s ..." spell)
  ;; message is needed because howm-search needs long time.
  (howm-search spell nil))
(defun snap-play:howm-view-contents-mode (spell)
  (message "howm searching %s ..." spell)
  (howm-search spell nil))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; cgi extension
;;;
;;; Examples:
;;;|goto-line       |snap:///file??g=110
;;;|search&move str |snap:///file??s=str
;;;|occur str       |snap:///file??q=str
;;;|dired-x (file)  |snap:///??x=file
;;;|dired-x (buffer)|snap:///??x=
;;;|open & dired-x  |snap:///file??x=
;;;|open &dired-x   |snap:///dir??x=file
;;;|find & dired-x  |snap:///dir??s=str&x=
;;;|move & dired-x  |snap:///dir??g=10&x=
;;;
;;; ToDo: find and compilation

(defun snap-play-dired-x (file)
  ""
  (let ((dir (or (file-name-directory file) default-directory))
        (filename (file-name-nondirectory file))
        (font-lock-global-modes nil))
    (save-excursion
      (find-file dir)
      (goto-char (point-min))
      (search-forward-regexp (concat "[ ]" (regexp-quote filename) "$") nil)
      (call-interactively 'dired-do-shell-command)
      (bury-buffer))))

(defun snap-play::x (spell &optional snap)
  "snap-record cgi extension for execute"
  (if (or (null spell) (string= "" spell))
      (cond
       (buffer-file-name
        (snap-play-dired-x buffer-file-name))
       ((eq major-mode 'dired-mode)
        (call-interactively 'dired-do-shell-command))
       (t
        (message "error")))
    (cond
     ((or (file-exists-p spell) (eq major-mode 'dired-mode))
      (snap-play-dired-x spell))
     (buffer-file-name
      (snap-play-dired-x buffer-file-name))
     (t
      (message "error")))))
(defun snap-record::g ()
  "snap-record cgi extension for goto-line"
  (number-to-string (snap-line-number)))
(defun snap-play::g (spell &optional snap)
  "snap-record cgi extension for goto-line"
  (goto-line (string-to-number spell)))
(defun snap-record:: ()
  "snap-record cgi extension for default tag"
  (number-to-string (snap-line-number)))
(defun snap-play:: (spell &optional snap)
  "snap-record cgi extension for default tag"
  (goto-line (string-to-number spell)))
(defun snap-record::s ()
  "snap-record cgi extension for search return the string of
kill-ring. (not work. help) "
  (cond
   ;;  ((eq last-command 'kill-ring-save)
   ;;    (remove-text-properties (current-kill 0))
   ;;    )
   (t
    (save-excursion
      (beginning-of-line)
      (looking-at "^[ \t]*\\(.*\\)")
      (match-string-no-properties 1)))))
(defun snap-play::s (spell &optional snap)
  "snap-play cgi extension for search around point"
  (or (search-forward spell nil t)
      (progn (goto-char (point-max))
             (search-backward spell nil t))
      (message "Failed search")))
(defun snap-record::q ()
  "snap-record cgi extension for search

return 1. the string of kill-ring.  (not yet)

2. the word at cursor."
  (cond
   ;;   ((eq last-command 'kill-ring-save)
   ;;    (remove-text-properties (current-kill 0))
   ;;    )
   ((provide 'thingatpt)
    (or (thing-at-point 'word) (thing-at-point 'symbol)))
   (t
    nil)))

(defun snap-play::q (spell &optional snap)
  "snap-play cgi extension for occur"
  (occur spell))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; with action-lock.el
;;; (in howm: <http://howm.sourceforge.jp/>)

(defun snap-action-lock (regexp arg-pos &optional hilit-pos)
  (action-lock-general #'(lambda (f u)
                           (call-interactively 'snap-play))
                       regexp arg-pos hilit-pos t))

(eval-after-load "action-lock"
  '(let ((snap-action-lock-rules (list (snap-action-lock snap-regexp 0))))
     (setq action-lock-default-rules
           (append snap-action-lock-rules action-lock-default-rules))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; provide

(provide 'snap)

;;; snap.el ends here.