Gauche:htmlリファレンスの参照

Gauche:WishListより

hira: WiLiKiからリファレンスマニュアルを参照しておけば、きっと役に立つ。そう思うのが人情というもの。でも、それをやっちゃうとバージョンアップでリンクがアサッテを向いてしまうのです。まさに諸刃の剣。何時までたっても変わらないURI、そんなもの有るのだろうか？有るのかどうか分からないけど、それを願っているという事をここに書いておきます。

texi2htmlを通すとファイル名やアンカー名がリナンバーされてしまうので、 htmlのリファレンスをURLで参照していた場合、マニュアルが改訂される度に URLがずれてしまいます。

そこで、とってもアドホックなcgiスクリプトを書いてみました。

インタフェース

WiLiKi内で使う場合は、InterWikiNameに登録してあるので、GaucheRefj:トピック名のようなWikiNameで参照できます。トピック名に使えるのは、関数名、マクロ名、モジュール名、クラス名('<', '>'のついているもの)、それと章や節のタイトルです。タイトルはスペースが入るとだめかも。

例：

GaucheRefj:receive
GaucheRefe:cut 英語マニュアルの方
GaucheRefj:file.util モジュール名
GaucheRefj:<sys-tm> クラス名
GaucheRefj:コレクションの実装セクションタイトル

他のwebpageからurlで参照したい場合、次のようにしてください。

http://practical-scheme.net/gauche/man/?l=jp&p=receive

更新履歴

2004/08/25 21:28:26 PDT

異なるエンコーディングでサーチワードが与えられた場合に対応。具体的には次の通り：
- フォームパラメータ en が与えられて、それが有効なエンコーディング名であれば、それを信頼してgaucheの内部コードに変換する
- そうでなければ、日本語マニュアルの場合、ces-convertに"*jp"を与えて推測させる

サーチワードに '>' などが含まれる場合を正しく処理。例: GaucheRefe:ssax:xml->sxml

議論

コード

(コードの最新版は、Gaucheの公開CVSリポジトリのGauche-scriptsモジュールから取り出せます)

#!/home/shiro/bin/gosh

(use srfi-2)
(use srfi-13)
(use util.list)
(use file.util)
(use util.match)
(use text.html-lite)
(use www.cgi)
(use gauche.charconv)

(define (pick-from-file rx file)
  (call-with-input-file file
    (lambda (port)
      (let loop ((line (read-line port)))
        (cond ((eof-object? line) #f)
              ((rx line) => (cut <> 1))
              (else (loop (read-line port))))))))

(define (multi-pick-from-file rx file)
  (call-with-input-file file
    (lambda (port)
      (let loop ((line (read-line port))
                 (r    '()))
        (cond ((eof-object? line) (reverse! r))
              ((rx line) =>
               (lambda (m) (loop (read-line port) (cons (m 1) r))))
              (else (loop (read-line port) r)))))))
  
(define (pick-initial initial file)
  (pick-from-file
   (string->regexp #`"<A HREF=\"(.*?)\" style=\"(.*?)\"><b>,(regexp-quote initial)</b></A>")
   file))

(define (pick-index-item item file)
  (pick-from-file
   (string->regexp #`"<A HREF=\"(.*?)\">(?:<CODE>)+,(regexp-quote item)(?:</CODE>)+</A>")
   file))

(define (file-part uri)
  (cond ((string-scan uri "#" 'before))
        (else uri)))

(define (root-file lang)
  (if (eq? lang 'jp) "gauche-refj.html" "gauche-refe.html"))

(define (toc-file lang)
  (if (eq? lang 'jp) "gauche-refj_toc.html" "gauche-refe_toc.html"))

(define (get-indexed-uri basedir index-file name)
  (and-let* ((index-page (pick-initial (string-upcase (string-take name 1))
                                       (build-path basedir index-file)))
             (uri (pick-index-item name
                                   (build-path basedir
                                               (file-part index-page)))))
    uri))

(define (get-index-pages basedir lang)
  (let* ((rx (if (eq? lang 'en)
               #/<A HREF=\"([^\"]*)\">.*(?:Function and Syntax Index|Module Index|Class Index)<\/A>/
               #/<A HREF=\"([^\"]*)\">.*(?:Index - 手続きと構文索引|Index - モジュール索引|Index - クラス索引)<\/A>/))
         (uris (multi-pick-from-file rx (build-path basedir (root-file lang))))
         )
    (map file-part uris)))

(define (search-from-index basedir lang name)
  (match-let1 (fn md cl) (get-index-pages basedir lang)
    (or (get-indexed-uri basedir fn name) ;; from function
        (get-indexed-uri basedir md name) ;; from module
        (cond
         ((#/^&lt\;(.*)&gt\;$/ name)
          => (lambda (m)
               (get-indexed-uri basedir cl (m 1)))) ;; from class
         (else #f)))))

(define (search-from-toc basedir lang name)
  (let1 picker #/<A NAME="[^"]*" HREF="([^"]*)">\d\.[.\d]*\s+([^<]*)<\/A>/
    (call-with-input-file (build-path basedir (toc-file lang))
      (lambda (port)
        (let loop ((line (read-line port)))
          (cond ((eof-object? line) #f)
                ((picker line) =>
                 (lambda (m)
                   (let1 sectitle (regexp-replace-all #/<\/?CODE>/ (m 2) "")
                     (if (equal? name sectitle)
                       (m 1)
                       (loop (read-line port))))))
                (else (loop (read-line port)))))))))
             
(define *base-path* "/home/shiro/shiro.dreamhost.com/scheme/gauche/man")
(define *base-uri*  "http://www.shiro.dreamhost.com/scheme/gauche/man")

(define (main args)
  (cgi-main
   (lambda (params)
     (let* ((lang (cgi-get-parameter "l" params
                                     :default 'en :convert string->symbol))
            (enc  (cgi-get-parameter "en" params))
            (raw-name (cgi-get-parameter "p" params))
            (name (html-escape-string
                   (cond
                    ((and enc (ces-conversion-supported? enc #f))
                     (ces-convert raw-name enc))
                    ((eq? lang 'jp)
                     (ces-convert raw-name "*JP"))
                    (else raw-name))))
            (uri  (or (and name
                           (positive? (string-length name))
                           (if (string-every #[\x21-\x7e] name)
                             (or (search-from-index *base-path* lang name)
                                 (search-from-toc *base-path* lang name))
                             (search-from-toc *base-path* lang name)))
                      (root-file lang))))
       `("Status: 302 Moved\n"
         ,(cgi-header :location (build-path *base-uri* uri)))
       ))))

;; Local variables:
;; mode: scheme
;; end: