複数の機能を一つにまとめてしまう lisp

emacs の anything とは動作が多分(かなりかも;))違ます。

  (require :anything/anything)
  (require :anything/sources)
  (require :anything/menu)

anything/sources

anything/menu なんて飾りです。

 M-x anything

インクリメンタルに候補を絞り、カテゴリで実行したい動作が変わります。

色

 (setq *anything-select-color*
   '(:foreground 0 :background 14 :bold t))
 (setq *anything-sources-name-color*
   '(:color 0 15 :bold :line))

横に表示

 ;; with-output-to-temp-buffer の説明を参考にして下さい
 (setq *anything-buffer-popup* t)
 (setq *anything-buffer-vert* t)

バッファタブを消す

 (setq *anything-buffer* " *anything*")

フレーム はいらない

 (setq *anything-use-frame* nil)

anything の開始時と終了時に実行する場合

 *anything-open-hook*
 *anything-close-hook*

migemo がインストールされていれば絞りこみに migemo を使います。

 (setq *anything-migemo-on* t)

migemo で絞り込む type 数

 (setq *anything-migemo-length* 4)

sources を追加していくことで拡張できます。

 :name string

表示するための名前 カテゴリ

 :type attribute

属性を指定

 :candidates function

リストを返す関数

 :action function arg

引数を一つ取る関数

 :init init

初期値

 :move-action function

移動した時に呼ばれる関数

 :visible-mode buffer-mode , list

表示したいモード(モードのリスト)

 :type source type

ソースでしている属性を指定

 :display string

表示するための名前

 :action function

引数を一つ取る関数

 :default variable

RET の場合実行される関数

通常の anything とは別に sources を作り呼び出せます。

 name

name-anything という関数が生成されます。

 body sources attribute ...

name-anything で使う source と attribute

1. 括弧好きな人が拡張を公開してくれるのを待つ
2. multi-line
3. process 用の関数の提供

odoc おれおれドキュメント Publisher テキストを html に置き換える xyzzy lisp です。 日付でメモを取っていくと日記ツールにもなるかと思います。

site-lisp に odoc 以下を放り込む。 .xyzzy siteinit.l に

  (require "odoc")

 [foo] RET で新しく foo.od を作成します。
 [index] RET で編集中のディレクトリの ~.od を集めてきて表示

書式は以下

  ^=..       h
  ^-..       ol (space2 つで入れ子)
  ^*..       ul (space2 つで入れ子)
  ^|..|      table
  ^ ..       pre
  ^..        p  (閉じる時は空行にする)
  ^----      hr
  ^:. :.     dl
  ^>..       blockquote
  http://    absolute link
  [http://..|name] absolute link
  [name]     relative link
  [img|x,y|path|alt]    img link
   \[fug] \http:// はエスケープ

ol,ul,table,pre,p,dl,blockquote の書式に従って書いた始めの行に $...$ , %...% を指定しておくと要素を <div> で囲み、 囲まれた文字は class と id 名になります。

class は $foo$ => <div class="foo"> 二行目 ..</div>

id は %bar% => <div id="bar"> 二行目 ..</div>

(注) 囲まれた文字以降は無視されます。エスケープは \%~% ,\$~$ です。

入れ子にすることはできますが、階層をとばすとタグをきちっと閉じられない バグがあるので気をつけて下さい。

publish 用設定ファイル odoc/.odocrc に好みの設定を書く、もしくは編集して いるディレクトリに .odocrc を作ればそれを読み込みます。

#

comment line

%site_title

Site タイトル名

%site_sub

Site の簡単な説明

%header

html の head 内を記述しておく

%encode

エンコードを xyzzy の定数を使って指定 例 *encoding-utf8n*

%footer

フッター

%date

フッターに表示する日付

%macro

置換文字 TAB で区切る

%regex

正規表現置換 TAB で区切る

%author

著者

%host

http://ホスト名 (Feed を吐き出す場合に使います)

%mail

メールアドレス your_address@example.com

%menu

Publish した HTML に menu{toc,recent,..}

%menu plugins

menu の recent 以下に追加するもの

が設定できます。

• odoc-publish で html index.html recent.html atom rss 作成
• odoc-inedx で現在の作業ディレクトリの ~.od を集めて来ます。
• odoc-mode ~.od を色分け
• odoc-config-mode .odocrc を色分け

publish 後に html+-mode でインデントしてもらう場合 .xyzzy 等に

 (add-hook '*odoc-publish-hook*
          #'(lambda()
              (indent-region(point-min)(point-max))))

~/odoc/.odoc-mode の始めに(in-package :odoc-mode)を追加して lisp を書いていく必要があります。 add-toggle-switch,add-action,add-action-list

任意の文字列二文字以上で {*} => {-} => { } 等を RET で変更する。 追加したい場合の例

 (add-toggle-switch 
     '(("}?""}+""}*")
      ("[+    ]""[++   ]""[+++  ]""[++++ ]" "[+++++]")))

任意の正規表現上で RET すると関数を呼び出して実行します。

 ; 一つずつ追加する場合
 (add-action regex function &optional delete goto)
 ; まとめて追加する場合
 (add-action-list '((regex func)
                    (regex2 func2 1 1)))

日記風につけたい場合は、.xyzzy 等に

 (defun diary()
  (interactive)
  (find-file(merge-pathnames
             (concat (format-date-string "%Y-%m-%d") "." *odoc-extension*)
             "~/oDiary")))
 M-x diary

turtle.l で地味にグラフ表示してみる(*scrath* でテスト), spreadsheet-mode で使えると嬉しいかも

    (require "wip/turtle")
    (defun pole-graph(&rest rest)
      (let*((min (apply #'min rest))
            (max (apply #'max rest))
            (total (apply #'+ rest))
            (width win-user::*turtle-window-width*)
            (height win-user::*turtle-window-height*)
            (win-hi (* (-(- min max))))
            (digit(do((x 1 (* x 10)))((>= x win-hi)(/ x 1000))))
            (i 0) (ii ()))
        (setq win-user::*turtle-window-width* (+ 30(* 30 (length rest))))
        (setq win-user::*turtle-window-height* (/ win-hi digit 2)) ;
        (win-user::with-turtle-paint
          (win-user::turtle-right 90)
            (dolist (a rest)
              (setq ii (* 25 (incf i)))
              (dotimes (b (/ (if (plusp a) a (* (- a)))
                             (* digit 10))) ;
                (win-user::turtle-setpos ii (if(plusp a)
                                                (- (/ win-user::*turtle-window-height* 2) b)
                                              (+ (/ win-user::*turtle-window-height* 2) b)))
                (win-user::turtle-lineto 20))
              ))
          (setq win-user::*turtle-window-width* width)
          (setq win-user::*turtle-window-height* height)
    (format t "min:~15T~D~%max:~15T~D~%average:~15T~D~%total:~15T~D~%"
            min max (round (/ total (length rest))) total)
        ))
    (pole-graph 10 20 30 20 50 100 5)
    =>min:           5
    =>max:           100
    =>average:       34
    =>total:         235
    =>nil

    (defun circle-graph(&rest rest)
      (let((total (apply #'+ rest))
           (p 360)(x 50)(y 200)
           percent result radius)
        (setq radius (/ p pi));?2
        (dolist (x rest (setq percent (nreverse percent)))
          (push (* (/ x total) p) percent)
          (push (list x (floor (* (/ x total) 100))) result))
        (win-user::with-turtle-paint
          (win-user::turtle-setpos x y)
          ;circle
          (dotimes (a p)
            (win-user::turtle-right 1)
            (win-user::turtle-lineto 2))
          ;base line
          (win-user::turtle-setpos (+ x radius) y)
          (win-user::turtle-lineto radius)
          ;
          (dolist (b percent)
            (win-user::turtle-right b)
            (win-user::turtle-setpos (+ x radius) y)
            (win-user::turtle-lineto radius))
          (format t "~{~{~D~5T:~10T~A%~}~%~}" (nreverse result))
          )))
    (circle-graph 31 3 6 8 9 45 8 32 43 35)
    =>31   :    14%
    =>3    :    1%
    =>6    :    2%
    =>8    :    3%
    =>9    :    4%
    =>45   :    20%
    =>8    :    3%
    =>32   :    14%
    =>43   :    19%
    =>35   :    15%
    =>nil

DOM 全部実装ってのはあんまり意味ないと思ったので get.. だけにしたけど、 最低半分は実装しないと使い勝手が悪そうだな~ かといって何か使い道があるか といゆうと疑問

使い方は

 (setq g(parse "e:/test/test.html"))
 => #<hashtable 51908756>
 (value g)
 => .......
 
 (setq m(get-elements-by-class-name gg "menu"))
 => #<hashtable 51910572>
 (value m)
 => .............
 

コード

 (defvar *parse-cache* ())
 (defun parse(file)
   (let((i 0)(n -1)(ln)(cache)(hash))
    (if(setq cache(assoc file *parse-cache* :test 'equal))
        (return-from parse (cdr cache)))
    (setq hash (make-hash-table))
    (with-open-file(f file)
      (while(setq ln (read-line f nil nil nil))
        (when ln
          (setq ln (split-string ln #\>))
          (dolist (x ln)
            (if(string-match "<" x)
                (setf(gethash (incf n) hash)(concat x ">"))
              (setf(gethash (incf n) hash) x))))))
    (pushnew  (cons file hash) *parse-cache*
              :test 'equal :key 'cdr)
    hash
    ))
 
 (defun dom-scanner(document regex &optional once)
   (let((i 0)(ct 0)(n -1)(nn -1)(tag)(hash)(rhash))
    (setq hash (make-hash-table))
    (setq rhash (make-hash-table))
    (dotimes (c (hash-table-count document))
      (let((s (gethash c document)))
        (cond
         ((string-match regex s)
          (and (= i 0)
               (setq tag (car(split-string(match-string 2) #\SPC))))
          (setf (gethash (incf n) hash) (match-string 1))
          (setq i 1)
          (cond
           ((string-match (concat ".*</" tag ">") s)
            (setq i 0))
           ((string-match (concat "<" tag ".*>") s)
            (incf ct)))
          )
         ((and(< 0 ct)
              (string-match (concat "\\(.*</" tag ">\\)") s))
          (setf (gethash(incf n) hash)(match-string 1))
          (decf ct)
          (if(zerop ct)(setq i 0))
          (when(zerop ct)
            (setf (gethash (incf nn) rhash)hash)
            (setq hash(make-hash-table))
            (setq n -1))
          (if once (return-from dom-scanner rhash))
          )
         ((= i 1)
          (and(string-match(concat "<" tag ".*>") s)
              (incf ct))
          (setf (gethash (incf n) hash) s)
          )
         (t ()))))
    rhash))
 
 (setq get-tag-regex-list '("\\(<\\("
                           "[^<>/]+?"
                           "\\)[^<>]*?"
                           ">.*\\)"))
 
 (defmacro get-document(document &optional once &rest arg)
   `(dom-scanner
    ,document
    (concat (nth 0 get-tag-regex-list)
            (if (< 1 (length(list ,@arg)))
                (nth 1 get-tag-regex-list))
            ,@arg
            (nth 2 get-tag-regex-list)
            (nth 3 get-tag-regex-list)
            )
    ,once
    ))
 
 (defmacro get-value(dom)
   (let((g (gensym)))
    `(let((g))
       (maphash
        #'(lambda(a b)
            (setq g (concat g(string b))))
        (if(hash-table-p(gethash 0 ,dom))
            (gethash 0 ,dom)
          ,dom))
       g)))
 
 ;; ここから使う関数
 (defun get-element-by-id(document id)
   (get-document document t " id=\"" id "\""))
 
 (defun get-elements-by-name(document id)
   (get-document document t " name=\"" name "\""))
 
 (defun get-elements-by-tag-name(document tag)
   (get-document document nil tag ))
 
 (defun get-elements-by-class-name(document class)
   (get-document document nil " class=\"" class "\""))
 
 (defun get-attribute(dom name)
   (string-match(concat "\\([^ ]+?\\)=" name) (gethash 0 dom))
   (match-string 1))
 
 (defun get-attribute-node(dom node)
   (string-match(concat node "= *\"\\([^ ]+?\\)\"") (gethash 0 dom))
   (match-string 1))
 
 (defun value(dom)
   (get-value dom))
 
 (defun title(dom)
   (get-value (dom-scanner dom "\\(<\\(title\\).*?>\\)" t)))
 

HTML を編集しているバッファの HTML を解析して､ CSS を吐き出します。 ネストしたやつも多分大丈夫だと思います。 CSS のことよく解ってないのでこれでいいのか解りませんが ^^)

    (defun get-elemement-init(regex)
      (let(result tmp tag p1 p2 st)
        (save-excursion
          (goto-char(point-min))
          (scan-buffer "<body.*>" :regexp t :case-fold t :tail t)
          (while
              (scan-buffer (concat "<\\("
                                   regex
                                   "[^<>]*?\\)>" )
                           :regexp t :no-dup t)
            (when
                (not(member
                     (car(split-string (match-string 1) #\SPC))
                     ; exclusion
                     '("head" "title" "area" "hr" "br" "frame" "frameset"
                       "map" "noframes" "noscript" "optgroup" "option" "param"
                       "script" "style" "tbody" "tfoot" "thead")
                     :test #'(lambda(a b)(string= b a))))
              (setq tag (car(split-string(match-string 1) #\SPC)))
              (message "Study Tag Name: <~A>."(string-upcase tag))
              (setq tmp nil)
              (push (match-string 0) tmp)
              (setq p1 (point))
              (scan-buffer (concat "<\\(/" tag "\\)>")
                           :regexp t :no-dup t :tail t)
              (setq p2 (point))
              (goto-char p1)
              ;この処理が重い
              (while(forward-char 1)
                (and(<= p2 (point))(return))
                (if(looking-at "<\\([^\/!<>]+?\\)>")
                    (push (match-string 0) tmp)))
              (push (remove-duplicates (nreverse tmp) :test 'string-equal) result)
              (goto-char p1))))
        (nreverse result)))
    
    (defun css-generator()
      (interactive)
      (let*((l  (get-elemement-init "[^\/!<>]+") ))
        (with-output-to-temp-buffer("CSS")
          (format t "/*-*- mode:css -*-*/~%~{/* */~%~{~A~^ ~}{~%}~2%~}"
                  (mapcar
                   #'(lambda(b)
                       (mapcar
                        #'(lambda(a)
                            (concat
                             (substitute-string a "^<\\([^ ]+\\).*>" "\\1")
                             (if (string-matchp  "class" a)
                                 (substitute-string
                                  a "^<.+class *= *\"\\([^ ]+\\)\".*>" ".\\1"))
                             (if (string-matchp "id" a)
                                 (substitute-string
                                  a "^<.+id *= *\"\\([^ ]+\\)\".*>" "#\\1"))))
                        b)
                       )
                   (remove-duplicates
                    (append (mapcar #'(lambda(x)(list(car x))) l) l)
                    :test 'equal)
                   )))))

iswitchb の場合、目線が minibaffer にいくので目線はそのままでバッファの表示量を増やし *do-completion を利用してかっちり補完移動と曖昧補完移動。(↑↓→← C-f C-b C-p C-n でも移動) きっちりモードに仕上げるのがいいと思ったけど、長くなるので個人的に使うのでここまでにした。

    (defun list/n(list n)
      (unless(atom list)
        (let ((i (if(< n (length list)) n (length list))))
          (cons(subseq list 0 i)
               (list/n (subseq list i nil)n)))))
    
    (defun miswitchb-color(search)
      (let((from (progn(scan-buffer search)(point))))
        (save-excursion
          (set-text-attribute from
                              (progn
                                (scan-buffer search :tail t)
                                (point))
                              'buf  :foreground 9 :bold t))))
    
    (defun miswitchb-switch(buf)
      (find-buffer buf)
      (delete-window)
      (switch-to-buffer buf))
    
    (defun vague-amiswitchb-list(str)
      (sort
       (remove-if #'(lambda (x)
                      (eq(char (buffer-name x) 0) #\SPC))
                  (let(r)
                    (dolist(x (remove-if
                               #'(lambda (x)
                                   (not (string-matchp(regexp-quote str)
                                                      (buffer-name x))))
                               (buffer-list))
                              r)
                      (push (buffer-name x) r))))
       #'string-lessp))
    
    (defun miswitchb(arg)
      (interactive "P")
      (and(get-ime-mode)
          (toggle-ime nil))
      (let((str "")
           (fmt " Completion Buffer~%~60,,,'-@A~%~{~{ ~20,@A ~}~%~}")
           (buf " *Buffer List Completion*")
           (i 0)
           ib c sym complete blst from to fbl ime)
        (and(get-ime-mode)
            (setq ime t)
            (toggle-ime nil))
        ;; 実行時にただ表示させるだけ
        (with-output-to-temp-buffer(buf)
          (multiple-value-bind(a b)
              (*do-completion str :buffer-name)
            (format t fmt ""
                    (list/n (setq fbl(sort
                                      (delete buf b :test 'equal)
                                      #'string-lessp)) 4))))
        (miswitchb-color(setq complete (car fbl)))
        (loop
          (minibuffer-message "Buffer: ~A" str)
          ;;RETで決定 複数の場合car
          (when(and(eq #\RET (setq c (read-char *keyboard*)))
                   ;; どうにかならんか
                   (if arg
                       (if (eq sym :no-match)
                         t
                       (if sym (stringp sym) t))
                     t))
            (miswitchb-switch complete)
            (and ime (toggle-ime ime))
            (return complete))
          (setq ib (1- (length blst)))
          (case c
            ((#\RET)
             (miswitchb-switch (car blst))
             (return (car blst)))
            ((#\C-g) (quit))
            ((#\C-h)
             (or(eq (length str) 0)
                (setq str (subseq str 0 (1- (length str))))))
            ((#\Left #\C-b)
             (if(< 0 i)(decf i)))
            ((#\Right #\C-f)
             (cond((= 0 i)
                   (setq i 1))
                  ((< i  ib)
                   (incf i))
                  (t (setq i 0))))
            ((#\Up #\C-p)
             (cond((<= 0 (- i 4)) (decf i 4))
                  ((< 0 i 4) (decf i))
                  (t (setq i ib))))
            ((#\Down #\C-n)
             (cond((< (- ib 4) i  ib)(incf i))
                  ((< ib i) (setq i 0))
                  ((< (+ i 3) ib)(incf i 4))
                  (t (setq i 0))))
            (t (setq i 0)
               (if(eq (lookup-key-command c) 'self-insert-command)
                   (setq str (concatenate 'string str (string c)))
                 t)))
          (message "~A" i)
          (with-output-to-temp-buffer(buf)
            (multiple-value-bind(a b)
                (*do-completion str :buffer-name)
              (format t fmt ""
                      (list/n (setq blst
                                    ;; 切り替え
                                    (if arg
                                        (sort (delete buf b :test 'equal)  #'string-lessp)
                                        (or (vague-amiswitchb-list str) fbl)
                                      ))
                              4))
              ;; 切り替え
              (and arg (setq sym a))
              (setq complete (nth i blst))
              ;書き換えた後の始めの位置
              (and blst (miswitchb-color (car blst)))
              ))
          (delete-text-attributes 'buf);前回の色を消す
          (and blst (miswitchb-color complete))
          (refresh-screen))
        ))
    
    

 ;; インタラクティブに xyzzy から javascript しようといゆうことで
 ;; shell-mode を少しいじっただけ
 ;;
 ;;  (require "js-shell")
 ;;  javascript-mode が必要です。
 ;;
 ;; パスを指定する
 ;;  rhino な場合
 ;;  (setq *js-shell-path* (merge-pathnames "rhino1_6R2/js.jar" "C:/usr/bin/"))
 ;;  InteractiveJS な場合 64 行目辺り
 ;;  (setq *js-shell-path* (merge-pathnames "imjs.js" "C:/usr/bin/")) imjsv3.js は手に入らないかも
 ;;  http://d.hatena.ne.jp/nak2k/ 辺り
 ;;
 ;; SpiderMonkey の js.exe はわからなかった
 ;;
 ;;
 ;; javascript-mode の keyword と abbrev-table *js-shell-mode-abbrev-table* を追加
 ;;
 ;;
 (provide "js-shell")
 
 (in-package "editor")
 
 (export '(*js-shell-mode-hook* *js-shell-prompt-regexp* *js-shell-mode-map*
           *js-shell-ret* *js-shell-echo* js-shell js-shell-send-input
           js-shell-send-interrupt js-shell-alternate-send-input
          js-execute-region))
 
 (defvar *js-shell-buffer* "*js-shell*" )
 (defvar *js-shell-path* nil)
 ;;;(setq *js-shell-path* (merge-pathnames "rhino1_6R2/js.jar" "C:/usr/bin/"))
 (defvar *js-shell-mode-hook* nil)
 (defvar *js-shell-prompt-regexp* "^\[^#$%>?\n]*\[#$%>?] *")
 (defvar-local *js-shell-ret* "\n")
 (defvar-local *js-shell-echo* nil)
 
 
 (defvar *js-shell-mode-map* nil)
 (unless *js-shell-mode-map*
  (setq *js-shell-mode-map* (make-sparse-keymap))
  (define-key *js-shell-mode-map* #\RET 'js-shell-send-input)
  (define-key *js-shell-mode-map* #\q 'js-shell-exit)
  (define-key *js-shell-mode-map* #\C-j 'js-shell-alternate-send-input)
  (define-key *js-shell-mode-map* #\C-i 'javascript-completion)
  (define-key *js-shell-mode-map* '(#\C-c #\C-c) 'js-shell-send-interrupt))
 
 (defvar *js-shell-mode-abbrev-table*  nil)
 (unless *js-shell-mode-abbrev-table*
  (define-abbrev-table '*js-shell-mode-abbrev-table*))
 
 (defun js-shell-exit()
  (interactive)
  (when(find-buffer *js-shell-buffer*)
    (switch-to-buffer *js-shell-buffer*)
    (goto-char(point-max))
    (js-shell-send-input)
    (insert "quit();")
    (js-shell-send-input)
    (sit-for 1)
    (delete-buffer *js-shell-buffer*)
    (delete-window)))
 
 
 (defun js-shell-mode ()
  (setq mode-name "js-shell")
  (setq buffer-mode 'js-shell-mode)
  (use-keymap *js-shell-mode-map*)
  (setq need-not-save t)
  (setq auto-save nil)
  (setq kept-undo-information nil)
  (set-buffer-fold-width 80)
  (setq *local-abbrev-table* *js-shell-mode-abbrev-table*)
  (cond ((string-matchp *eshell* "command.com$")
         (setq *js-shell-ret* "\r" *js-shell-echo* t))
        ((string-matchp *eshell* "cmd.exe$")
         (setq *js-shell-ret* "\n" *js-shell-echo* t))
        (t
         (setq *js-shell-ret* "\n" *js-shell-echo* nil)))
  (run-hooks '*js-shell-mode-hook*))
 
 
 (defun js-shell ()
  (interactive)
  (set-buffer (get-buffer-create *js-shell-buffer*))
  (let ((proc (buffer-process (selected-buffer))))
    (and proc (eq (process-status proc) ':run)
         (return-from js-shell t)))
  (goto-char (point-max))
  (js-shell-mode)
  ;;imjs(WSH) な人はここをコメントアウトを外して下をコメントアウト
  ;;(make-process (concat *eshell* " /c cscript " *js-shell-path*) :output (selected-buffer)))
  (make-process (concat *eshell* " /c " "java -jar " *js-shell-path*):output (selected-buffer)))
 
  ;;;
  ;;; This code is loosely based on version 0.1 by Yutaka Oiwa .
  ;;;
 
 (defun js-shell-send-input ()
  (interactive)
  (let ((process (buffer-process (selected-buffer)))
        start end prompt)
    (when (and process
               (eq (process-status process) :run))
      (cond ((>= (point) (marker-point (process-marker process)))
             (setq start (marker-point (process-marker process)))
             (setq end (progn (goto-eol) (point))))
            ((save-excursion
               (goto-bol)
               (looking-at *js-shell-prompt-regexp*))
             (setq start (match-end 0))
             (setq end (progn (goto-eol) (point)))
             (setq prompt (match-string 0)))
            (t
             (return-from js-shell-send-input nil)))
      (let ((cmd (buffer-substring start end)))
        (cond ((eobp)
               (if *js-shell-echo*
                   ;;(delete-region start end)
                   (insert "\n")
                 (insert "\n")))
              (t
               (goto-char (point-max))
               (or (bolp)
                   (insert "\n"))
               (and prompt (insert prompt))
               (unless *js-shell-echo*
                 (insert cmd))))
        (set-marker (process-marker process))
        (process-send-string process (concatenate 'string cmd *js-shell-ret*)))))
  (recenter (round (/ (window-lines) 2))))
 
 (defun js-shell-alternate-send-input ()
  (interactive)
  (let ((*js-shell-echo* (if (equal *js-shell-echo* "\n")"\r" "\n")))
    (declare (special *js-shell-echo*))
    (js-shell-send-input)))
 
 (setf (symbol-function 'js-shell-send-interrupt) #'kill-subprocess)

リージョンをshellに投げつけるので編集しながらちょこっとテストする時に使える、*javascript-mode-map* に追加しておくと少し幸せになれるかも

 (defvar *js-shell-popup-width* 0)
 (defun js-execute-region(beg end)
  (interactive "*r")
  (let(str b
           (send (split-string (buffer-substring beg end) #\LFD))
           (curent (selected-buffer))
           (buf *js-shell-buffer*))
    (setq b (get-buffer-create buf))
    (js-shell)
    (let ((proc (buffer-process (selected-buffer))))
      (loop
        (when
            (and proc (eq (process-status proc) ':run))
          (return)))
      (set-buffer b)
      (goto-char(point-max))
      (let((p1(point)))
        (dolist (x send )
          (insert (format nil "~A" x))
          (funcall 'js-shell-send-input))
        (set-buffer curent)
        (pop-to-buffer b *js-shell-popup-width*)
        (set-buffer b)
        (dotimes (i (length send)) (scroll-window 1) (sit-for .05))
        (goto-char(point-max))
        (recenter (if (zerop *js-shell-popup-width*)
                      5
                    (round(/ *js-shell-popup-width* 2))))
        (refresh-screen)
        (other-window)
        ))))
 
 (defun js-eval-function(&optional arg)
  (interactive "P")
  (if arg
      (if(find-buffer *js-shell-buffer*)
          (switch-to-buffer *js-shell-buffer*)
        (js-shell))
    (let((p (point)) p1)
      (save-excursion
        (scan-buffer "^\\(\(?function\\|var\\)"
                     :regexp t :reverse t :no-dup t)
        (setq p1 (point))
        (js-execute-region p p1)))
    ))

window の高さは *js-shell-popup-width*を調整することで幅を変えられる

その都度、一時ファイルに書き出してjsshell.exeを立ち上げて実行しているのであまり効率が良くないような気がするけど一応メモしておく。

function,var,空白行を探して戻り現在行を実行しているので、それなりな所で実行しないとSyntaxErrorを吐きまくります。^^;

 (defun spidermonkey-eval-print()
  (interactive)
  (let*((beg (save-excursion
              (goto-eol)
              (scan-buffer "^\\($\\|\\(\(?function\\|var\\).+\\({\\|;\\)$\\)"
                           :regexp t :reverse t :no-dup t)
              (point)))
        (str (buffer-substring beg (progn(goto-eol)(point))))
        (print (split-string  str #\LFD))
        (file (make-temp-file-name "$js_" "tmp" "~/"));一時ファイルを作る
        (cur (selected-buffer))
        (buf (get-buffer-create ed::*js-shell-buffer*))
        (line (buffer-substring(progn(goto-bol)(point))(progn(goto-eol)(point)))))
    (with-open-file(f file :direction :output)
      (princ str f)
      (dolist(x print)
        (format f "~&print(\"~A\")~%"
                (substitute-string x "\[\"\']\\(.*?\\)\[\"\']" "\\\\\"\\1\\\\\"")))
      (format f "~&print(\"js> \" +~A)~%" line))
    (set-buffer buf)
    (set-buffer cur)
    (pop-to-buffer buf 8);分割
    (setq need-not-save t)
    (setq auto-save nil)
    (setq kept-undo-information nil)
    (goto-char (point-max))
    (make-process (format nil  "js.exe -f \"~A\"" file)
                   :output (selected-buffer)) ; jsshell.exe?
    (dotimes (i (length print)) (sit-for 1)(scroll-window 1) )
    (refresh-screen)
    (goto-char (point-max))
    (recenter (window-height))(refresh-screen)
    (other-window)
    (start-timer 5 #'(lambda()(delete-file file)) t)
    ))

ファイルに書き出さなくてもいいバージョン、こっちの方がエラーで出てファイルが残ったりしないのでいいと思う。

 (defun spidermonkey-eval-region(from to)
  (interactive "*r")
  (spidermonkey-eval-print
   (buffer-substring from
                     (if(not(eolp))
                         (progn(goto-eol)(point))
                       to))))
 (defun spidermonkey-eval-print(&optional string)
  (interactive)
  (let*((end (save-excursion(goto-eol)(point)))
        (beg (save-excursion
               ;どこまで戻るか
               (scan-buffer "^\\($\\|\\(\(?function\\|var\\).+\\({\\|;\\)$\\)"
                            :regexp t :reverse t :no-dup t)
               (point)))
        (str (if string string (buffer-substring beg end)))
        (print (split-string  str #\LFD))
        (cur (selected-buffer))
        (buf (get-buffer-create ed::*js-shell-buffer*))
        (line (buffer-substring(save-excursion(goto-bol)(point)) end))
        (proc))
    (set-buffer buf)
    (setq need-not-save t)
    (setq auto-save nil)
    (setq kept-undo-information nil)
    (goto-char (point-max))
    (set-buffer cur)
    (pop-to-buffer buf 8)
 
    (setq proc(make-process "js" :output (selected-buffer)))
    ; 評価しておく
    (process-send-string proc (format nil "~A~%" str))
    ; 一行宛表示
    (dolist(x print)
      (process-send-string
       proc
       (format nil "print(\"js> ~A\")~%"
               (substitute-string x "\[\"\']\\(.*?\\)\[\"\']"
                                  "\\\\\"\\1\\\\\""))))
    ; キャレットのある行を評価
    (process-send-string
     proc
     (format nil "~&print(\"js> \" + ~A)~%"
             (cond ((string-match ".*//.*" line)
                    "\"comment line\"")
                   ((string-match "^[ \t]?+?[}].*" line)
                    (if(string-match "^\\(function\\|var\\) \\(\[^ ]+?\\)\[ (=]" (car print))
                        (concat "\""(match-string 2)"\"")
                      "\"not test function\""))
                   ((string-match "var" line)
                    (substitute-string line "var \\(\[^ ]+?\\) =.*" "\\1"))
                   (t line))
             ))
    (process-send-string proc (string #\C-z)); process end
    (sit-for .5)
    (goto-char (point-max))
    (recenter (1- (window-height)))
    (refresh-screen)
    (other-window)
    ))

矩形やら選択範囲を操作するのは silog さんとこの surround.l が便利なのでそれを使っているのですが何ヶ所か離れた所を同時編集する時に使う為と register って便利だなと思ったので使ってみた。上記の物よりはコードが短くすんだので満足した。

 (defvar *multi-register-r* 0)
 (defun multi-set-register ()
  (interactive)
  (mouse-left-press)
  (setq *multi-register-r* (1+ *multi-register-r*))
  (ed::set-register (code-char *multi-register-r*)(point-marker)))
 
 (defun multi-type-register()
  (interactive)
  (let(c)
    (while(setq c (read-char *standard-input*))
      (if(eq #\C-h c)
        (do((i 1 (1+ i)))
            ((> i *multi-register-r*)nil)
          (jump-to-register (code-char i))
          (delete-char -1)(refresh-screen))
        (progn
      (when(and(not(eq #\C-h c))(fboundp (lookup-key-command c))
               (not(eq (lookup-key-command c) 'self-insert-command)))
        (setq *multi-register-r* 0)(unread-char c)
        (return-from multi-type-register))
      (do((i 1 (1+ i)))
          ((> i *multi-register-r*)nil)
        (jump-to-register (code-char i))
        (insert c)
        (ed::set-register (code-char i)(point-marker))
        (refresh-screen)
        ))))))

;とりあえずマウスで指定していく

 (global-set-key #\C-LBtnDown 'multi-set-register)
 (global-set-key #\C-RBtnDown 'multi-type-register)