twittering-mode.elを読む（続き）
昨日(id:hyoshiok:20080524#p1)に続いてtwitterling-mode.elを読んでいく。
elisp profiler (elp) を使った計測でtwittering-http-get-default-sentinelのコストが高いということがわかったので、そこを起点に読み始めている。で、case-stringというところまで行った。macroの定義で立ち往生していたところid:hayamiz (twittering-mode.elの作者)の解説。ネ申降臨。
さて、下記だ。
(case-string status (("200 OK") (mapcar #'twittering-cache-status-datum (reverse (twittering-xmltree-to-status body))) (twittering-render-friends-timeline) (message (if suc-msg suc-msg "Success: Get."))) (t (message status))))
これはstatusが"200 OK"だったら(mapcar ...)を実行、そうでなかったら(t)、(message status)を実行する。statusはHTTPのヘッダなので、それがOKなのかそれ以外なのか。
#'twittering-cache-status-datuml ... は (function twittering-cache-status-datum) と同じ。(mapcar #'abc (...)) はabcという関数を(...)の各要素に順に適用して、結果をリストで返す。
(reverse (...)) は (...)のリストを逆順にする。例えば(reverse '(1 2 3 4))は(4 3 2 1)というリストになる。
さてここでbodyの値は何かというと twittering-http-get-default-sentinel で定義されているのでそれをもう一度掲載すると下記だ。
(defun twittering-http-get-default-sentinel (proc stat &optional suc-msg) (let ((header (twittering-get-response-header)) (body (twittering-get-response-body)) (status nil) ) ...) )
bodyはtwittering-get-response-bodyを評価したものになっている。twittering-get-response-bodyの定義を読むことにする。
(defun twittering-get-response-body (&optional buffer) "Exract HTTP response body from HTTP response, parse it as XML, and return a XML tree as list. `buffer' may be a buffer or the name of an existing buffer. If `buffer' is omitted, the value of `twittering-http-buffer' is used as `buffer'." (if (stringp buffer) (setq buffer (get-buffer buffer))) (if (null buffer) (setq buffer (twittering-http-buffer))) (save-excursion (set-buffer buffer) (let ((content (buffer-string))) (let ((content (buffer-string))) (xml-parse-region (+ (string-match "\r?\n\r?\n" content) (length (match-string 0 content))) (point-max))) )))
説明文を読むとHTTPレスポンスをXMLとしてパースしてXML木をリストとして返すということらしい。xml-parse-regionの定義については、オンラインヘルプを読むのが王道だろう。メニューからならhelp->describe->describe-functionで当該関数を検索するか、キーボードなら C-h f xml-parse-region すればその定義がわかる。
ヘルプを写経すると、
xml-parse-region is a compiled Lisp function in `xml.el'. (xml-parse-region beg end &optional buffer parse-dtd parse-ns) Parse the region from beg to end in buffer. If buffer is nil, it defaults to the current buffer. Returns the XML list for the region, or raises an error if the region is not well-formed XML. If parse-dtd is non-nil, the DTD is parsed rather than skipped, and returned as the first element of the list. If parse-ns is non-nil, then QNAMES are expanded.
てな事が書いてある。行きがけの駄賃でxml.elまで行ってしまおう。わたしの環境(Ubuntu 8.04)のEmacs 22.1 だとxml.elクリックするだけでソースコードまで連れていってくれた。find /usr/share/emacs|grep xml.elなどとして力づくで検索してもいい。
ファイルの先頭にコメントが書いてあるので、それを読む。
;;; Commentary: ;; This file contains a somewhat incomplete non-validating XML parser. It ;; parses a file, and returns a list that can be used internally by ;; any other Lisp libraries. ;;; FILE FORMAT ;; The document type declaration may either be ignored or (optionally) ;; parsed, but currently the parsing will only accept element ;; declarations. The XML file is assumed to be well-formed. In case ;; of error, the parsing stops and the XML file is shown where the ;; parsing stopped. ;; ;; It also knows how to ignore comments and processing instructions. ;; ;; The XML file should have the following format: ;; <node1 attr1="name1" attr2="name2" ...>value ;; <node2 attr3="name3" attr4="name4">value2</node2> ;; <node3 attr5="name5" attr6="name6">value3</node3> ;; </node1> ;; Of course, the name of the nodes and attributes can be anything. There can ;; be any number of attributes (or none), as well as any number of children ;; below the nodes. ;; ;; There can be only top level node, but with any number of children below. ;;; LIST FORMAT ;; The functions `xml-parse-file', `xml-parse-region' and ;; `xml-parse-tag' return a list with the following format: ;; ;; xml-list ::= (node node ...) ;; node ::= (qname attribute-list . child_node_list) ;; child_node_list ::= child_node child_node ... ;; child_node ::= node | string ;; qname ::= (:namespace-uri . "name") | "name" ;; attribute_list ::= ((qname . "value") (qname . "value") ...) ;; | nil ;; string ::= "..." ;; ;; Some macros are provided to ease the parsing of this list. ;; Whitespace is preserved. Fixme: There should be a tree-walker that ;; can remove it.
これをみるとxml-listを(node node ...)という形式のリストにしてくれるようだ。ふむふむ。
twittering-get-response-header はHTTPレスポンスのヘッダー部分をストリングにして、 twittering-get-response-bodyはHTTPレスポンスのボディ部分をXMLとしてパースしてXML木のリストにして返すようだ。
ということでbodyはXML木のリストである。
(reverse (twittering-xmltree-to-status body)))
次はtwittering-xmltree-to-statusを読む。
(defun twittering-xmltree-to-status (xmltree) (mapcar #'twittering-status-to-status-datum ;; quirk to treat difference between xml.el in Emacs21 and Emacs22 ;; On Emacs22, there may be blank strings (let ((ret nil) (statuses (reverse (cddr (car xmltree))))) (while statuses (if (consp (car statuses)) (setq ret (cons (car statuses) ret))) (setq statuses (cdr statuses))) ret)))
ここで
(let ((ret nil) (statuses (reverse (cddr (car xmltree))))) ... )
となっているので(statuses (reverse (cddr (car xmltree))))なので(car xmltree)は先のコメントからXML木のnodeだ。(cddr XML木のnode)ということなので、(cdr (cdr XML木のnode))となる。上記の定義よりそれは子ノードということになる。それを逆順にしたものがstatusesということになるらしい。
(while statuses (if (consp (car statuses)) (setq ret (cons (car statuses) ret))) (setq statuses (cdr statuses)))
(while statuses (if ...) (setq ...)) はstatusesがnilでない間、(if ...) (setq ...) を繰り返す。statusesを逆順にしたのをretになる。それをそれぞれtwittering-status-to-status-datum適用する。
twittering-status-to-status-datum は、長い。画面に収まらない。
ざっくり、構造を抽出すると下記になる。
(defun twittering-status-to-status-datum (status) ;; 関数の再定義 (flet ((assq-get (item seq) (car (cddr (assq item seq))))) ;; 変数の定義 (let* ((status-data (cddr status)) ;; 中略 regex-index) ;; 変数へ初期値を代入 (setq id (string-to-number (assq-get 'id status-data))) ;; 中略 ;; make username clickable ;; make URI clickable ;; make screen-name clickable ;; make source pretty and clickable (mapcar (lambda (sym) `(,sym . ,(symbol-value sym))) '(id text source created-at truncated user-id user-name user-screen-name user-location user-description user-profile-image-url user-url user-protected)))))
一番最後の(mapcar (lambda (sym) ...) '(id ...))がどうもこの関数のキモのようである。
ということで長くなったので一休み。このペースで終わるかなあ。不安だ。
本日のプロファイリングデータ
Function Name Call Count Elapsed Time Average Time ======================================== ========== ============ ============ twittering-http-get-default-sentinel 210 825.63031699 3.9315729380 twittering-render-friends-timeline 159 733.25885600 4.6116909182 twittering-format-status 74418 682.15694900 0.0091665584 xml-parse-tag 56682 285.23423599 0.0050321836 twittering-timer-action 210 268.58633499 1.2789825476 twittering-friends-timeline 210 268.55300099 1.2788238142 twittering-http-get 210 258.650464 1.2316688761 twittering-get-response-body 210 68.477939999 0.3260854285 xml-parse-region 210 67.574131000 0.3217815761 xml-parse-string 107673 38.983813999 0.0003620574 xml-substitute-special 108262 26.867760000 0.0002481735 twittering-xmltree-to-status 160 18.433747000 0.1152109187 twittering-status-to-status-datum 2912 17.943616000 0.0061619560 twittering-image-type 74418 4.0766180000 5.477...e-05 twittering-cache-status-datum 2911 3.7562859999 0.0012903765 xml-parse-attlist 56472 2.0487380000 3.627...e-05 twittering-decode-html-entities 17466 1.9062979999 0.0001091433 xml-maybe-do-ns 57061 1.6209119999 2.840...e-05 twittering-get-response-header 210 0.4974110000 0.0023686238 twittering-http-buffer 840 0.0928869999 0.0001105797 twittering-get-or-generate-buffer 1418 0.0755730000 5.329...e-05 twittering-wget-buffer 418 0.0671740000 0.0001607033 twittering-buffer 160 0.0115700000 7.231...e-05 xml-parse-dtd 11 0.006544 0.0005949090 twittering-mode 1 0.001119 0.001119 twittering-mode-init-variables 1 0.000857 0.000857 twittering-start 1 0.000128 0.000128 twittering-click 1 3.3e-05 3.3e-05
呼び出し関係は下記のとおり。
twittering-http-get-default-sentinel calls
case-string
twittering-render-friends-timeline calls
twittering-buffer calls
twittering-buffer
twittering-http-buffer calls
twittering-get-or-generate-buffer
twittering-friends-timeline calls
twittering-buffer
twittering-wget-buffer calls
twittering-get-or-generate-buffer
twittering-wget-buffer
twittering-icon-mode calls
twittering-icon-mode
twittering-render-friends-timeline calls
twittering-buffer
twittering-scroll-mode calls
twittering-scroll-mode
debug-print calls
twittering-debug-buffer calls
twittering-get-or-generate-buffer
twittering-debug-buffer.
twittering-debug-mode calls
twittering-debug-mode
twittering-mode
twittering-update-lambda
twittering-friends-timeline
twittering-update-status-interactive
twittering-erase-old-statuses
twittering-click
twittering-enter
twittering-view-user-page
twittering-format-status calls
assocref
twittering-icon-mode
twittering-image-type
twittering-local-strftime calls
twittering-debug-buffer
twittering-debug-mode
twittering-friends-timeline
twittering-icon-mode
twittering-http-get calls
twittering-http-buffer
twittering-http-get
twittering-http-get-default-sentinel
twittering-stop
twittering-get-or-generate-buffer
twittering-scroll-mode
debug-print
twittering-format-status
twittering-friends-timeline.
twittering-get-response-header calls
twittering-http-buffer
twittering-get-response-body calls
twittering-http-buffer
twittering-cache-status-datum calls
twittering-friends-timeline
twittering-xmltree-to-status calls
twittering-status-to-status-datum calls
twittering-decode-html-entities calls
twittering-ucs-to-char.うーむ、まだまだである。
