Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2011-01-08

KMRCLを眺める(234) repl.lisp

| 21:39 | KMRCLを眺める(234) repl.lisp - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(234) repl.lisp - わだばLisperになる

今回はKMRCLのrepl.lispまるごとです。

一つ一つの関数をばらして解説というのがちょっと難しそうなのと、それ程長くもない、ということでファイル全体を眺めます。

まず、名前からしてREPLを実現するファイルだろうなということは分かります。

とりあえず上からつらつらと眺めつつ実際に動かしてみます。

定数などの定義

(in-package #:kmrcl)

(defconstant +default-repl-server-port+ 4000)

デフォルトの接続ポートを4000番にしていますが、どうやら外部と通信できるようです。

REPLクラス

(defclass repl ()
  ((listener :initarg :listener :accessor listener
             :initform nil)))

REPLクラスを定義しています。

MAKE-REPL

(defun make-repl (&key (port +default-repl-server-port+)
                       announce user-checker remote-host-checker)
  (make-instance 'listener
    :port port
    :base-name "repl"
    :function 'repl-worker
    :function-args (list user-checker announce)
    :format :text
    :wait nil
    :remote-host-checker remote-host-checker
    :catch-errors nil))

MAKE-REPLというLISTNERのインスタンスを生成するユーティリティを定義していますが、LISTERクラスは、KMRCLのlistener.lispで定義されています。こちらもいつか眺めます。

LISTNERはどうやら通信できることを前提に設定されている様子。

INIT/REPL

(defun init/repl (repl state)
  (init/listener repl state))

INIT/REPLは名前の通りREPLを初期化するものだろうと思われます。

INIT/LISTENERもlistener.lispで定義されています。state引数が謎ですが、定義を辿ってみると、:start、:stop、:restartという引数を取り状態を遷移させるもののようです。

REPL-WORKER

(defun repl-worker (conn user-checker announce)
  (when announce
    (format conn "~A~%" announce)
    (force-output conn))
  (when user-checker
    (let (login password)
      (format conn "login: ")
      (finish-output conn)
      (setq login (read-socket-line conn))
      (format conn "password: ")
      (finish-output conn)
      (setq password (read-socket-line conn))
      (unless (funcall user-checker login password)
        (format conn "Invalid login~%")
        (finish-output conn)
        (return-from repl-worker))))
  #+allegro
  (tpl::start-interactive-top-level
   conn
   #'tpl::top-level-read-eval-print-loop
   nil)
  #-allegro
  (repl-on-stream conn)
  )

REPL-WORKERはLISTENERのFUNCTIONに登録されるものです。接続と、ユーザーチェック(パスワードの確認)の有無、接続時に表示させるアナウンスの内容を取り、一連の処理をした後、REPL-ON-STREAMを呼びます。

READ-SOCKET-LINE

(defun read-socket-line (stream)
  (string-right-trim-one-char #\return
                              (read-line stream nil nil)))

READ-SOCKET-LINEは、REPL-WORKERの中でユーザー名とパスワードを読み取るのに使われています。

STRING-RIGHT-TRIM-ONE-CHARはKMRCLのユーティリティ関数です。

PRINT-PROMPT

(defun print-prompt (stream)
  (format stream "~&~A> " (package-name *package*))
  (force-output stream))

名前の通りプロンプトを表示させるもの。パッケージも表示されるようです。

REPL-ON-STREAM

(defun repl-on-stream (stream)
  (let ((*standard-input* stream)
        (*standard-output* stream)
        (*terminal-io* stream)
        (*debug-io* stream))
    #|
    #+sbcl
    (if (and (find-package 'sb-aclrepl)
             (fboundp (intern "REPL-FUN" "SB-ACLREPL")))
        (sb-aclrepl::repl-fun)
        (%repl))
    #-sbcl
    |#
    (%repl)))

REPL-ON-STREAMは、*standard-input/output*等をストリームに束縛して%REPLを呼ぶというもの。

SBCLの場合は、SB-ACLREPL(SBCLで、Allegro CL風のREPLを実現するもの)を使おうとしたりしているようですが、コメントアウトされています。

%REPL

(defun %repl ()
  (loop
    (print-prompt *standard-output*)
    (let ((form (read *standard-input*)))
      (format *standard-output* "~&~S~%" (eval form)))))

%REPLが実質の本体で、Read-Eval-Print-Loopそのままに、read->eval->format->loopとなっています。

内容は以上ですが、実際に使ってみます。

(require :kmrcl)

(defvar *repl*)

;; REPLインスタンスを生成
(setq *repl* (kl:make-repl :announce "hello!" :port 4001
                           :user-checker (lambda (user pass)
                                           (find (cons user pass)
                                                 '(("g000001" . "g000001"))
                                                 :test #'equal))))
;; 起動
(kl:init/repl *repl* :start)

telnetで接続

setq% rlwrap telnet localhost 4001
Trying ::1...
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
hello!
login: g000001
password: g000001

COMMON-LISP-USER> (+ 3 3 3 3 )

12
COMMON-LISP-USER>

という感じになります。

2011-01-07

KMRCLを眺める(233) REMOVE-SIGNAL-HANDLER

| 19:58 | KMRCLを眺める(233) REMOVE-SIGNAL-HANDLER - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(233) REMOVE-SIGNAL-HANDLER - わだばLisperになる

今回はKMRCLのsignals.lispから、REMOVE-SIGNAL-HANDLERです。

前回はハンドラを設定する方でしたが今回は削除する方です。

定義は、

(defun remove-signal-handler (sig &optional old-handler)
  "Removes a handler from signal. Tries, when possible, to restore old-handler."
  (let ((signum (etypecase sig
                  (integer sig)
                  (keyword (signal-key-to-number sig)))))
    ;; allegro automatically restores old handler, because set-signal-handler above
    ;; actually pushes the new handler onto a list of handlers
    #+allegro (declare (ignore old-handler))
    #+allegro (excl:remove-signal-handler signum)
    #+cmu (system:enable-interrupt signum (or old-handler :default))
    ;; lispworks removes handler if old-handler is nil
    #+(and lispworks unix) (system:set-signal-handler signum old-handler)
    #+sbcl (sb-sys:enable-interrupt signum (or old-handler :default))
    #-(or allegro cmu (and lispworks unix) sbcl)
    (declare (ignore sig handler))
    #-(or allegro cmu (and lispworks unix) sbcl)
    (warn "Signal setting not supported on this platform.")))

となっています。

動作は、

;; USR1へのハンドラを設定
(kl:set-signal-handler :usr1
                       (lambda (&rest args)
                         (declare (ignore args))
                         (princ "Hello USR1 !")
                         (terpri)
                         (force-output)))

:DEFAULT
* (sb-posix:getpid)
9776

;; 他のシェルから
$ kill -USR1 9776

* Hello USR1 !
;; USR1のハンドラを削除
(kl:remove-signal-handler :usr1)
#<CLOSURE (FLET SB-UNIX::RUN-HANDLER) {1003B40C89}>
T

;; 他のシェルから
$ kill -USR1 9776
* User defined signal 1

というところ

2011-01-05

KMRCLを眺める(232) SET-SIGNAL-HANDLER

| 19:54 | KMRCLを眺める(232) SET-SIGNAL-HANDLER - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(232) SET-SIGNAL-HANDLER - わだばLisperになる

今回はKMRCLのsignals.lispから、SET-SIGNAL-HANDLERです。

処理系依存で処理系に送られたシグナルをハンドリングする機能があるようですが、それをポータブルに書けるようにしたもののようです。

定義は、

(defun set-signal-handler (sig handler)
  "Sets the handler for a signal to a function. Where possible, returns
the old handler for the function for later restoration with remove-signal-handler
below.

To be portable, signal handlers should use (&rest dummy) function signatures
and ignore the value. They should return T to tell some Lisp implementations (Allegro)
that the signal was successfully handled."
  (let ((signum (etypecase sig
                  (integer sig)
                  (keyword (signal-key-to-number sig)))))
    #+allegro (excl:add-signal-handler signum handler)
    #+cmu (system:enable-interrupt signum handler)
    #+(and lispworks unix)
    ;; non-documented method to get old handler, works in lispworks 5
    (let ((old-handler (when (and (boundp 'system::*signal-handler-functions*)
                                  (typep system::*signal-handler-functions* 'array))
                         (aref system::*signal-handler-functions* signum))))
      (system:set-signal-handler signum handler)
      old-handler)
    #+sbcl (sb-sys:enable-interrupt signum handler)
    #-(or allegro cmu (and lispworks unix) sbcl)
    (declare (ignore sig handler))
    #-(or allegro cmu (and lispworks unix) sbcl)
    (warn "Signal setting not supported on this platform.")))

となっていて前回のSIGNAL-KEY-TO-NUMBERが内部で使われています。

長いですが、それぞれの処理系で実質2、3行といったところです。

動作は、

;; USR1へのハンドラを設定
(kl:set-signal-handler :usr1 
                       (lambda (&rest args)
                         (declare (ignore args))
                         (princ "Hello USR1 !")
                         (terpri)
                         (force-output)))
;; プロセスIDを確認
(kl:getpid)
;=> 6269

他のシェル等から
$ kill -USR1 6269

;; 処理系が起動しているターミナル等に表示される筈
* Hello USR1 !

というところ

2011-01-03

KMRCLを眺める(231) SIGNAL-KEY-TO-NUMBER

| 21:58 | KMRCLを眺める(231) SIGNAL-KEY-TO-NUMBER - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(231) SIGNAL-KEY-TO-NUMBER - わだばLisperになる

strmatch.lispも眺め終えたので、今回はKMRCLのsignals.lispから、SIGNAL-KEY-TO-NUMBERです。

signals.lispはPOSIXのシグナル関係の処理系依存のところを纏めたもののようです。

SIGNAL-KEY-TO-NUMBERは、名前のとおりシグナルの名前から番号に変換するもので定義は、

(defun signal-key-to-number (sig)
  "These signals and numbers are only valid on POSIX systems, perhaps
some are Linux-specific."
  (case sig
    (:hup 1)
    (:int 2)
    (:quit 3)
    (:kill 9)
    (:usr1 10)
    (:usr2 12)
    (:pipe 13)
    (:alrm 14)
    (:term 15)
    (t
     (error "Signal ~A not known." sig))))

となっています。

動作は、

(kl::signal-key-to-number :usr1)
;=> 10

というところ

2010-12-04

KMRCLを眺める(230) MULTIWORD-MATCH

| 22:34 | KMRCLを眺める(230) MULTIWORD-MATCH - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(230) MULTIWORD-MATCH - わだばLisperになる

今回はKMRCLのstrmatch.lispから、MULTIWORD-MATCHです。

ドキュメント文字列によると、区切り文字や単語の位置には無関係で、大文字小文字も区別しないで文字列に含まれる単語群が同一のものかを判定するようです。

動作は、

(kl:multiword-match "foo        bar   baz" "foo,bar,baz")
;=> T

(kl:multiword-match "***foo/bar/baz**" "FOO,BAZ,bar")
;=> T

(kl:multiword-match "***foo/bar/baz**" "FOO,BAZ,bbb")
;=> NIL

というところ

定義は、

(defun multiword-match (s1 s2)
  "Matches two multiword strings, ignores case, word position, punctuation"
  (let* ((word-list-1 (split-alphanumeric-string s1))
         (word-list-2 (split-alphanumeric-string s2))
         (n1 (length word-list-1))
         (n2 (length word-list-2)))
    (when (= n1 n2)
      ;; remove each word from word-list-2 as walk word-list-1
      (dolist (w word-list-1)
        (let ((p (position w word-list-2 :test #'string-equal)))
          (unless p
            (return-from multiword-match nil))
          (setf (nth p word-list-2) "")))
      t)))

となっています。

SPLIT-ALPHANUMERIC-STRINGが肝ですが、これはKMRCLのもので以前に取り上げています。

2010-11-26

KMRCLを眺める(229) SCORE-MULTIWORD-MATCH

| 23:51 | KMRCLを眺める(229) SCORE-MULTIWORD-MATCH - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(229) SCORE-MULTIWORD-MATCH - わだばLisperになる

xml-utils.lispも眺め終えたので、今回はKMRCLのstrmatch.lispから、SCORE-MULTIWORD-MATCHです。

名前からすると、与えられた引数の文字列の類似度を測定する関数のようです。

定義は、

(defun score-multiword-match (s1 s2)
  "Score a match between two strings with s1 being reference string.
S1 can be a string or a list or strings/conses"
  (let* ((word-list-1 (if (stringp s1)
                          (split-alphanumeric-string s1)
                        s1))
         (word-list-2 (split-alphanumeric-string s2))
         (n1 (length word-list-1))
         (n2 (length word-list-2))
         (unmatched n1)
         (score 0))
    (declare (fixnum n1 n2 score unmatched))
    (decf score (* 4 (abs (- n1 n2))))
    (dotimes (iword n1)
      (declare (fixnum iword))
      (let ((w1 (nth iword word-list-1))
            pos)
        (cond
         ((consp w1)
          (let ((first t))
            (dotimes (i-alt (length w1))
              (setq pos
                (position (nth i-alt w1) word-list-2
                          :test #'string-equal))
              (when pos
                (incf score (- 30
                               (if first 0 5)
                               (abs (- iword pos))))
                (decf unmatched)
                (return))
              (setq first nil))))
         ((stringp w1)
          (kmrcl:awhen (position w1 word-list-2
                               :test #'string-equal)
                       (incf score (- 30 (abs (- kmrcl::it iword))))
                       (decf unmatched))))))
    (decf score (* 4 unmatched))
    score))

となっていますが、どうも自分には、使い方がいまいち不明でした

(kl:score-multiword-match "foo" "foo")
;=> 30

(kl:score-multiword-match '("foo") "foo")
;=> 30

(kl:score-multiword-match '("foo" "foo") "foo")
;=> 55

(kl:score-multiword-match '("foo" "foo" "foo") "foo")
;=> 79

(kl:score-multiword-match '("foo" "foo" "foo" "foo") "foo")
;=> 102

(kl:score-multiword-match '("foo" "foo" "foo" "foa") "foo")
;=> 71

(kl:score-multiword-match '("foo" "fao" "foo" "foa") "foo")
;=> 38

有名なアルゴリズムだったりするのでしょうか。

2010-11-22

KMRCLを眺める(228) SGML-HEADER-STREAM

| 22:41 | KMRCLを眺める(228) SGML-HEADER-STREAM - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(228) SGML-HEADER-STREAM - わだばLisperになる

今回はKMRCLのxml-utils.lispから、SGML-HEADER-STREAMです。

名前の通り、SGML系のヘッダを出力するのに使うようです。

定義は、

(defun sgml-header-stream (format stream &key entities (encoding "iso-8859-1") standalone (version "1.0")
                          top-element (availability "PUBLIC") registered organization (type "DTD")
                           label (language "EN") url)
  (when (in format :xhtml :xhtml11 :xhtml10-strict :xhtml10-transitional :xhtml10-frameset :xml :docbook)
    (xml-declaration-stream stream :version version :encoding encoding :standalone standalone))
  (unless (eq :xml format)
    (doctype-format stream format :top-element top-element
                    :availability availability :registered registered
                    :organization organization :type type :label label :language language
                    :url url :entities entities))
  stream)

動作は、

(with-output-to-string (out)
  (kl::sgml-header-stream :xhtml10-transitional
                          out))
;=> "<?xml version=\"1.0\" encoding=\"iso-8859-1\" ?>
;   <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml10/DTD/xhtml10-transitional.dtd\">
;   "

といったところ。

ふと気付いたのですが、どうも、一般的には、http://www.w3.org/TR/xhtml10/DTD/xhtml10-transitional.dtdじゃなくて、 http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtdのようなんですが、定義が古かったりするんでしょうか。

2010-11-15

KMRCLを眺める(227) DOCTYPE-STREAM

| 21:23 | KMRCLを眺める(227) DOCTYPE-STREAM - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(227) DOCTYPE-STREAM - わだばLisperになる

今回はKMRCLのxml-utils.lispから、DOCTYPE-STREAMです。

眺める順番を間違えてしまいましたが、DOCTYPEを作成するためのユーティリティで、ストリームを取って出力するものです。

前回のDOCTYPE-FORMATは内部でこれを利用しています。

定義は、

(defun doctype-stream (stream top-element availability registered organization type
                       label language url entities)
  (format stream "<!DOCTYPE ~A ~A \"~A//~A//~A ~A//~A\"" top-element
          availability (if registered "+" "-") organization type label language)

  (when url
    (write-char #\space stream)
    (write-char #\" stream)
    (write-string url stream)
    (write-char #\" stream))

  (when entities
    (format stream " [~%~A~%]" entities))

  (write-char #\> stream)
  (write-char #\newline stream))

動作は、

(with-output-to-string (out)
  (kl::doctype-stream out
                      "html"
                      "PUBLIC"
                      NIL
                      "W3C"
                      "DTD"
                      "XHTML 1.1"
                      "EN"
                      "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"
                      NIL))
;=> "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
;   "

といったところ

2010-11-11

KMRCLを眺める(226) DOCTYPE-FORMAT

| 23:51 | KMRCLを眺める(226) DOCTYPE-FORMAT - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(226) DOCTYPE-FORMAT - わだばLisperになる

今回はKMRCLのxml-utils.lispから、DOCTYPE-FORMATです。

名前から大体分かるようにDOCTYPEを作成するためのユーティリティです。

定義は、

(defun doctype-format (stream format &key top-element (availability "PUBLIC")
                       (registered nil) organization (type "DTD") label
                       (language "EN") url entities)
  (case format
    ((:xhtml11 :xhtml)
     (doctype-stream stream "html" availability registered "W3C" type "XHTML 1.1" language
                     (if url url "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd")
                     entities))
    (:xhtml10-strict
     (doctype-stream stream "html" availability registered "W3C" type "XHTML 1.0 Strict" language
                     (if url url "http://www.w3.org/TR/xhtml10/DTD/xhtml10-strict.dtd")
                     entities))
    (:xhtml10-transitional
     (doctype-stream stream "html" availability registered "W3C" type "XHTML 1.0 Transitional" language
                     (if url url "http://www.w3.org/TR/xhtml10/DTD/xhtml10-transitional.dtd")
                     entities))
    (:xhtml-frameset
     (doctype-stream stream "html" availability registered "W3C" type "XHTML 1.0 Frameset" language
                     (if url url "http://www.w3.org/TR/xhtml10/DTD/xhtml10-frameset.dtd")
                     entities))
    (:html2
     (doctype-stream stream "HTML" availability registered "IETF" type "HTML" language url entities))
    (:html3
     (doctype-stream stream "HTML" availability registered "IETF" type "HTML 3.0" language url entities))
    (:html3.2
     (doctype-stream stream "HTML" availability registered "W3C" type "HTML 3.2 Final" language url entities))
    ((:html :html4)
     (doctype-stream stream "HTML" availability registered "W3C" type "HTML 4.01 Final" language url entities))
    ((:docbook :docbook42)
     (doctype-stream stream (if top-element top-element "book")
                     availability registered "OASIS" type "Docbook XML 4.2" language
                     (if url url "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd")
                     entities))
    (t
     (unless top-element (warn "Missing top-element in doctype-format"))
     (unless organization (warn "Missing organization in doctype-format"))
     (unless label (warn "Missing label in doctype-format"))
     (doctype-stream stream top-element availability registered organization type label language url
                     entities))))

で、色々と条件を指定することができます。

動作は、

(with-output-to-string (out)
  (kl::doctype-format out :xhtml))
;=> "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
;   "

というところ

2010-11-10

KMRCLを眺める(225) XML-DECLARATION-STREAM

| 21:48 | KMRCLを眺める(225) XML-DECLARATION-STREAM - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(225) XML-DECLARATION-STREAM - わだばLisperになる

今回はKMRCLのxml-utils.lispから、XML-DECLARATION-STREAMです。

名前の通りXMLの宣言を作成するもので定義は、

(defun xml-declaration-stream (stream &key (version "1.0") standalone encoding)
  (format stream "<?xml version=\"~A\"~A~A ?>~%"
          version
          (if encoding
              (format nil " encoding=\"~A\"" encoding)
              ""
              )
          (if standalone
              (format nil " standalone=\"~A\"" standalone)
              "")))

という風。

動作は、

(with-output-to-string (out)
  (kl::xml-declaration-stream out :standalone "yes" :encoding "utf-8"))
;=> "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"yes\" ?>
;   "

となっています。

2010-11-09

KMRCLを眺める(224) WRITE-CDATA

| 21:35 | KMRCLを眺める(224) WRITE-CDATA - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(224) WRITE-CDATA - わだばLisperになる

今回はKMRCLのxml-utils.lispから、WRITE-CDATAです。

定義は、

(defun write-cdata (str s)
  (declare (simple-string str) (optimize (speed 3) (safety 0) (space 0)))
  (do ((len (length str))
       (i 0 (1+ i)))
      ((= i len) str)
    (declare (fixnum i len))
    (let ((c (schar str i)))
      (case c
        (#\< (write-string "&lt;" s))
        (#\& (write-string "&amp;" s))
        (t   (write-char c s))))))

となっていて、単純に"<"や"&"などを、&lt;、&amp;に置き換えるだけのものの様子。

動作は、

(kl:write-cdata "<![CDATA[こんにちは]]>" *standard-output*)
;-> &lt;![CDATA[こんにちは]]>
;=> "<![CDATA[こんにちは]]>"

となっていますが、CDATAセクションの中でCDATAのタグを使うための文字列を生成するというのもちょっとおかしいし、CDATAを表示させるためとしたら、>が置き換えされていないし…、ということでちょっと謎の関数です。

(#\> (write-string "&gt;" s))

が忘れられていたりするんでしょうか。

2010-11-06

KMRCLを眺める(223) CDATA-STRING

| 21:46 | KMRCLを眺める(223) CDATA-STRING - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(223) CDATA-STRING - わだばLisperになる

今回はKMRCLのxml-utils.lispから、CDATA-STRINGです。

動作は、

(kl:cdata-string "<いろはにほへと><ちりぬるを>")
;=> "<![CDATA[<いろはにほへと><ちりぬるを>]]>"

という風。

定義は、単純に

(defun cdata-string (str)
  (concatenate 'string "<![CDATA[" str "]]>"))

となっています。

2010-10-28

KMRCLを眺める(222) XML-TAG-CONTENTS

| 20:21 | KMRCLを眺める(222) XML-TAG-CONTENTS - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(222) XML-TAG-CONTENTS - わだばLisperになる

今回はKMRCLのxml-utils.lispから、XML-TAG-CONTENTSです。

前回眺めた、POSITIONS-XML-TAG-CONTENTSを使ってタグの中身を切り出すものです。

動作は、

(kl::xml-tag-contents "foo" "<foo bar=\"1\">hello</foo>")
;⇒ "hello", 24, ("bar=\"1\"")

定義は、

(defun xml-tag-contents (tag xmlstr &optional (start-xmlstr 0)
                         (end-xmlstr (length xmlstr)))
  "Returns two values: the string between XML start and end tag
and position of character following end tag."
  (multiple-value-bind
      (startpos endpos nextpos attributes)
      (positions-xml-tag-contents tag xmlstr start-xmlstr end-xmlstr)
    (if (and startpos endpos)
        (values (subseq xmlstr startpos endpos) nextpos attributes)
      (values nil nil nil))))

となっています。

2010-10-25

KMRCLを眺める(221) POSITIONS-XML-TAG-CONTENTS

| 20:40 | KMRCLを眺める(221) POSITIONS-XML-TAG-CONTENTS - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(221) POSITIONS-XML-TAG-CONTENTS - わだばLisperになる

今回はKMRCLのxml-utils.lispから、POSITIONS-XML-TAG-CONTENTSです。

定義は、

(defun positions-xml-tag-contents (tag xmlstr &optional (start-xmlstr 0)
                                       (end-xmlstr (length xmlstr)))
  "Returns three values: the start and end positions of contents between
 the xml tags and the position following the close of the end tag."
  (let* ((taglen (length tag)))
    (multiple-value-bind (start attributes)
        (find-start-tag tag taglen xmlstr start-xmlstr end-xmlstr)
      (unless start
        (return-from positions-xml-tag-contents (values nil nil nil nil)))
      (let ((end (find-end-tag tag taglen xmlstr start end-xmlstr)))
        (unless end
          (return-from positions-xml-tag-contents (values nil nil nil nil)))
        (values start end (+ end taglen 3) attributes)))))

となっていますが、前回、前々回に眺めた、FIND-START-TAG、FIND-END-TAGを使ってタグに囲まれた中身の開始と終了の位置を切り出している様子。

最初に開始タグの検出、不備があれば脱出、次に終了タグの検出/脱出、開始/終了タグともに問題なければ位置を多値で返す、という風。

動作は、

(kl::positions-xml-tag-contents "foo" "<foo bar=\"1\">hello</foo>")
;⇒ 13, 18, 24, ("bar=\"1\"")

;; 開始タグ不備
(kl::positions-xml-tag-contents "foo" "foo>hello</foo>")
;⇒ NIL, NIL, NIL, NIL

;; 終了タグ不備
(kl::positions-xml-tag-contents "foo" "<foo>hello</foo")
;⇒ NIL, NIL, NIL, NIL

となっています。

2010-10-22

KMRCLを眺める(220) FIND-END-TAG

| 18:46 | KMRCLを眺める(220) FIND-END-TAG - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(220) FIND-END-TAG - わだばLisperになる

今回はKMRCLのxml-utils.lispから、FIND-END-TAGです。

動作は、

(kmrcl::find-end-tag "foo" 3 "<foo>hello</foo>" 5 16)
;⇒ 10

という感じで前回のFIND-START-TAGの対で終了タグの開始位置を返すものです。

定義は、

(defun find-end-tag (tag taglen xmlstr start end)
  (fast-string-search
   (concatenate 'string "</" tag ">") xmlstr
   (+ taglen 3) start end))

というところ。

簡単に標準の関数で書けば、

(defun find-end-tag (tag taglen xmlstr start end)
  (declare (ignore taglen))
  (search (concatenate 'string "</" tag ">")
          xmlstr
          :start2 start :end2 end ))

というところでしょうか。