Lispboxと同様に、Emacs等を含んだGaucheの配布物を作ろうとする試み。 Gauche:NSISと重複する部分は割愛。
http://sourceforge.net/project/showfiles.php?group_id=25227
Enter the directory which Meadow read .emacs file from. If you do not specify, Meadow reads .emacs file in following directory. [C:\Program Files\Gauchebox\Meadow]通常はここで単に[Enter]を押すことを推奨
※ 注意点: Meadowがすでにインストールされている環境では、GaucheboxはMeadowの設定を上書きする。 Meadowがすでにインストールされている場合はGauche-mingw-<version>.exeをインストールしてください。
http://gauche.svn.sourceforge.net/viewvc/gauche/Gauchebox/
Gauche ;; GaucheのCVS版 Gauchebox ;; Gaucheboxのソースディレクトリ Meadow ;; Meadowのバイナリ配布物 ProgrammingGauche ;; フムフム本のサンプルソース
上記が同じ階層に存在することが前提。
※ うまく統一させたいけど、 現状ではGauche:NSISとは異なります。
;; -*- coding: utf-8 -*-
;; Copyright (c) 2008 ENDO Yasuyuki, All rights reserved.
;; Copyright (c) 2008 Kahua Project, All rights reserved.
;; See COPYING for terms and conditions of using this software
(use file.util)
(use srfi-1)
(use srfi-13)
(use gauche.parameter)
(use gauche.parseopt)
(use text.tree)
(define *instdir* "$INSTDIR")
(define *ignore-path* '("CVS" ".svn"))
(define *target-prefix* " SetOutPath ")
(define *install-prefix* " File ")
(define *delete-prefix* " Delete /REBOOTOK ")
(define *cr-lf* "\r\n")
(define *path-separater* "\\")
(define *file-list* (make-parameter #f))
(define *current-version* (make-parameter #f))
(define (replace-inst prefix path)
(receive (pref last ext)
(decompose-path prefix)
(regexp-replace (string->regexp pref)
path *instdir*)))
(define (file-list path)
(directory-fold
path cons '()
:lister (lambda (path seed)
(receive (d f)
(directory-list2 path :add-path? #t :children? #t)
(values d
(cons (cons path f) seed))))))
(define (check-ignore-path str lis)
(every identity
(map
(lambda (s)
(not (string-contains str s)))
lis)))
(define (initialize dist-list version)
(begin0
(*current-version* version)
(*file-list*
(map
(lambda (path)
(begin
(cons path
(reverse
(filter
(lambda (ls) (and (pair? (cdr ls))
(check-ignore-path (car ls) *ignore-path*)))
(file-list path))))))
dist-list))))
(define (inst-str root-path ls)
(cons
#`",|*target-prefix*|,(change-path (replace-inst root-path (car ls))),|*cr-lf*|"
(map change-path
(map
(lambda (s) #`",|*install-prefix*|,|s|,|*cr-lf*|")
(cdr ls)))))
(define (del-str root-path ls)
(map
(lambda (s) #`",|*delete-prefix*|,(change-path (replace-inst root-path s)),|*cr-lf*|")
(cdr ls)))
(define (install-files)
(append-map
(lambda (ls)
(let1 root-path (car ls)
(map (cut inst-str root-path <>)
(cdr ls))))
(*file-list*)))
(define (delete-files)
(append-map
(lambda (ls)
(let1 root-path (car ls)
(map (cut del-str root-path <>) (cdr ls))))
(*file-list*)))
(define (include line)
(or
(and-let* ((match (#/^(.*)##\(include (.*)\)(.*\r\n)$/ line))
(exp (call-with-input-string (match 2) (cut read <>))))
(list (match 1) (eval exp (current-module)) (match 3)))
line))
(define (include-all lis)
(map include lis))
(define (change-path str)
(string-join (string-split str #\/) *path-separater*))
(define (read-line-crlf file)
(let1 line (read-line file)
(if (eof-object? line) line
#`",|line|,|*cr-lf*|")))
(define (exist-filter path-list)
(filter
(cut file-exist <>)
path-list))
(define (main args)
(let1 path-list '()
(let-args (cdr args)
((path "p|path=s"
=> (lambda (x) (push! path-list x)))
(template "t|template=s" #f)
(version "v|version=s" #f))
(let* ((path-list (filter (cut file-exists? <>) path-list))
(out (path-sans-extension template))
(lines (file->list read-line-crlf template)))
(begin
(initialize path-list version)
(call-with-output-file out
(cut write-tree (include-all lines) <>))
0)))))
(setq scheme-program-name "\"gosh.exe\" -i")
フムフム本の付録Bとの違いは上記のみ。 $INSTDIR\Meadowにコピーされる。
scheme-program-nameで空白を含むパスに対応するために以下を追加。 (thanks: 齊藤さん)
- 齊藤(2008/05/02 04:45:08 PDT): run-scheme の引数や scheme-program-name に空白を含む場合に対処する設定です。
(add-hook 'cmuscheme-load-hook '(lambda() (defun scheme-args-to-list (string) (if (string= string "") nil (let ((where (string-match "[ \t]" string))) (cond ((null where) (list string)) ((not (= where 0)) (let ((qpos (string-match "^\"\\([^\"]*\\)\"" string))) (if (null qpos) (cons (substring string 0 where) (scheme-args-to-list (substring string (+ 1 where) (length string)))) (cons (substring string (match-beginning 1) (match-end 1)) (scheme-args-to-list (substring string (match-end 0) (length string))))))) (t (let ((pos (string-match "[^ \t]" string))) (if (null pos) nil (scheme-args-to-list (substring string pos (length string))))))))))))空白を含むパスや引数をダブルクウォートで囲むことでひとかたまりと認識するようになります。 以下のような使い方を受け付けるようになります。(setq scheme-program-name "\"C:\\Program Files\\gauche\\bin\\gosh.exe\" -i -E \"use slib\"")
setup.nsi.inの-postインストールセクションで以下を実行。
# Included files
!include WordFunc.nsh
!include TextReplace.nsh
(略)
!insertmacro WordReplace
(略)
## replace gosh.exe's full-path in .emacs
${WordReplace} "$INSTDIR\Gauche\bin\gosh.exe" "\" "\\" "+*" $0
${textreplace::ReplaceInFile} "$INSTDIR\Meadow\.emacs" "$INSTDIR\Meadow\.emacs" "gosh.exe" "$0" "/S=1 /C=1 /A0=1" $1
齊藤さんによるビルドを採用。
http://saito.s4.xrea.com/wiliki.scm?Gauche
出来れば自前でビルドしたい。
Meadow/install.exeはデスクトップやスタートメニューにショートカットを作成する。 すでにMeadowがインストール済みの環境ではこれらを上書きしてしまう。
すでにMeadowをインストールしている場合はGaucheboxではなくGauche-win32-0.8.13.exeを推奨。
gosh.exeを単体で起動して日本語表示してみる。
gosh> #\u3042 #\縺・
コードページはMS932な模様。
gosh> (sys-system "dir")
ドライブ C のボリューム ラベルがありません。
ボリューム シリアル番号は 045D-793E です
C:\Documents and Settings\yasuyuki\スタート メニュー\プログラム\Gauchebox のデ
ィレクトリ
2008/05/02 14:44 <DIR> .
2008/05/02 14:44 <DIR> ..
2008/05/02 14:44 1,758 Gauchebox.lnk
2008/05/02 14:44 1,789 Meadow.lnk
2008/05/02 14:44 774 Uninstall Gauchebox.lnk
3 個のファイル 4,321 バイト
2 個のディレクトリ 123,822,731,264 バイトの空き領域
0
gosh> (sys-system "chcp")
現在のコード ページ: 932
0
(add-hook 'inferior-scheme-mode-hook (lambda () (set-buffer-process-coding-system 'utf-8 'utf-8)))
(mw32-ime-initialize) (setq default-input-method "MW32-IME")
Meadow 3なら不要。
rio sosh
yokota (2008/05/02 01:09:49):
yokota (2008/05/02 03:20:47):
えんどう (2008/05/07 01:47:34):