top  Index  Search  Changes  RSS  Login

howm wiki - SnapDotEl.050519 Diff

  • Added parts are displayed like this.
  • Deleted parts are displayed like this.

→ [[SnapDotEl]]
----

;;; 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.17 2005/05/18 15:40:41 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-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.17 2005/05/18 15:40:41 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 ()
   (snap-shrink-string (snap-record-string-exact)))
(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."
   (let* ((mode major-mode)
          (recorder (or (snap-op 'record mode t)
                        (progn (setq mode "") (snap-op 'record mode))))
          (spell (or (funcall recorder)
                     (error "%s is not supported." major-mode)))
          (cgi-list (delq nil (mapcar #'snap-record-cgi snap-record-cgi))))
     (snap-encode mode spell cgi-list)))

(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)))
     (when (null raw-path)
       (error "This buffer is not supported."))
     (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.

----
コメントは[[SnapDotEl]]へ
----