;;; -*- Emacs-Lisp -*-
;;; Multi format Archive file handler for Emacs.
;;; <Marche>
;;; arch.el version 1.12 w/mtools and dmarche
;;; (c) 1993-2000 by HIROSE Yuuji.[yuuji@gentei.org]
;;; Last modified Thu Dec 14 23:09:45 2000 on firestorm
;;; JAPANESE MANUAL BELOW (日本語マニュアルは下の方にあります)
;;;
;;; This program enables your Emacs to walk through an archive file
;;; and to inspect its contents. Now you can say,
;;;
;;; "Mon Emacs marche dans les archives!"
;;;
;;; Document:
;;;
;;; Multi format ARChive file Handler for Emacs: [MARCHE]
;;;
;;;[What is MARCHE?]
;;;
;;; When you visit an archive file created with LHA, ZIP, ARC, or
;;; ARJ after loading MARCHE, the contents of the archive will be
;;; shown in a buffer. In this buffer, you can view, edit or make
;;; other operations to a file by typing some key on the file name.
;;;
;;;[Preparation]
;;;
;;; Since all the extraction or other kinds of jobs will be done
;;; by corresponding archivers, you have to put them in command
;;; search path. Then write the following sentences in your .emacs.
;;;
;;; (defvar am-file-name-regexp "\\.\\(lzh\\|arj\\|arc\\|zip\\|zoo\\)$"
;;; "*Regexp of file-name to be handled with [MARCHE].")
;;; (setq auto-mode-alist
;;; (cons (cons am-file-name-regexp 'marche)
;;; auto-mode-alist))
;;; (autoload 'marche "arch" "Archive file mode." t)
;;;
;;;[Listing Buffer]
;;;
;;; After the preparation of the preceding section, when you open
;;; the file with extension .lzh or so, the editing mode will turn
;;; automatically to archive file mode. And the listing table of the
;;; archive will be displayed in the current buffer. Here are the
;;; key definitions in the listing buffer.
;;;
;;; n, j next line
;;; p, k previous line
;;; C-n / C-p next/previous line without inspection
;;; RET, v view file
;;; LF(C-j) assume cursor position as file field
;;; e, f find file
;;; TAB mark current file
;;; SPACE, m mark current file and next line
;;; BS cancel mark on the previous line
;;; u unpack marked files from archive
;;; d delete marked files in archive
;;; g re-read contents from disk
;;; G ditto(change listing switch of archiver)
;;; * mark files by regexp
;;; z reverse all marks
;;; o other-window
;;; P re-evaluate machine performance
;;; & (tentative) prepare all inspection buffers in background
;;; . inspect current file
;;; ; toggle inspect mode
;;; + / - enlarge/shrink window
;;; q quit
;;;
;;; By default on unix or unix-like OS, MARCHE starts up in
;;; inspect mode in which the contents of file is automatically
;;; shown in other window. You may feel this bothering on the slow
;;; machine or in huge archive files. In those case, you had better
;;; move cursor with standard next-line (C-n) or previous-line
;;; (C-p), or type `;' (semicolon) in the listing buffer to toggle
;;; inspect mode.
;;;
;;;[View Mode]
;;;
;;; Typing return key in the listing buffer extracts the file on
;;; the line of the cursor to the standard output and takes it into
;;; marche-view-mode's buffer. Here are the key definitions of
;;; marche-view-mode.
;;;
;;; SPC / BS scroll up/down by 1 page
;;; j,e / k,y scroll up/down by 1 line
;;; d / u scroll up/down by half window
;;; g / G goto beginning/end of the buffer
;;; o other-window
;;; / isearch forward
;;; ? isearch backward
;;; n repeat previous search forward
;;; N repeat previous search backward
;;; 1 delete-other-windows
;;; 0 beginning-of-line
;;; h help
;;; q quit marche-view-mode
;;;
;;;[Editing Mode]
;;;
;;; By typing `f' in the listing buffer, you can extract the file
;;; at the position of the cursor to the disk and edit it. Of
;;; course, you can edit it normally because it is a normal file on
;;; the disk. In this buffer, save-buffer(C-x C-s by default) saves
;;; the current buffer and updates the archive in which the file
;;; belongs. And kill-buffer(C-x k by default) kills the current
;;; buffer and removes the file extracted temporarily on the disk
;;; (This means that temporary file will remain on the disk when you
;;; kill-emacs without C-x k).
;;;
;;;[Customizations]
;;;
;;; *customizable variables*
;;;
;;; Here are the customizable variables. Parenthesized values are
;;; their defaults.
;;;
;;; am-unpack-tmpdir
;;; Directory name where the file to edit is extracted.
;;; ($TMP, /tmp, /usr/tmp, c:/tmp, / are searched in sequence)
;;; am-inspect-mode
;;; Inspect mode at startup(t, but always nil on DOS)
;;; am-contents-height
;;; Height of inspect buffer(1/3 of screen-height)
;;; am-nonshow-file-names
;;; Regexp of file name require no inspection.
;;; (None. Set the pattern except the value of
;;; am-nonshow-file-names-default which has standard binary
;;; type file names on DOS.)
;;; am-queueing-method
;;; ('newestonly) On file inspection, MARCHE invokes the
;;; archiver to get the head of contents, but doesn't
;;; execute directly those process. All the processes are
;;; stacked onto the process queue if other processes are
;;; running. `am-queueing-method' controls how the new
;;; process request goes into that queue. There are 3
;;; possible methods, 'normal is for historically ordered
;;; queue, 'reverse is for reverse of 'normal, 'newestonly
;;; keeps only the newest one in the queue.
;;; am-discard-process-queue-when-view
;;; (nil) Whether delete the process entry to be done for
;;; file inspection from the queue or not, when you type `v'
;;; (am-view-file) or `.' (am-this-line). By default,
;;; MARCHE restricts the number of simultaneous process for
;;; inspection according to the machine performance which is
;;; automatically checked at the startup of MARCHE. The
;;; process invoked when the number of running processes
;;; exceeds the limit, is only stored to queue and waits for
;;; being executed. Non-nil for this variable cause
;;; deletion of all of the entry of process queue. Notice
;;; that this value cause practical effect only when the
;;; value of am-queueing-method is 'normal or 'reverse.
;;;
;;; *hook variables*
;;;
;;; Here are the all hook variables of MARCHE.
;;;
;;; arc-mode-hook will be parsed at
;;; the end of initialization of MARCHE.
;;; am-view-mode-setup-hook will be parsed at
;;; the initialization of view-mode
;;; am-view-mode-hook will be parsed at
;;; every time before entering view-mode
;;; marche-load-hook will be parsed at
;;; loading this file(at the end of this file).
;;;
;;; *To change archivers*
;;;
;;; By default, MARCHE selects the archiver by the extension of
;;; the file as follows (parenthesized values are for MS-DOS):
;;;
;;; .arc -> arc/arc (parc/parc)
;;; .arj -> ???/unarj (arj/arj)
;;; .lzh -> lha/lha
;;; .zip -> zip/unzip
;;; .zoo -> zoo/zoo
;;;
;;; You can change these settings by setq-ing the Lisp variable:
;;; am-archiver-alist. It is formed as follows.
;;; '( ("EXTENSION" "Archiver(to extract)"
;;; "Switch_to_make_listing_table"
;;; "Switch_to_extract_contents_to_standard_output"
;;; "Switch_to_extract(with force overwriting)"
;;; "Archiver(to make) Switch_to_update"
;;; "Archiver Switch_to_delete_files")
;;; ("EXTENSION" ...)
;;; )
;;; See the value of am-archiver-alist-default as an example, please.
;;;
;;;[Q and A]
;;;
;;; *Error "Sorry unknown table format" occurs.
;;;
;;; Since there are various archivers in the world, some of them
;;; create the listing table that MARCHE cannot analyze (Zoo is one
;;; of them). If you see the error message above, check up the
;;; column of the beginning of the file name field, and make a
;;; declaration with the name of the archiver in your .emacs.
;;;
;;; (put 'zoo 'file-name-column 46)
;;;
;;; Above example tells MARCHE that file name field starts at the
;;; 46th column. If you find any further errors, send a bug report
;;; to me, please.
;;;
;;; *Cursor doesn't go file name field.
;;;
;;; Sometimes file name field goes improper position because file
;;; size is too large and file size field takes too many columns.
;;; In this case, MARCHE fails to extract the file name at view or
;;; edit. To avoid this, move the cursor on the file name field and
;;; type C-j there. MARCHE will assume that position as the file
;;; name field.
;;;
;;; *There is no `overwrite-switch' at extraction with my archiver.
;;;
;;; Write `(put 'ArchiverName 'ask-overwrite t)' in your .emacs.
;;; If there are same files on the destination directory of the
;;; extraction, Emacs will ask you whether you can delete them or
;;; not. However, the extraction is aborted if there are any files
;;; that should not be removed.
;;;
;;; *My archiver does not allow / as a path delimiter(MS-DOS).
;;;
;;; Write (put 'ArchiverName 'use-backslash t) in your .emacs.
;;;
;;; *Can't customize to handle the archive of capital file name.
;;;
;;; Redefining am-file-name-regexp isn't enough. Set the variable
;;; am-archiver-alist to equivalent to the list for downcase
;;; filename (maybe defined in am-archiver-alist-default).
;;; cf. [Customizations]
;;;
;;;[Tricks]
;;;
;;; MARCHE assumes that listing tables output by archivers as follows:
;;;
;;; MARCHE ver 1.12(C)2000 by yuuji |<-titles
;;; Size Time Date Name |<-column table
;;; ----- ----- -------- -------------- |<-section line
;;; 76446 23:09 00/12/14 arch.el |<-table
;;; : | :
;;; ----- ----- -------- -------------- |<-section line
;;;
;;; The important things are the column table and section lines.
;;; Notice that `name' stands for a file name and the section lines
;;; stand for the limits of the file names. The archivers I have
;;; (except zoo) take this format, so I have selected this analysis.
;;;
;;; The name identification of the packed files is done by strings
;;; in the file name column. Therefore, if there exist any files
;;; having same file name, MARCHE is unable to tell one from the
;;; other. This might happen when the archive is listed with `lha
;;; l' so that directory names have been eliminated. If this
;;; happens frequently, change default setting of lha's table
;;; listing switch to "v".
;;;
;;;[Contributors]
;;;
;;; *Ilya Zakharevich: Suggests view mode should be minor.
;;; Fixes the bug shell command quoting.
;;;
;;; Thank you very much.
;;;
;;;[Copying]
;;;
;;; This program is distributed as a free software. The author is
;;; not responsible for any possible defects caused by this
;;; software.
;;;
;;; Comments and bug reports are welcome. Don't hesitated to report.
;;; My possible e-mail address is following.
;;;
;;; yuuji@gentei.org
;;;
;;; Japanese document follows:
;;;
;;; アーカイブファイルモード: marche [まるしぇ]
;;;
;;;【marcheとは】
;;;
;;; LHa, ZIP, ARC, ARJ などのアーカイバを用いて作成されたアーカイ
;;; ブファイルをオープンすると、中に入っているファイル一覧の画面を表
;;; 示します。この画面で、カーソルを目的のファイル名に合わせて操作す
;;; ることで、そのファイルの内容を閲覧したり、編集したりすることがで
;;; きます。
;;;
;;;【準備】
;;;
;;; アーカイブファイルの展開処理等は、全てアーカイバを呼び出すこと
;;; で行っています。各アーカイブファイルを扱うためのアーカイバは用意
;;; しておく必要があります。次に、以下の行を .emacs に入れて下さい。
;;;
;;; (defvar am-file-name-regexp "\\.\\(lzh\\|arj\\|arc\\|zip\\|zoo\\)$"
;;; "*[まるしぇ]を起動するファイル名の正規表現.")
;;; (setq auto-mode-alist
;;; (cons (cons am-file-name-regexp 'marche)
;;; auto-mode-alist))
;;; (autoload 'marche "arch" "Archive file mode." t)
;;;
;;;【一覧画面】
;;;
;;; 前項の設定により、.lzh などの拡張子の付くファイルをオープンす
;;; ると、自動的にアーカイブファイルモードになり、アーカイブファイル
;;; の内容一覧画面が表示されます。この画面でのキー操作には以下のもの
;;; があります。
;;;
;;; n,j 次の行へ
;;; p,k 前の行へ
;;; C-n / C-p ファイルの先頭表示をせずに 次/前 の行へ
;;; RET ファイルの内容の閲覧(view)
;;; LF(C-j) カーソル位置をファイルとみなす
;;; e,f ファイルの編集
;;; TAB ファイルのマーク
;;; SPACE ファイルをマークして次の行へ
;;; BS 直前の行のマークの解除
;;; u マークファイルの展開(unpack)
;;; d マークファイルの削除
;;; g アーカイブファイルの再読み込み
;;; G 同上(アーカイバのリスト表示スイッチ変更)
;;; S SJIS判定優先モードON/OFF
;;; z ファイルのマークの反転
;;; * 正規表現によるファイル一括マーク
;;; o 別ウィンドウへ(other-window)
;;; P マシンパフォーマンス再チェック
;;; & バックグラウンドで全直視内容を用意(試験中)
;;; . カレントファイルの先頭表示
;;; ; ファイル先頭表示モードON/OFF
;;; + / - ウィンドウ拡大/縮小
;;; q 終了
;;;
;;; unixベースのOSではファイル先頭表示モードが有効になっています。
;;; 遅いマシンや大きいアーカイブファイルの中では普通の next-line
;;; (C-n) と previous-line (C-p) でカーソル移動するか、 「;」(セミコ
;;; ロン) を押して直視モードをOFFにした方が良いでしょう。
;;;
;;;【view-mode】
;;;
;;; 一覧画面でリターンキーを押すと、カーソル位置のファイルを(標準
;;; 出力に)展開し、その中味を表示すると共にまるしぇの view-mode に移
;;; 行します。このモードでは、次のキーが使用できます。
;;;
;;; SPC / BS 一画面スクロールアップ/ダウン
;;; j,e / k,y 一行スクロールアップ/ダウン
;;; d / u 半画面スクロールアップ/ダウン
;;; g / G ファイルの先頭へ/末尾へ
;;; o 隣のウィンドウへ
;;; / 前方検索
;;; ? 後方検索
;;; n 前方再検索
;;; N 後方再検索
;;; 1 全画面化
;;; 0 カーソルを行頭へ
;;; h ヘルプ
;;; q view-mode を抜ける
;;;
;;;【編集モード】
;;;
;;; 一覧画面で f を押すことにより、カーソル位置のファイルを(ディス
;;; ク上に)展開し、そのファイルを編集します。これは普通のファイルな
;;; ので、一般のファイルと同様に編集できます。ただし、通常時に
;;; save-buffer が割当てられているキー(標準で C-x C-s)を押すと、カレ
;;; ントバッファをセーブすると同時にアーカイブ中の該当ファイルを更新
;;; します。同様に、通常時 kill-buffer が割当てられているキー(標準で
;;; C-x k)を押すと、カレントバッファを削除すると共にディスク上に臨時
;;; に展開したファイルを消去します(逆に C-x k せずに Emacs を終了す
;;; ると臨時ファイルがディスク上に残ります)。
;;;
;;;【カスタマイズ】
;;;
;;; ・カスタマイズ変数
;;;
;;; 動作を決定する以下の変数が設定可能です。括弧内に示されているも
;;; のがデフォルト値です。
;;;
;;; am-unpack-tmpdir
;;; edit-file で一時的にファイルを展開するディレクトリ
;;; (環境変数TMP, /tmp, /usr/tmp, c:/tmp, / の順で参照)
;;; am-inspect-mode
;;; ファイルの先頭表示モード(t ただしMSDOSでは常にnil)
;;; am-contents-height
;;; ファイルの先頭表示バッファの高さ(画面の1/3)
;;; am-nonshow-file-names
;;; ファイルの先頭表示をしないファイル名の正規表現
;;; (なし。am-nonshow-file-names-default にDOSの標準的なバイ
;;; ナリファイルのパターンが設定されているのでその値以外を
;;; 設定します)
;;; am-queueing-method
;;; ファイルの先頭表示のために起動するプロセスは一旦キューに
;;; 入れられて順次起動されますが、プロセスをキューに入れる方
;;; 法を指定します。プロセスの発生した順番にキューに入れる時
;;; は 'normal を、 逆順に入れる時は 'reverse を、古いキュー
;;; は捨てて新しいものだけを入れる時は 'newestonly を指定し
;;; ます(デフォルトは 'newestonly)。 ある程度高速なマシンで
;;; は 'reverse を指定するとカーソルをたくさん動かした時にも
;;; カーソル位置のファイルの内容の表示が優先されるので快適で
;;; す。
;;; am-discard-process-queue-when-view
;;; v による am-view-file および . による am-this-line の時
;;; に、ファイルの先頭表示をするために起動するためのプロセス
;;; の予定表を消去するかどうか(nil)。 デフォルトではファイル
;;; 一覧画面で n や p を連打したときにファイルの先頭部を表示
;;; させるためのプロセスを複数起動することになりますが、まる
;;; しぇでは組み込み時に測ったマシンの能力に応じて同時に起動
;;; するプロセス個数の上限を決めています。上限を超えている時
;;; に発生したプロセス起動要求はキューに入れられて順次起動さ
;;; れるのを待ちます。この変数を nil 以外にセットするとキュー
;;; に入っている起動予定プロセスをすべて削除します。
;;; am-queueing-method の値が 'normal か 'reverse の時にのみ
;;; 実用的な意味をもちます。
;;;
;;; ・hook変数
;;;
;;; 次の hook 変数を用意しています。
;;;
;;; arc-mode-hook
;;; arc-mode の初期化が終わった時
;;; am-view-mode-setup-hook
;;; ファイル閲覧の view-mode のキーマップ設定時
;;; am-view-mode-hook
;;; ファイル閲覧の view-mode に入った時
;;; marche-load-hook
;;; このファイルをロードする時(ファイルの最後)
;;;
;;; ・アーカイバの変更
;;;
;;; 標準設定では、ファイルの拡張子により、次のアーカイバ(圧縮用/展
;;; 開用)を使用するようになっています(括弧内はMS-DOSでの設定)。
;;;
;;; .arc → arc/arc (parc/parc)
;;; .arj → ???/unarj (arj/arj)
;;; .lzh → lha/lha
;;; .zip → zip/unzip
;;; .zoo → zoo/zoo
;;;
;;; この設定は、Lisp 変数 am-archiver-alist によって行います。これは、
;;; '( ("拡張子" "(展開用)アーカイバ名"
;;; "ファイルリスト表示用スイッチ"
;;; "ファイルを標準出力に書き出すスイッチ"
;;; "(強制上書きオプション付き)展開スイッチ"
;;; "(圧縮用)アーカイバ名 更新スイッチ"
;;; "アーカイバ名 ファイル削除スイッチ")
;;; ("拡張子" ... 以下同様 )
;;; )
;;; のように設定します。具体例は、変数 am-archiver-alist-default の
;;; 値を参照して下さい。
;;;
;;;【こんな時は】
;;;
;;; ・"Sorry unknown table format" と言われてしまう。
;;;
;;; 世の中いろいろアーカイバがあるので、「まるしぇ」で解析できない
;;; 書式のテーブルを表示するものがあるかもしれません(実はzooもその一
;;; つ)。もしお手持ちのアーカイバのテーブル表示に対して、このメッセー
;;; ジが表示されたら、そのバッファのテーブルのファイル名フィールドの
;;; カラム位置を調べ、その時のアーカイバの名前と共に次のような宣言を
;;; して下さい。
;;;
;;; (put 'zoo 'file-name-column 46)
;;;
;;; 上の例は、zoo の出力するテーブル表示に対して、ファイル名フィール
;;; ドが46カラム目から始まることを「まるしぇ」にあらかじめ教え込みま
;;; す。もし、これを指示しても unknown と出た場合は、作者までご一報
;;; 下さい。
;;;
;;; ・リスト表示のファイル名が予定の位置からずれてしまう。
;;;
;;; ファイルが巨大でサイズを表す数字の桁が大きく右にはみ出てしまっ
;;; たりして、ファイル名フィールドが予定の位置からずれてしまう(nやp
;;; で移動した時にファイル名の先頭にカーソルが行かない)ことがありま
;;; す。こうなると、view しようとしても正しいファイル名を取得できな
;;; くなってしまいます。このようなときは、いったんカーソルをファイル
;;; 名の上に移し、そこで C-j を押します。それ以後ファイル名フィール
;;; ドをカーソル位置の場所であるとみなします。
;;;
;;; ・アーカイバに展開時の強制上書きスイッチがない。
;;;
;;; (put 'アーカイバ名 'ask-overwrite t) として下さい。もし、展開
;;; 先ディレクトリに同名のファイルがあった場合、それを消去して良いか
;;; Emacs 側で質問します。ただし、一つでも消してはいけないファイルが
;;; あった場合は、展開を中止します。
;;;
;;; ・パスデリミタとして \ しか認めない(MS-DOS)。
;;;
;;; (put 'アーカイバ名 'use-backslash t) として下さい。
;;;
;;; ・大文字のファイル名を扱えるようにカスタマイズできない。
;;;
;;; am-file-name-regexp に大文字パターンを定義するだけでは不十分で
;;; す。変数 am-archiver-alist に、小文字の時に使う定義の「拡張子」
;;; の部分を大文字に変えたものを定義してください(【カスタマイズ】の
;;; 項参照)。
;;;
;;;【種明かし】
;;;
;;; ・テーブルフォーマット
;;;
;;; アーカイバの出力するテーブルは、次のようなフォーマットであると
;;; 仮定しています。
;;;
;;; MARCHE ver 1.12(C)2000 by yuuji |←タイトルなど
;;; Size Time Date Name |←項目見出し
;;; ----- ----- -------- -------------- |←上罫線
;;; 76446 23:09 00/12/14 arch.el |←実際のテーブル
;;; : | :
;;; ----- ----- -------- -------------- |←下罫線
;;;
;;; これらのうち重要なのは、項目見出しと上下罫線です。項目見出しの
;;; うちファイル名を示すものに `name' という文字列が含まれることと、
;;; 上下罫線がテーブルの上下範囲を示している必要があります。手元のアー
;;; カイバでは(zoo以外)どれもこのフォーマットに基づいていたので、こ
;;; のような解析方法を採用しました。
;;;
;;; ・アーカイブファイル中のファイル名
;;;
;;; 中味のファイルの識別は、ファイル名フィールドの文字列(つまり表
;;; 示するファイル名)によって行っています。従って、一アーカイブ中に
;;; 同じファイル名のものがあった場合、「まるしぇ」はそれを区別出来ま
;;; せん。これが問題になるのは、lha l によって、ディレクトリ名が省略
;;; されている場合でしょうから、このようなケースが多い方は、lha用の
;;; デフォルトの「テーブル表示スイッチ」を "v" として下さい。
;;;
;;;【謝辞】
;;;
;;; Nop.Mさん, Paciさん, Rijさん, bauerさん, かずやさん, たりゃー
;;; 佐々木さん, ほんまたけるさん, りゅさんには ASCII-NET において貴
;;; 重なコメントを頂きました。慶應義塾大計算機科学専攻の三平善郎君に
;;; はバグ報告を、同管理工学科の森川修君には動作報告と仕様に関する助
;;; 言を、京都大学大学院文学研究科の奥西藤和さんにはWin32系Mule対応
;;; 時のコメントを頂きました。ここに感謝申し上げます。
;;;
;;;【取り扱い】
;;;
;;; このプログラムは、フリーソフトウェアとして配布いたします。この
;;; プログラムを使用して生じたいかなる結果に対しても作者は一切の責任
;;; を負わないものといたしますが、コメントやバグレポートは大いに歓迎
;;; いたします。お気軽にご連絡下さい。連絡は以下のアドレスまでお願い
;;; いたします(1999/9現在)。
;;; yuuji@gentei.org
(defconst am-version
"$Id: arch.el,v 1.13 2000/12/14 14:10:06 yuuji Exp $"
"Version number of running marche.")
(defvar am-on-dos (memq system-type '(ms-dos OS/2 emx windows-nt))
"T if marche is running on DOS or its relivatives.")
(defvar am-file-ignore-case
(or am-on-dos (eq system-type 'vax-vms))
"T if marche is running on OS which ignores file name case.")
(defvar debug (string= (getenv "USER") "yuuji"))
(defconst am-emacs-18 (string= "18" (substring emacs-version 0 2)))
(defconst am-emacs-19 (string= "19" (substring emacs-version 0 2)))
(defvar am-archiver-alist nil
"*Customizable association list of filename pattern to using archiver.")
(defvar am-file-name-regexp "\\.\\(lzh\\|arj\\|arc\\|zip\\|zoo\\)$"
"*Regexp of file name Arc mode should begin.")
(defvar am-command-option
(or (and (boundp 'shell-command-option) shell-command-option)
(and (memq system-type '(ms-dos OS/2 emx)) "/c")
"-c"))
(defvar am-archiver-alist-default
(list
;; ext cmd view print extract udpate delete
;; quiet quiet overwrt with command with command
(if am-on-dos
'("lzh" "lha" "v" "p -n2" "e -xmc" "lha u" "lha d")
'("lzh" "lha" "l" "ptq" "xvf" "lha u" "lha d"))
(if am-on-dos
'("arc" "parc" "v" "p" "xo" "parc a" "parc d")
'("arc" "arc" "l" "p" "e" "arc u" "arc d"))
'("zip" "unzip" "-l" "-p" "-xo" "zip -u" "zip -d")
(if am-on-dos
'("arj" "arj" "v" "p" "x -y" "arj u" "arj d")
'("arj" "unarj" "v" "p" "x -y" "echo Sorry." "echo sorry"))
'("zoo" "zoo" "l" "ep" "eSO" "zoo u" "zoo D")
)
"Default association list of filename extension to archiver and its
miscellaneous switches. It consists of following elements:
'((\"EXT\" \"ARCHIVER\" \"LIST\" \"PRINT\" \"EXTRACT\" \"UPDATE\" \"DELETE\")
...)
EXT is the extension of file name, ARCHIVER is the name of archiver to
handle the file whose extension is EXT, LIST is the switch(option) of
archiver for listing contents, PRINT is the switch to print contents of
file (in archive) to standard output, EXTRACT is the switch to extract
file without overwrite-ask, UPDATE is the both archiver name and its
switch to update file, and DELETE is also the archiver name and its
deletion switch.")
(if (not am-on-dos) nil
(put 'parc 'ask-overwrite t)
(put 'lha 'hack-stdin t)
(put 'arj 'use-backslash t))
(put 'zoo 'file-name-column (if am-on-dos 46 49))
(defvar am-table-begin-regexp "^[ \t]*[-=][-=][-=][-=]"
"Regexp of the top edge of archive listing table.")
(defvar am-table-end-regexp "^[ \t]*[-=][-=][-=][-=]"
"Regexp of the bottom edge of archive listing table.")
(defvar am-file-name-column nil)
(defvar am-delete-buffer "*delete*")
(defvar am-update-buffer "*update*")
(defvar am-unpack-buffer "*Unpack*")
(defvar am-unlink-command "rm -f"
"*Name of command string to unlink files.")
(defvar am-unpack-tmpdir
(or (if (and am-on-dos debug) "j:/tmp")
(getenv "TMP")
(and (file-directory-p "/tmp") "/tmp") ;for UN*X
(and (file-directory-p "/usr/tmp") "/usr/tmp")
(and (file-directory-p "c:/tmp") "c:/tmp") ;for DOS
"/")
"*Directory where extraction of the file from archive will be done.
By default, edited file will be extacted into directory where
(getenv \"TMP\") indicates. If you want extract them into other directory,
set that name in this variable.")
(defmacro am-get-command (x) (list 'nth 1 x))
(defmacro am-get-listing (x) (list 'nth 2 x))
(defmacro am-get-print (x) (list 'nth 3 x))
(defmacro am-get-extract (x) (list 'nth 4 x))
(defmacro am-get-update (x) (list 'nth 5 x))
(defmacro am-get-delete (x) (list 'nth 6 x))
(defmacro am-detect-range () (list 'min 5000 (list 'point-max)))
(defvar am-nemacs-raw-code 3)
(defvar am-sjis-flag am-on-dos
"Assume file contents consist of sjis.")
(defvar am-archive-file-name nil "Holds file name of the archive.")
(defvar am-parent-buffer nil "Holds the parent archive file name.")
(defvar am-children-list nil
"Holds the children buffer names of Arc mode buffer.")
(setq-default am-children-list nil)
(defvar am-favorite-listing nil
"Keeps the temporary listing switch to view listing of the table.")
(defvar am-protected-locals
'(am-archive-file-name
am-children-list am-favorite-listing
am-parent-buffer am-update-command am-update-flag))
(defvar kill-buffer-hook nil)
(mapcar (function (lambda (var)
(cond
(am-emacs-18
(if (not (memq var *protected-local-variables*))
(setq *protected-local-variables*
(cons var *protected-local-variables*))))
(am-emacs-19
(put var 'permanent-local t)))))
am-protected-locals)
;;;
;; Version 1.x
;;;
(defconst am-can-inspect (and (fboundp 'start-process)
(fboundp 'set-process-sentinel)
(fboundp 'interrupt-process))
"Non-nil if running OS can have multi process.")
(defvar am-inspect-mode am-can-inspect
"*Non-nil for viewing the contents of file on other window.")
(defvar am-contents-height (/ (screen-height) 3)
"*Window height of the file-contents buffer.")
(defvar am-current-process nil
"Holds process object.")
(defvar am-nonshow-file-names-default
"\\.\\(com\\|exe\\|obj\\|o\\|dvi\\|lib\\|a\\|dll\\|fmt\\|.df\\|tar\\|taz\\|tgz\\)$"
"Inihibit showing contents on this filename.")
(defvar am-nonshow-file-names nil)
(setq am-nonshow-file-name-regexp
(concat am-file-name-regexp "\\|"
(if am-nonshow-file-names (concat am-nonshow-file-names "\\|"))
am-nonshow-file-names-default))
(defvar am-process-queue nil "Queue used for process of inspection.")
(defvar am-queueing-method 'newestonly
"*Method of queueing of process for inspection.
Possible methods are...
'normal new process entry goes to bottom of queue.
'reverse new process entry goes top of queue.
'newestonly keeps only newest process request.")
(defvar am-discard-process-queue-when-view nil
"*Whether discard process queue of am-start-proc-with-queue or not.
If non-nil, discard process queue (not running yet) when
`view-file' entered. If you want to see all the headers of files, set this
variable to nil.")
;;;
;; Marche functions
;;;
(defun am-version ()
(interactive)
(message am-version))
(defun am-toggle-inspect ()
(interactive)
;;(if (not am-can-inspect)
;; (error "Can't enter inspect mode on this system(%s)." system-type))
(setq am-inspect-mode (not am-inspect-mode))
(message "Set inspect mode %s" (if am-inspect-mode "ON" "OFF")))
(defun am-toggle-sjis-flag ()
(interactive)
(setq am-sjis-flag (not am-sjis-flag))
(message "Set SJIS flag %s" (if am-sjis-flag "ON" "OFF")))
(defun am-refresh-kanji (&optional proc mes)
"Check kanji code of currnet buffer and refresh it to be readable."
(let (code (buffer-read-only nil) pbuf
(sw (selected-window)))
(save-excursion
(if (and proc (processp proc) (setq pbuf (process-buffer proc))
(buffer-name pbuf))
(set-buffer pbuf))
(setq buffer-read-only nil)
(cond
((and pbuf (null (buffer-name pbuf)));;killed buffer
nil) ;maybe canceled
((and (boundp 'MULE) (string< (substring mule-version 0 3) "1.1"))
(setq code
(detect-code-category (point-min) (am-detect-range)))
(if (listp code) (setq code (car code)))
(if (eq code t) nil
(code-convert (point-min) (point-max) code *internal*)
(if (and proc (not (eq code '*internal*)))
(set-process-coding-system proc code code))))
((boundp 'NEMACS)
(setq code (check-region-kanji-code (point-min) (am-detect-range)))
;;(message "Guess it as %s in %s" code (buffer-name))(sit-for 2)
(if (and code (not (eq am-nemacs-raw-code code)))
(progn
(convert-region-kanji-code
(point-min) (point-max) code am-nemacs-raw-code)
(if proc (set-process-kanji-code proc code))))))
(if (and am-emacs-19 (get-buffer-window pbuf))
(progn
(select-window (get-buffer-window pbuf))
;(recenter -1)
(goto-char (point-min))
(select-window sw))))
(set-buffer-modified-p nil)))
(defun am-quote-each-word (string)
"Quote each word by single quotation."
(if (string-match "^\\(command\\|cmd\\)" shell-file-name)
string ;quoting not required on DOSish shells
(let ((s "") (i 0) match
(quote (if (or (eq system-type 'emx) ;???
(string-match "'" string))
"\"" "'")))
(while (and (< i (length string))
(setq match (string-match " " string i)))
(setq s (concat s quote (substring string i match) quote " ")
i (1+ match)))
(concat s quote (substring string i) quote))))
(defun am-call-command (cmd buf &optional convert)
"Call process CMD and put output into buffer BUF.
If optional third arg CONVERT is `t', check current kanji coding-system of
output string and convert it into displayable one."
(let ((default-kanji-process-code (if am-sjis-flag 1 3))
(default-process-coding-system
(and (boundp 'MULE)
(list (if am-sjis-flag *sjis* *autoconv*)))))
(if am-emacs-19 (cd default-directory))
(call-process shell-file-name nil buf 1
am-command-option
(am-quote-each-word cmd)))
(if convert (am-refresh-kanji)))
(defun am-convert-slash (path)
"Covert path delimiter from / to \\."
(let ((p (copy-sequence path))(i 0)(len (length path)))
(while (< i len)
(if (= (aref p i) ?/) (aset p i ?\\ ))
(setq i (1+ i)))
p))
(defun am-convert-backslash (path)
"Convert path delimiter from \\ to /."
(let ((p (copy-sequence path))(i 0)(len (length path)))
(while (< i len)
(if (= (aref p i) ?\\ ) (aset p i ?/))
(setq i (1+ i)))
p))
(defun am-make-directory (dir)
"Make directory DIR."
(am-call-command
(concat "mkdir " (if am-on-dos (am-convert-slash dir) dir)) nil)
(if (file-directory-p dir) nil
(error "Cannot create %s." dir)))
(defun am-build-command (type list file &optional arg)
"Build a command line to handle an archive.
TYPE is job type, LIST is a list of archive operations and FILE
is the archive file name."
(let ((cmd (am-get-command list)))
(if (get (intern cmd) 'use-backslash)
(setq file (am-convert-slash (copy-sequence file))))
(cond
((eq type 'listing)
(concat cmd " "
(or am-favorite-listing
(am-get-listing list))
" " file
(if (get (intern cmd) 'hack-stdin) " *.*")))
((eq type 'print)
(concat cmd " " (am-get-print list) " " file))
((eq type 'extract)
(concat cmd " " (am-get-extract list) " " file " " arg))
((eq type 'delete)
(concat (am-get-delete list) " " file " " arg))
((eq type 'update)
(concat (am-get-update list) " " file " " arg)))))
(defun am-get-file-name ()
"Get the file name on the current line."
(cond
((am-on-file-name-line-p)
(move-to-column am-file-name-column)
(if (= (current-column) am-file-name-column)
(buffer-substring
(point)
(save-excursion
(skip-chars-forward "^ \t\n" (am-point-end-of-line)) (point)))))
(t nil)))
(defun am-prepare-view-contents (buffer)
"Prepare the buffer that shows the contents of thie file in archive."
(message "Call: %s..." cmd)
(if am-can-inspect
(let ((process-coding-system-alist
(cons (cons "." 'sjis-dos) process-coding-system-alist))
code pmax)
(if am-discard-process-queue-when-view (am-flush-process-queue))
(make-local-variable 'am-current-process)
(set-buffer buffer) ;for assertion
(setq am-current-process
(start-process "marche:View" buffer shell-file-name
am-command-option cmd))
(if (boundp 'MULE)
(set-process-coding-system
am-current-process (if am-sjis-flag *sjis* *autoconv*) nil))
(set-process-sentinel am-current-process ;;do nothing on exit
'(lambda (proc mes) ())
;;; 'am-refresh-kanji
)
(sit-for 1)
(while (and (= (point) (point-min))
(eq (process-status am-current-process) 'run))
(goto-char (point-max)) (sleep-for 1)) ;;sit-for is not good.
(cond
((or (boundp 'NEMACS) (boundp 'MULE))
;;(set-buffer buffer)
;;(setq code (check-region-kanji-code
;; (point-min) (setq pmax (point-max))))
;;(if (and code (not (eq am-nemacs-raw-code code)))
;; (progn
;; (set-process-kanji-code am-current-process code)
;; (convert-region-kanji-code
;; (point-min) pmax code am-nemacs-raw-code)))
(am-refresh-kanji am-current-process)
)))
(am-call-command cmd buffer t))
(goto-char (point-min))
(switch-to-buffer buffer))
;;-------------------- am-view-mode starts --------------------
(defun am-view-k (arg)
"Marche view mode: scroll down 1 line."
(interactive "p")
(scroll-down arg))
(defun am-view-j (arg)
"Marche view mode: scroll up 1 line."
(interactive "p")
(scroll-up arg))
(defun am-view-d (arg)
"Marche view mode: scroll up half a page."
(interactive "P")
(if arg
(scroll-up arg)
(scroll-up (/ (window-height) 2))))
(defun am-view-u (arg)
"Marche view mode: scroll down half a page."
(interactive "P")
(if arg (scroll-down arg)
(scroll-down (/ (window-height) 2))))
(defun am-view-SPC ()
"Marche view mode: scroll up 1 page."
(interactive)
(scroll-up (- (window-height) 2)))
(defun am-view-BS ()
"Marche view mode: scroll down 1 page."
(interactive)
(scroll-down (- (window-height) 2)))
(defun am-view-bottom ()
"Marche view mode: go to end of buffer."
(interactive)
(set-mark-command nil)
(goto-char (1- (point-max))))
(defun am-view-q ()
"Marche view mode: quit."
(interactive)
(cond
(buffer-file-name ;maybe saved onto other file
(setq marche:view nil)
(set-buffer-modified-p (buffer-modified-p))
(setq buffer-read-only nil)
(normal-mode))
(am-view-parent
(let ((parent am-view-parent))
(set-buffer-modified-p nil)
(bury-buffer)
(if (and parent (get-buffer parent)) (switch-to-buffer parent))))))
(defun am-view-search-next (arg)
"Marche view mode: Continuous search forward."
(interactive "p")
(search-forward (if am-emacs-19 (car search-ring) search-last-string)
nil t arg))
(defun am-view-search-prev (arg)
"Marche view mode: Continuous search backward."
(interactive "p")
(search-backward (if am-emacs-19 (car search-ring) search-last-string)
nil t arg))
(defvar am-view-mode-map nil
"Key map used in view-mode in Arc mode.")
(defvar am-view-mode nil "marche:view-mode indicator")
(or (assq 'am-view-mode minor-mode-alist)
(setq minor-mode-alist
(append (cons '(am-view-mode " marcheV") minor-mode-alist))))
(defun am-set-view-mode-map ()
"Set `less' oriented extended view mode map."
(if am-view-mode-map nil
(setq am-view-mode-map (make-sparse-keymap))
;;(suppress-keymap am-view-mode-map) ;doesn't work on 18
(define-key am-view-mode-map "0" 'beginning-of-line)
(define-key am-view-mode-map "1" 'delete-other-windows)
(define-key am-view-mode-map " " 'am-view-SPC)
(define-key am-view-mode-map "\C-h" 'am-view-BS)
(define-key am-view-mode-map "\C-?" 'am-view-BS)
(define-key am-view-mode-map "b" 'am-view-BS)
(define-key am-view-mode-map "j" 'am-view-j)
(define-key am-view-mode-map "e" 'am-view-j)
(define-key am-view-mode-map "k" 'am-view-k)
(define-key am-view-mode-map "h" 'describe-mode)
(define-key am-view-mode-map "y" 'am-view-k)
(define-key am-view-mode-map "/" 'isearch-forward)
(define-key am-view-mode-map "?" 'isearch-backward)
(define-key am-view-mode-map "n" 'am-view-search-next)
(define-key am-view-mode-map "N" 'am-view-search-prev)
(define-key am-view-mode-map "d" 'am-view-d)
(define-key am-view-mode-map "u" 'am-view-u)
(define-key am-view-mode-map "o" 'other-window)
(define-key am-view-mode-map "g" 'beginning-of-buffer)
(define-key am-view-mode-map "<" 'beginning-of-buffer)
(define-key am-view-mode-map ">" 'am-view-bottom)
(define-key am-view-mode-map "G" 'am-view-bottom)
(define-key am-view-mode-map "q" 'am-view-q)
(run-hooks 'am-view-mode-setup-hook)))
(defvar am-view-parent nil "Keeps parent buffer of view buffer.")
(defun am-view-mode (&optional editable)
"View mode for marche.
scroll up (page): \\[am-view-SPC]
scroll down(page): \\[am-view-BS]
scroll up (half): \\[am-view-d]
scroll down(half): \\[am-view-u]
scroll up (line): \\[am-view-j]
scroll down(line): \\[am-view-k]
beginning of buf: \\[beginning-of-buffer]
end of buf: \\[am-view-bottom]
beginning of line: \\[beginning-of-line]
delete other windows: \\[delete-other-windows]
quit: \\[am-view-q]
"
(interactive "p")
(let ((buffer-file-name file))
(normal-mode t))
;;(setq mode-name "marche:view" major-mode 'am-view-mode)
(am-set-view-mode-map)
(setq buffer-read-only (not editable))
(make-local-variable 'am-view-parent)
(make-local-variable 'am-view-mode)
(setq am-view-mode t)
(set-buffer-modified-p (buffer-modified-p))
(use-local-map (append am-view-mode-map (current-local-map)))
(run-hooks 'am-view-mode-hook))
(defun am-view-mode-entry (parent)
(am-view-mode nil)
(setq am-view-parent parent))
;;-------------------- am-view-mode ends --------------------
(defun am-view-buffer-name (archive file)
"Return the buffer name of view-buffer."
(concat "*" file " in "
(if (eq major-mode 'mtools-mode) archive
(file-name-nondirectory archive))
"*"))
(defun am-show-buffer-name (archive file)
"Return the buffer name of show-buffer."
(concat "*"
(if (eq major-mode 'mtools-mode) archive
(file-name-nondirectory archive))
":" file "*"))
(defun am-view-file ()
"Call archive print command to view contents of file."
(interactive)
(if (not (am-on-file-name-line-p)) (error "Not on file name."))
(let*((curbuf (current-buffer))
(file (am-get-file-name))
(archive
(if (eq major-mode 'mtools-mode) am-archive-file-name
(file-name-nondirectory am-archive-file-name)))
(buffer (am-view-buffer-name am-archive-file-name file))
(cmd (concat (am-build-command
'print am-archive-list archive) " "
(am-quote-each-word file))))
(if (get-buffer buffer)
(switch-to-buffer buffer)
(setq am-children-list (cons buffer am-children-list))
(set-buffer (get-buffer-create buffer))
(erase-buffer)
(am-prepare-view-contents buffer)
(goto-char (point-min))
(set-buffer-modified-p nil)
(am-view-mode-entry curbuf))))
(defun am-message-job-done (joblist)
"Print the message when a job is done."
(message "Process [%s...] done."
(substring (nth 1 joblist) 5
(min (- (screen-width) 12) (length (nth 1 joblist))))))
(defun am-suitable-max-process ()
"Guess the number of processes Emacs can run smooth at the same time.
** This version returns purely tentative score! **
** PLEASE TELL ME PROPERER VALUE **
"
(let ((curtime (current-time-string)) time (i 0) result
(mes "Checking your machine/system's performance."))
(message "%s." mes)
(while (string= curtime (current-time-string)))
(message "%s.." mes)
(setq curtime (current-time-string))
(while (string= curtime (current-time-string))
(setq i (1+ i)))
(setq result
(cond ((< i 1000) 1) ;maybe under 486SX(20MHz) or Sparc1
((< i 2000) 2) ;maybe under Sparc1+
((< i 3000) 3) ;maybe under Sparc2
((< i 5000) 4) ;maybe under Sparc10
((< i 10000) 5) ;???
((< i 20000) 6) ;maybe under MMX Pentium 200MHz class
(t 10) ;K6III400MHz, Celeron350MHz...sigh...
))
(message "%s...Done(count:%d, level:%d)" mes i result)
(sit-for 1) ;bothering?? (^^;)
result))
(defvar am-max-process (am-suitable-max-process)
"*Maximum number of process running at the same time.")
(defun am-set-max-process ()
(interactive)
(setq am-max-process (am-suitable-max-process)))
(defvar am-header-lines (max (* 2 (screen-height)) (* 200 am-max-process))
"*Lines to extract a file in archive for an inspection buffer.")
(defun am-chop-queue (entry)
"Chop the process entry ENTRY in am-process-queue."
(if (null am-process-queue)
(progn
(am-message-job-done entry)
(setq am-running-process nil))
(let ((qlist am-process-queue) (i 0) (len (length am-process-queue)) queue)
(if (null
(catch 'found
(while (< i len)
(if (equal (nth i am-process-queue) entry) (throw 'found t))
(setq i (1+ i)))))
(progn
(am-message-job-done entry)
;;(error "Process queueing failed. Send bug report to author.")
))
(if (= i 0)
(setq am-process-queue (cdr am-process-queue))
(let ((x (nthcdr (1- i) am-process-queue)))
(setcdr x (nthcdr (1+ i) am-process-queue))))
(if (setq queue (nth (1- am-max-process) am-process-queue))
(am-start-proc-with-queue
(nth 0 queue) (nth 1 queue) (nth 2 queue) t)))))
(defvar am-running-process nil "Keeps current running process.")
(defun am-start-proc-with-queue (buffer command sentinel &optional chop quiet)
"Start process limiting the number of running process at the same time.
BUFFER, COMMAND, SENTINEL are passed to start-process. Optional 4th arg
CHOP is set to non-nil when the call to this function is from am-chop-queue."
(let (entry proc (len (length am-process-queue)))
(setq entry (list buffer command sentinel))
(if (null chop)
(cond
((eq am-queueing-method 'normal)
(setq am-process-queue (append am-process-queue (list entry))))
((eq am-queueing-method 'reverse)
(if (<= len am-max-process)
(setq am-process-queue (append am-process-queue (list entry)))
(setcdr (nthcdr (1- am-max-process) am-process-queue)
(cons entry (nthcdr am-max-process am-process-queue)))))
((eq am-queueing-method 'newestonly)
(if (< len am-max-process)
(setq am-process-queue (append am-process-queue (list entry)))
(setcdr (nthcdr (1- am-max-process) am-process-queue)
(list entry)))))
)
(setq am-max-process (max 1 am-max-process))
(if (or (and (> (length am-process-queue) am-max-process) (null chop))
(null (get-buffer buffer)))
nil
(or quiet (eq (selected-window) (minibuffer-window))
(message "Starting %s..." command))
(save-excursion
(set-buffer buffer)
(erase-buffer)
(insert " ") ;???
(setq am-running-process
(start-process
"marche:show" buffer shell-file-name am-command-option command))
(set-marker (process-mark am-running-process) (point-max))
(goto-char (point-min)))
(if (featurep 'mule)
(set-process-coding-system
am-running-process
(if am-sjis-flag (if (boundp '*sjis*) *sjis* sjis-dos)
(if (boundp '*autoconv*) *autoconv* 'undecided)) nil))
(set-process-sentinel
am-running-process
(list 'lambda '(proc mes)
'(condition-case err
(save-excursion
(set-buffer (process-buffer proc))
(delete-char 1))
(error nil))
(list sentinel 'proc 'mes)
(list 'am-chop-queue (list 'quote entry))))))
)
(defun am-flush-process-queue ()
"Flush the proces queue."
(if am-process-queue
(let ((curbuf (current-buffer)))
(mapcar '(lambda (entry)
(let ((buf (car entry)))
(if (and (or (bufferp buf) (stringp buf))
(get-buffer buf))
(progn
(set-buffer buf)
(if (= (buffer-size) 0)
(kill-buffer buf))))))
am-process-queue)
(set-buffer curbuf)))
(setq am-process-queue nil))
(defun am-show-contents (file &optional background)
"Show the head of file contents in the next window."
;;(if (not am-can-inspect)
;; (error "You can't inspect the head of file on this system."))
(let*((archive
(if (eq major-mode 'mtools-mode) am-archive-file-name
(file-name-nondirectory am-archive-file-name)))
proc (arclist am-archive-list)
(viewbuffer (am-view-buffer-name archive file))
(showbuffer (am-show-buffer-name archive file))
buf (win (selected-window)) (curbuf (current-buffer))
(nulbuf "*marche*") (case-fold-search am-file-ignore-case))
(cond ;;`buf' should be set in each condition.
;;dired-mode hack
((eq major-mode 'dired-mode) (am-dired-prepare-contents))
;;if file name matches with binary file name regexp.
((string-match am-nonshow-file-name-regexp file)
(set-buffer (get-buffer-create showbuffer))
(setq buf showbuffer)
(if (> (buffer-size) 0) nil
(insert (format "%s in %s" file archive))
(set-buffer-modified-p nil)
(set-buffer curbuf) ;;to activate am-children-list
(setq am-children-list (cons showbuffer am-children-list))))
;;if the beginning of the file has alredy been shown.
((and (get-buffer showbuffer)
(progn (set-buffer showbuffer) (> (buffer-size) 0)))
(setq buf showbuffer))
;;if the file has already been viewed.
((get-buffer viewbuffer)(setq buf viewbuffer))
(am-can-inspect ;;t ;;else show the head of file contents.
(if (null (get-buffer showbuffer))
(setq am-children-list (cons showbuffer am-children-list)))
(get-buffer-create showbuffer)
(setq buf showbuffer)
(set-buffer curbuf)
(am-start-proc-with-queue
buf (concat "nice "
(am-build-command 'print arclist archive)
" " (am-quote-each-word file) "| head -"
(int-to-string (max am-header-lines (screen-height))))
'am-refresh-kanji) background);background==quiet
(t ;;maybe on DOS. show current archive name.
(if (null (get-buffer nulbuf))
(setq am-children-list (cons nulbuf am-children-list)))
(set-buffer (get-buffer-create nulbuf))
(erase-buffer)
(insert (format "** %s **\n" archive))
(setq buf nulbuf)))
(set-buffer buf)
(am-set-view-mode-map)
(use-local-map am-view-mode-map)
(goto-char (point-min))
(if background nil
(pop-to-buffer buf)
(shrink-window (- (window-height) am-contents-height 1))
(bury-buffer (current-buffer)))
(select-window win)
(switch-to-buffer curbuf)))
(defun am-read-background ()
"Prepare all show-contents previously."
(interactive)
(cond
(am-can-inspect
(let ((am-queueing-method 'normal) showbuf file
(mes "Put all viewing jobs into a queue..."))
(save-excursion
(goto-char am-begin-position)
(while (< (point) am-end-position)
(message mes)
(if (am-on-file-name-line-p)
(am-show-contents (am-get-file-name) t))
(forward-line 1))
(message (concat mes "Done"))))))
)
(defun am-change-column (arg)
"Change am-file-name-column to the column where cursor belongs."
(interactive "P")
(if (not arg) (skip-chars-backward "^ \n\t"))
(setq am-file-name-column (current-column))
(message "Change file name column to %d." am-file-name-column))
(defun am-unkown-table ()
(error "Sorry, unknown table format. Tell me archiver you always use."))
(defun am-on-file-name-line-p ()
(and (>= (point) am-begin-position) (< (point) am-end-position)))
(defun am-guess-file-name-column ()
"Guess and return the column of the file names in the listing table."
(let ((case-fold-search t) col)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(beginning-of-line)
(insert " ")
(next-line 1))
(goto-char (point-min))
(cond
((re-search-forward am-table-begin-regexp nil t)
(forward-line 1)
(setq am-begin-position (point))
(if (search-backward "name" nil t)
(setq col (current-column))
(or
(setq col (get (intern-soft (am-get-command am-archive-list))
'file-name-column))
(am-unkown-table)))
(goto-char am-begin-position)
(move-to-column col)
(skip-chars-backward "^ \t^\n" ;`^' for zip
(am-point-beginning-of-line))
(setq col (current-column)) ;This will be the answer.
(goto-char (point-max))
(and (and (re-search-backward am-table-end-regexp nil t)
(> am-begin-position
(setq am-end-position
(progn (forward-line -1)
(am-point-end-of-line))))))
col)
(t (am-unkown-table))))))
(defun am-next-line (arg)
"Move to next line and set cursor on the file name maybe."
(interactive "p")
(next-line arg)
(end-of-line)
(backward-char 1)
(if (am-on-file-name-line-p)
(let ((file (am-get-file-name)))
(move-to-column am-file-name-column)
(if (looking-at " ") (am-next-line arg)
(skip-chars-backward "^ \t" (am-point-end-of-line))
(if am-inspect-mode (am-show-contents file))))
(beginning-of-line)))
(defun am-insert-set-properties (beg end)
(save-excursion
(let (p am-inspect-mode)
(goto-char beg)
(while (< (point) end)
(setq p (point))
(am-next-line 1)
(if (eq p (point)) (goto-char end))
(or (bolp)
(put-text-property (point)
(save-excursion
(end-of-line)
(point))
'mouse-face 'highlight))
;;(forward-line 1)
))))
(defun am-previous-line (arg)
"Move to previous line and set cursor on the file name maybe."
(interactive "p")
(am-next-line (- arg)))
(defun am-this-line ()
"Force file inspection and erase process queue."
(interactive)
(if ;;(string= (elt (recent-keys) -1) (substring (recent-keys) -2 -1))
;;For Emacs 19.
(equal (elt (recent-keys) (1- (length (recent-keys))))
(elt (recent-keys) (- (length (recent-keys)) 2)))
(let ((file (am-get-file-name)))
(if (null file) nil
(and (get-buffer (am-show-buffer-name am-archive-file-name file))
(kill-buffer (am-show-buffer-name am-archive-file-name file)))
(and (get-buffer (am-view-buffer-name am-archive-file-name file))
(kill-buffer (am-view-buffer-name am-archive-file-name file)))
)))
(if am-discard-process-queue-when-view (am-flush-process-queue))
(if (and am-running-process
(processp am-running-process)
(eq (process-status am-running-process) 'exit))
(setq am-process-queue nil))
(let ((am-inspect-mode t))
(am-next-line 0)))
(defun am-enlarge-window (arg)
(interactive "p")
(if (one-window-p) nil
(let ((oldh am-contents-height))
(setq am-contents-height (- am-contents-height arg))
(cond
((< am-contents-height 4) (setq am-contents-height 4))
((< (window-height) 6)
(setq am-contents-height (1- am-contents-height))))
(message "Set inspect height to %d" am-contents-height)
(enlarge-window (- oldh am-contents-height)))))
(defun am-shrink-window (arg)
(interactive "p")
(am-enlarge-window (- arg)))
(defun am-kill-relevant-buffers (buflist)
"Kill all buffers that is relevant to parent archvie."
(while buflist
(if (get-buffer (car buflist)) (kill-buffer (car buflist)))
(setq buflist (cdr buflist))))
(defun am-quit ()
"Quit Marche."
(interactive)
(let ((config am-initial-configuration))
(set-buffer-modified-p nil)
(save-excursion
(am-kill-relevant-buffers am-children-list))
(kill-buffer (current-buffer))
(set-window-configuration config)))
(defun am-mark-file-forward (arg &optional sw)
"Mark current file."
(interactive "p")
(move-to-column am-file-name-column)
(if (and (= (current-column) am-file-name-column)
(am-on-file-name-line-p))
(let ((file (am-get-file-name)))
(setq buffer-read-only nil)
(set-buffer-modified-p t) ;to avoid locking
(skip-chars-backward "^ \*" (am-point-beginning-of-line))
(backward-char 1) ;goto position to mark
(cond
((eq sw 'mark) (delete-char 1) (insert " ") (backward-char 1))
((eq sw 'unmark) (delete-char 1) (insert "*") (backward-char 1)))
(cond
((looking-at " ") ;set mark
(replace-match "*")
(setq am-marked-file-list
(cons (list file (count-lines (point-min) (point)))
am-marked-file-list)))
((looking-at "\\*") ;erase mark
(replace-match " ")
(setq am-marked-file-list
(delq (assoc file am-marked-file-list)
am-marked-file-list))) ;Humm. More strict logic!
(t (error "Illegal format of table.")))
(am-next-line arg)
(if debug (message "%s" am-marked-file-list))
(setq buffer-read-only t)
(set-buffer-modified-p nil))))
(defun am-mark-file ()
"Mark file and stay here."
(interactive)
(am-mark-file-forward 0))
(defun am-unmark-file-backward ()
"Move to previous file and unmark it, if neccessary."
(interactive)
(am-previous-line 1)
(am-mark-file-forward 0 'unmark))
(defun am-remove-file (file)
"Delete file FILE trapping an error."
(condition-case err
(delete-file file)
(file-error (message "Can't remove %s." file))))
(defun am-ask-overwrite (list)
"Ask user to remove file which is to be overwritten at extraction."
(let ((file (car list)))
(if (file-exists-p file)
(if (y-or-n-p
(format "%s is in %s. remove?" file default-directory))
(am-remove-file file)
(error "Aborted."))
(if (file-exists-p file) (error "Cannot unlink %s" file)))))
(defun am-revert-buffer (&optional arg noconfirm)
"Revert Marche's buffer and initialize all."
(interactive)
(setq am-process-queue nil) ;;flush process queue
(let ((line (count-lines (point-min) (point))))
(set-buffer-modified-p nil)
(message "Reverting buffer...")
(save-excursion
(let ((buf (current-buffer))
(tmpbuf "*Reverting buffer, wait...*"))
(switch-to-buffer tmpbuf) ;; for beauty:->
(set-buffer buf)
(am-kill-relevant-buffers am-children-list)
(setq am-children-list nil)
(unwind-protect
(am-initiate-buffer)
(kill-buffer tmpbuf))))
(setq buffer-read-only t)
(set-buffer-modified-p nil)
(if am-emacs-19 (switch-to-buffer (current-buffer)))
(goto-line line)
(move-to-column am-file-name-column)
(if (and (am-on-file-name-line-p)
am-inspect-mode)
(am-show-contents (am-get-file-name)))
(message "Reverting buffer...Done.")))
(defun am-change-listing (cmd)
"Change the listing switch of the corresponding archiver."
(interactive "sListing switch: ")
(setq am-favorite-listing cmd)
(am-revert-buffer))
(defun am-unpack-files (arg)
"Call archiver with extract command on marked file(s)."
(interactive "P")
(let*((archiver(am-get-command am-archive-list))
(cmd (concat archiver " "
(am-get-extract am-archive-list) " "))
(archive (concat am-archive-file-name " "))
(flist (if (or arg (null am-marked-file-list))
(list (list (am-get-file-name) nil))
am-marked-file-list))
(files (if arg (am-get-file-name)
(mapconcat 'car (reverse flist) " ")))
(curbuf (current-buffer))
dest-dir)
(if (string= files "") (error "No file(s) specified."))
(save-window-excursion ;list files and ask output directory.
(pop-to-buffer (get-buffer-create "*Unpack file list*"))
(erase-buffer)
(insert files)
(let ((fill-prefix nil)(fill-column 78))
(fill-region (point-min) (point-max)))
(goto-char (point-max))
;;(if (> (window-height) (count-lines 1 (point)))
;; (shrink-window (- (window-height) (count-lines 1 (point)) 3)))
(unwind-protect
(progn
(setq dest-dir
(read-file-name
"Extract to..: " default-directory t nil))
(if (eq dest-dir t) (setq dest-dir default-directory))
(if (and (not (file-directory-p dest-dir))
(y-or-n-p (format "Makedir %s?" dest-dir)))
(am-make-directory dest-dir))
(if (not (string-match "/$" dest-dir))
(setq dest-dir (concat dest-dir "/"))))
(kill-buffer (current-buffer))))
;;canonicalize directory name
(if (eq major-mode 'mtools-mode) (setq files (concat files " .")))
(with-output-to-temp-buffer am-unpack-buffer
(set-buffer (get-buffer am-unpack-buffer))
(setq default-directory dest-dir) ;is buffer local variable.
(princ (format "Extract {%s} from %s \n" files archive))
(if (get (intern archiver) 'ask-overwrite)
(mapcar 'am-ask-overwrite flist))
(am-call-command (concat cmd archive files) t))))
(defun am-delete-files (arg)
"Call archiver with extract command on marked file(s)."
(interactive "P")
(let*((list am-archive-list)
(archive (concat am-archive-file-name " "))
(flist (if (null am-marked-file-list)
(list (list (am-get-file-name) nil))
am-marked-file-list))
(files (if arg (am-get-file-name)
(mapconcat 'car (reverse flist) " ")))
(curbuf (current-buffer))
yes)
(if (string= files "") (error "No file(s) specified."))
(save-window-excursion ;list files and ask output directory.
(pop-to-buffer (get-buffer-create "*Delete file list*"))
(erase-buffer)
(insert files)
(let ((fill-prefix nil)(fill-column 76))
(fill-region (point-min) (point-max)))
(goto-char (point-max))
;;(if (> (window-height) (count-lines 1 (point)))
;; (shrink-window (- (window-height) (count-lines 1 (point)) 3)))
(unwind-protect
(setq yes (y-or-n-p "Delete these files?"))
(kill-buffer (get-buffer "*Delete file list*"))))
(if yes
(progn
(with-output-to-temp-buffer am-delete-buffer
(set-buffer (get-buffer am-delete-buffer))
(princ (format "Delete {%s} from %s \n" files archive))
(am-call-command
(am-build-command 'delete list archive files) t)
(princ "Done."))
(set-buffer curbuf)
(am-revert-buffer)))))
(defun am-save-buffer ()
"Save this buffer and update archive.
This function can be called interactively."
(interactive)
(save-excursion
(save-restriction
(widen)
(if (buffer-modified-p)
(let ((cb (current-buffer))(command am-update-command))
(if (null buffer-file-name)
(progn
(setq buffer-file-name
(expand-file-name
(read-file-name "File to save in: ") nil)
default-directory
(file-name-directory buffer-file-name))
(auto-save-mode auto-save-default)))
(write-region (point-min) (point-max) buffer-file-name nil t)
(setq am-update-flag t)
(set-buffer (get-buffer-create am-update-buffer))
(setq default-directory (am-convert-backslash am-unpack-tmpdir))
(message "Call %s..." command)
(am-call-command command t)
(set-buffer cb)
(am-remove-file buffer-file-name)
(message "Call %s...Done" command)
t)
(message "No changes need to be saved")
nil))))
(defun am-write-file-hook-function ()
"Inhibit writing."
(if (not (eq major-mode 'arc-mode)) nil ;continue to eval write-file-hooks
(message "Cannot write to archive. Type `g' to revert buffer instead.")
t))
(defun am-kill-buffer-hook-function ()
"Kill buffer hook function to erase temporary file."
(if (and buffer-file-name (file-exists-p buffer-file-name)
(boundp 'am-parent-buffer) am-parent-buffer)
(am-remove-file
(if am-on-dos (downcase (buffer-file-name)) (buffer-file-name))))
(if (get-buffer am-parent-buffer)
(save-excursion (switch-to-buffer am-parent-buffer)));Raise parent buffer
(if (and (boundp 'am-update-flag) am-update-flag)
(message
"Child file was modified. Type `g' to update listing if neccessary.")))
(defun am-find-file (filelist)
"Find-file for am-edit-file."
(if (stringp (car filelist))
(let ((file (car filelist)))
(if (not (file-exists-p file))
(error "Unpack trouble on %s in %s" file default-directory)
(cond
((boundp 'NEMACS)
(let (kanji-expected-code)
(if am-sjis-flag (setq kanji-expected-code 1))
(find-file file)))
((boundp 'MULE)
(let ((file-coding-system-for-read *autoconv*))
(find-file
file
(if am-sjis-flag
(if (boundp '*sjis*dos) *sjis*dos *sjis-dos*)))))
((and (featurep 'mule) (string< "20" emacs-version))
(let ((file-coding-system-alist
(cons (cons "." (if am-sjis-flag 'sjis-dos 'undecided))
file-coding-system-alist))
(process-coding-system-alist
(cons (cons "." (if am-sjis-flag 'sjis-dos 'undecided))
process-coding-system-alist)))
(find-file file)))
(t (find-file file)))
(make-local-variable 'am-parent-buffer)
(setq am-parent-buffer curbuf)
(make-local-variable 'am-update-command)
(setq am-update-command (am-build-command 'update list archive file))
(make-local-variable 'write-file-hooks)
(am-append-to-hook 'write-file-hooks 'am-save-buffer)
(make-local-variable 'kill-buffer-hook)
(am-append-to-hook 'kill-buffer-hook 'am-kill-buffer-hook-function)
(make-local-variable 'am-update-flag)
(setq am-update-flag nil)))))
(defun am-edit-file (arg)
"Extract file(s) and edit it.
If universal-argument ARG is non-nil, edit the file where cursor exists
instead of marked files."
(interactive "P")
(let*((list am-archive-list)
(archive (concat am-archive-file-name " "))
(archiver (am-get-command list))
(flist (if (or arg (null am-marked-file-list))
(list (list (am-get-file-name) nil))
am-marked-file-list))
(files (if arg (am-get-file-name)
(mapconcat 'car (reverse flist) " ")))
(curbuf (current-buffer)))
(if (string= files "") (error "No file(s) specified."))
(set-buffer (get-buffer-create am-unpack-buffer))
(setq default-directory (am-convert-backslash am-unpack-tmpdir))
(cd default-directory) ;for 19
(if (file-directory-p default-directory) nil
(am-make-directory default-directory))
(if (get (intern archiver) 'ask-overwrite)
(mapcar 'am-ask-overwrite flist))
(am-call-command (am-build-command 'extract list archive files) nil)
(mapcar 'am-find-file flist)
(set-buffer curbuf)
(if (or (boundp 'NEMACS) (boundp 'MULE))
(message "文字化けしていたら M-x am-re-find-file"))))
(defun am-re-find-file ()
"Re-open current file inquiring kanji coding system."
(interactive)
(let*((parent am-parent-buffer) (update am-update-command)
(whooks write-file-hooks) (khooks kill-buffer-hook)
(flag am-update-flag) (col (current-column))
(line (+ (count-lines (point-min) (point)) (if (= col 0) 1 0)))
(wline (+ (count-lines (window-start) (point)) (if (= col 0) 1 0)))
code)
(setq code
(cond ((boundp 'NEMACS)
(cdr (assoc (completing-read
"Kanji Code System: "
extended-kanji-code-alist nil t)
extended-kanji-code-alist)))
((boundp 'MULE)
(read-coding-system "Coding system: "))))
(cond
((boundp 'NEMACS)
(let ((kanji-expected-code code))
(find-alternate-file buffer-file-name)))
((boundp 'MULE)
(let ((file-coding-system-for-read code))
(find-alternate-file buffer-file-name))))
(goto-line line)
(move-to-column col)
(recenter (1- wline))
(if parent ;if last buffer is Marche's child
(progn
(make-local-variable 'am-parent-buffer)
(setq am-parent-buffer parent)
(make-local-variable 'am-update-command)
(setq am-update-command update)
(make-local-variable 'write-file-hooks)
(setq write-file-hooks whooks)
(make-local-variable 'kill-buffer-hook)
(setq kill-buffer-hook khooks)
(make-local-variable 'am-update-flag)
(setq am-update-flag flag)))))
(defun am-get-marks ()
"Read mark information from current buffer."
(save-excursion
(goto-char am-begin-position)
(setq am-marked-file-list nil)
(move-to-column am-file-name-column)
(while (< (point) am-end-position)
(skip-chars-backward "^^* \n")
(forward-char -1)
(if (= (following-char) ?*)
(setq am-marked-file-list
(cons (list (am-get-file-name)
(count-lines (point-min) (point)))
am-marked-file-list)))
(am-next-line 1))))
(defun am-undo (arg)
"Undo function for listing buffer."
(interactive "P")
(let ((buffer-read-only nil))
(undo arg)
(am-get-marks)
(setq buffer-read-only t)))
(defun am-mark-files-regexp (regexp)
"Mark files matching with REGEXP."
(interactive "sMarking regexp: ")
(save-excursion
(goto-char am-begin-position)
(while (< (point) am-end-position)
(move-to-column am-file-name-column)
(if (string-match regexp (am-get-file-name)) ;is file-name
(am-mark-file-forward 1 'mark) ;force marking
(am-next-line 1))
)))
(defun am-reverse-marks ()
"Reverse all marks."
(interactive)
(save-excursion
(goto-char am-begin-position)
(while (< (point) am-end-position)
(am-mark-file-forward 1))))
(defun am-mark-unmark-all ()
"Mark or unmark all files."
(interactive)
(save-excursion
(let((action (if am-marked-file-list 'unmark 'mark)))
(goto-char am-begin-position)
(while (< (point) am-end-position)
(am-mark-file-forward 1 action))))
(move-to-column am-file-name-column))
(defun am-mouse-view-file (click)
"Bound to mouse click views the file."
(interactive "e")
(mouse-set-point click)
(am-view-file))
(defvar arc-mode-map nil
"Key map used in Arc mode.")
(if arc-mode-map
nil
(setq arc-mode-map (make-keymap))
(suppress-keymap arc-mode-map)
(define-key arc-mode-map "\C-m" 'am-view-file)
(define-key arc-mode-map "\C-j" 'am-change-column)
(define-key arc-mode-map "v" 'am-view-file)
(define-key arc-mode-map "V" 'am-version)
(define-key arc-mode-map "e" 'am-edit-file)
(define-key arc-mode-map "f" 'am-edit-file)
(define-key arc-mode-map "g" 'revert-buffer)
(define-key arc-mode-map "G" 'am-change-listing)
(define-key arc-mode-map "n" 'am-next-line)
(define-key arc-mode-map "j" 'am-next-line)
(define-key arc-mode-map "p" 'am-previous-line)
(define-key arc-mode-map "k" 'am-previous-line)
(define-key arc-mode-map " " 'am-mark-file-forward)
(define-key arc-mode-map "m" 'am-mark-file-forward)
(define-key arc-mode-map "u" 'am-unpack-files)
(define-key arc-mode-map "d" 'am-delete-files)
(define-key arc-mode-map "*" 'am-mark-files-regexp)
(define-key arc-mode-map "z" 'am-reverse-marks)
(define-key arc-mode-map "w" 'am-mark-unmark-all)
(define-key arc-mode-map "S" 'am-toggle-sjis-flag)
(define-key arc-mode-map "P" 'am-set-max-process)
(define-key arc-mode-map ";" 'am-toggle-inspect)
(define-key arc-mode-map "." 'am-this-line)
(define-key arc-mode-map "o" 'other-window)
(define-key arc-mode-map "&" 'am-read-background)
(define-key arc-mode-map "+" 'am-enlarge-window)
(define-key arc-mode-map "-" 'am-shrink-window)
(define-key arc-mode-map "\C-_" 'am-undo)
(define-key arc-mode-map "\C-i" 'am-mark-file)
(define-key arc-mode-map "\C-?" 'am-unmark-file-backward)
(define-key arc-mode-map "q" 'am-quit)
(cond
(am-emacs-19
(define-key arc-mode-map [mouse-2] 'am-mouse-view-file)
(condition-case ()
(progn
(require 'easymenu)
(easy-menu-define
Arc-mode-menu
arc-mode-map
"Keys for Archive viewing mode"
'("Marche"
["View" am-view-file t]
["Edit" am-edit-file t]
["Inspect this" am-this-line t]
["------------" nil nil]
["Toggle Mark" am-mark-file t]
["Toggle Mark forward" am-mark-file-forward t]
["Toggle all marks" am-reverse-marks t]
["(Un)mark All" am-mark-unmark-all t]
["------------ " nil nil]
["Unpack Files" am-unpack-files t]
["Delete Files" am-delete-files t]
["------------ " nil nil]
["Toggle inspect" am-toggle-inspect t]
["Set file column" am-change-column t]
["Archiver option" am-change-listing t]
["Revert buffer" revert-buffer t]
["Undo changes" am-undo t]
["------------ " nil nil] ; Strings should be different
["Quit" am-quit t]
)))
(error nil)))))
(defun am-insert-listing ()
"Erase narrowed whole buffer and call archive to insert listing."
(goto-char (point-min))
(am-call-command
(am-build-command 'listing am-archive-list am-archive-file-name) t))
(defun am-initiate-buffer ()
"Make the initial Arc mode's buffer."
(setq buffer-read-only nil)
(save-excursion
(if am-file-name-column
(widen))
(erase-buffer)
(am-insert-listing)
(make-local-variable 'am-file-name-column)
(make-local-variable 'am-begin-position)
(make-local-variable 'am-end-position)
(setq am-file-name-column (am-guess-file-name-column))
(make-local-variable 'am-marked-file-list)
(setq am-marked-file-list nil)
(if am-emacs-19 (am-insert-set-properties (point-min) (point-max)))
(setq buffer-read-only t)
(setq am-process-queue nil)
(set-buffer-modified-p nil))
;;Why find-file-noselect enclose after-find-file in save-excursion???
;;So two codes have no effects...
;;(goto-char am-begin-position)
;;(move-to-column am-file-name-column)
)
(defun am-get-buffer (file)
"Get Arc mode buffer named FILE."
(let ((list (buffer-list)))
(save-excursion
(catch 'found
(while list
(set-buffer (car list))
(if (and
(string= am-archive-file-name file)
(string-match
(regexp-quote (file-name-nondirectory file)) (buffer-name)))
(throw 'found (car list)))
(setq list (cdr list)))))))
;;;
;; Override function
;;;
(if (fboundp 'am:saved-find-file-noselect) nil
(fset 'am:saved-find-file-noselect (symbol-function 'find-file-noselect))
(defun find-file-noselect (filename &rest restargs)
(setq filename (expand-file-name filename))
(let ((buf (am-get-buffer filename)) ;find Arc mode buffer
(case-fold-search am-file-ignore-case))
(if buf (set-buffer buf)
(if (string-match am-file-name-regexp filename)
(save-excursion
(setq buf (generate-new-buffer
(file-name-nondirectory filename)))
(set-buffer buf)
(erase-buffer)
(setq default-directory (file-name-directory filename))
(setq buffer-file-name filename)
;;Entrust normal-mode with error operations.
(normal-mode t)
;;;(setq buf (marche filename))
) ;;must be (arc-mode);;
(setq buf (apply 'am:saved-find-file-noselect filename restargs))))
buf)))
(if (or (not am-emacs-18)
(fboundp 'am:saved-kill-buffer)) nil
(fset 'am:saved-kill-buffer (symbol-function 'kill-buffer))
(defun kill-buffer (buf)
(interactive "bKill buffer: ")
(save-excursion
(if (or (stringp buf) (bufferp buf)) (set-buffer buf))
(if (and t ;;(eq major-mode 'arc-mode)
(not (and (boundp 'am-kill-flag) am-kill-flag)))
(let ((am-kill-flag t))
(run-hooks 'kill-buffer-hook)))
(am:saved-kill-buffer buf))))
;;;###autoload
(defun arc-mode (&optional arg)
"Major mode for handling archive files as `miel', file browser on DOS, does.
Select the file by typing \\[am-previous-line] or \\[am-next-line]
and do the action to that file. Following actions are available.
\\[am-view-file] View file
\\[am-edit-file] Edit file
\\[am-mark-file-forward] Mark file forward
\\[am-unmark-file-backward] Unmark previous file
\\[am-mark-file] Mark/unmark current file
\\[am-mark-files-regexp] Mark files by regexp
\\[am-reverse-marks] Reverse marks
\\[am-mark-unmark-all] Mark/unmark all
\\[am-unpack-files] Unpack marked files
\\[am-delete-files] Delete marked files
\\[am-toggle-inspect] Toggle inspect mode
\\[am-this-line] Force to display this file
\\[other-window] Other window
\\[am-enlarge-window] Enlarge window
\\[am-shrink-window] Shrink window
\\[am-undo] Undo
\\[revert-buffer] Revert buffer
\\[am-change-listing] Change listing command
\\[am-change-column] Assume current column as file name
\\[am-quit] Quit Marche
To customize marche, use the hook variable `marche-load-hook',
`arc-mode-hook' and `am-view-mode-hook'.
To change the archiver, set the variable am-archiver-alist referring the
value of am-archiver-alist-default."
(interactive "P")
(kill-all-local-variables)
(make-local-variable 'am-initial-configuration)
(setq am-initial-configuration (current-window-configuration))
(auto-save-mode 0)
(goto-char (point-min))
(make-local-variable 'am-archive-file-name)
(or am-archive-file-name
(setq am-archive-file-name (buffer-file-name)))
(make-local-variable 'am-archive-list)
(setq am-archive-list
(assoc (substring am-archive-file-name -3)
(append am-archiver-alist am-archiver-alist-default)))
(make-local-variable 'am-children-list)
(make-local-variable 'am-favorite-listing)
(make-local-variable 'revert-buffer-function)
(setq revert-buffer-function 'am-revert-buffer)
(make-local-variable 'kill-buffer-hook)
(am-append-to-hook
'kill-buffer-hook '(lambda () (am-kill-relevant-buffers am-children-list)))
(make-local-variable 'write-file-hooks)
(am-append-to-hook 'write-file-hooks 'am-write-file-hook-function)
(setq mode-name
(concat "marche:" (am-get-command am-archive-list)))
(setq major-mode 'arc-mode)
(am-initiate-buffer)
(message
"If my guess of file name column is wrong, type C-j on the file name.")
(use-local-map arc-mode-map)
(run-hooks 'arc-mode-hook))
;; -------------------- General sub functions --------------------
(defun am-point-beginning-of-line ()
(save-excursion (beginning-of-line)(point)))
(defun am-point-end-of-line ()
(save-excursion (end-of-line)(point)))
(defun am-append-to-hook (hook funcs)
"Append funcs to hook's value keeping its uniquness."
;;Derived from add-hook.el by Daniel LaLiberte.
(if (boundp hook)
(let ((value (symbol-value hook)))
(if (and (listp value) (not (eq (car value) 'lambda)))
(and (not (memq funcs value))
(set hook
(append value (list funcs))))
(and (not (eq funcs value))
(set hook
(list value funcs)))))
(set hook funcs)))
;; -------------------- Finish --------------------
(fset 'marche 'arc-mode)
(provide 'arc-mode)
(provide 'arch)
(provide 'marche)
(run-hooks 'marche-load-hook)
;;;$Log: arch.el,v $
;;;Revision 1.13 2000/12/14 14:10:06 yuuji
;;;Give up GPL
;;;
;;;Revision 1.12 2000/12/14 14:08:22 yuuji
;;;Check on Emacs21, and more...
;;;
;;;Revision 1.11 1999/09/14 04:36:05 yuuji
;;;Trivial fix
;;;
;;;Revision 1.10 1999/09/14 02:34:22 yuuji
;;;Support Emacs20
;;;
;;;Revision 1.9 1997/06/19 05:37:04 yuuji
;;;Win32
;;;
;;;Revision 1.8 1997/01/17 02:16:55 yuuji
;;;Quote file name in argument for the archiver
;;;
; Revision 1.7 1994/05/06 21:32:51 yuuji
; Couldn't view file on DOS, fixed.
;
; Revision 1.6 1994/03/23 06:16:09 yuuji
; Support Mule-1.1x.
;
; Revision 1.5 1994/02/14 08:19:48 yuuji
; Sent to GNU.
;
; Revision 1.4 1994/02/10 07:43:56 yuuji
; Dressed up for voyage.
;
; Revision 1.3 1993/12/24 08:24:44 yuuji
; Start-process with queue.
;
; Revision 1.1 93/12/12 22:34:24 yuuji
; Limit the maximum number of simultaneous running process.
;
; Revision 1.0 93/12/12 06:41:19 yuuji
; Support miel-like inspection.
;
; Revision 0.9 1993/09/25 18:38:14 yuuji
; C-j adjusts misplaced file name field.
; Fix updation/delete-tmp-file bug.
;
; Revision 0.7 1993/06/21 07:20:14 yuuji
; Fix english document.
; Enable recursive marche.
;
;;;慶応義塾ITC助手 広瀬雄二
;;;Information Technology Center, KEIO Univ.
;;;HIROSE, Yuuji. [yuuji@gentei.org]
;--Positions and mail addresses below are obsolete,
;--but leave here for memorial reason
;;;慶応義塾理工学研究科管理工学専攻 広瀬雄二
;;;Faculty of Science and technology, KEIO Univ.
;;;HIROSE, Yuuji. [yuuji@ae.keio.ac.jp, pcs39334@asciinet.or.jp]
;--
;;;英語版ドキュメント(English document):
;;;筑波大学大学院物理学研究科 桂川直己
;;;Institute of Phyisics, Univ. of Tsukuba
;;;KATSURAGAWA, Naoki. [katsura@prc.tsukuba.ac.jp, net66331@asciinet.or.jp]
; Local variables:
; fill-prefix: ";;; "
; paragraph-start: "^$\\| \\|;;;$"
; paragraph-separate: "^$\\| \\|;;;$"
; End:
HIROSE Yuuji