Wilikiで見出し検索 - 駄目日記っぽぃ。

大学で作業してるメモは大体Wilikiに突っこんでいってるんやが、毎日書くメモをいちいち分類しながら書くのもアホらしいんで日付毎にページを作って適当に書く、というスタイルになってしまっている。これだと「前にあんなこと考えてたよなぁ…」と思って探すのが面倒くさい。
幸いジャンル毎(？)に「ネタ」とか「やること」とか見出しを付ける癖があるので、そっちを検索して切り出し、1ページにまとめて(見出し以下の内容も含めてびらーっと)表示してやることにした。
例によって外部からなんやかんやするのが面倒くさいので、Wilikiのコードに直接付け足し。wilikiはCVSから6月頃に拾ってきたやつ(0.6_pre2)ベース。
db.scmに

(define (get-first-remaining str)
  (let ((p (open-input-string str)))
    (read p)
    (get-remaining-input-string p)))

(define (extract-section key content)
  (let ((regexp (string->regexp (string-append "(?:^|(?:(?![^\n]).))(\\*+)( [^\r\n]*"
                                               key
                                               "[^\r\n]*)")
                                :case-fold #t) ))
    (let loop ((txt content)
               (ret ""))
      (let ((match (rxmatch regexp txt)))
        (or (and match
                 (let* ((num (string-length (match 1)))
                        (rest (rxmatch-after match 2))
                        (match2 ((string->regexp #`"[\n\r]+\\*{1,,,|num|}? ") rest)))
                   (if match2
                       (loop (string-drop rest(rxmatch-start match2))
                         (string-append ret "\r\n" (match 1)(match 2)(rxmatch-before match2)))
                       (loop "" (string-append ret "\r\n" (match 1)(match 2)rest)))) )
            ret) ))))


(define (wiliki-db-search-section pred key . maybe-sorter)
  (sort
   (dbm-fold (check-db)
             (lambda (k v r)
               (if (pred k v) (acons (cons k (extract-section key (get-first-remaining v)) )
                                     (read-from-string v) r) r))
             '())
   (get-optional maybe-sorter
                 (lambda (a b)
                   (> (get-keyword :mtime (cdr a) 0)
                      (get-keyword :mtime (cdr b) 0))))))

(define (wiliki-db-search-section-content key . maybe-sorter)
  (apply wiliki-db-search-section
         (lambda (k v)
           (and (not (string-prefix? " " k))
                (let ((content (ref (wiliki-db-record->page (string-append "* " key "\n") v)
                                    'content)))
                  ((string->regexp (string-append "(?:^|(?:(?![^\n]).))(\\*+)( [^\r\n]*"
                                                  key "[^\r\n]*)")
                                   :case-fold #t)
                   content)
                  )))
         key
         maybe-sorter))

とかやって、wiliki.scmには

(define (wiliki:search-section-box)
  `((form (@ (method POST) (action ,(cgi-name-of (wiliki)))
             (style "margin:0pt; padding:0pt"))
          (input (@ (type hidden) (name c) (value ss)))
          (input (@ (type text) (name key) (size 15)
                    (class "search-box")))
          (input (@ (type submit) (name search) (value ,($$ "Search"))
                    (class "navi-button")))
          )))

(define-wiliki-action ss :read (_
				(key :convert cv-in))
  (html-page
   (make <wiliki-page>
     :title (format ($$ "Search results of \"~a\"") key)
     :command (format #f "c=ss&key=~a" (html-escape-string key))
     :content
     `((ul
	,@(map (lambda (p)
		 (append
		 `(li
		   ,(wiliki:wikiname-anchor (caar p))
		   ,(or (and-let* ((mtime (get-keyword :mtime (cdr p) #f)))
				  #`"(,(how-long-since mtime))")
			""))
		   (wiliki:format-content (cdar p))))
	       (wiliki-db-search-section-content key))))
     )))

とやって、表示CGI側でwiliki:search-section-boxを呼出したりして検索boxを配置して使う。ああ、各関数をちゃんとexportしないと使えんけど。

普通のキーワード検索を元に作ったんやが、(自分で言うのも何やが)かなり使いやすい。検索して1ホップで情報がなめるように見られるというのはやっぱ違うね。

あと課題はヒットする見出しが多くなってきたときに大変なんで、DHTMLな感じで畳めるようにするとか、ページング処理するとかかな。extract-sectionでstring-appendとかしてるのとか、やりかたがわからんので適当に書いてしまったget-first-remainingとかも気になるけど、まぁそのうち(やる気があれば)修正しよう。