[xyzzy:01606] archive-mode について

[Seiya Suda <EZU11330@xxxxxxxxxxxxxxxx>]

亀井さん、こんにちは。

lister の archive-mode は次のようにしていますが、
どこかにむりがありますか？ ２つ３つ連続して解凍
すると xyzzy が死んでしまいます。

それから、zip や tgz については、どのようにすれば
いいのですか？

以上よろしくお願いします。

-------------------------------
(export '(*archive-mode-map* archive-mode))

(require "wip/winapi")

(defvar *archive-mode-map* nil)
(unless *archive-mode-map*
  (setq *archive-mode-map* (copy-keymap *lister-directory-map*))
  (define-key *archive-mode-map* #\RET 'lister-find-archived-file))

(defvar *lister-archive-name* nil)

;; 文字列中の Ctrl-Mを削除
(defun remove-ctl-m (str)
  (remove-if #'(lambda(x)(char= x #\RET)) str))

(defun lister-archive-mode (archive)
  (interactive)
  (setq *lister-archive-name* archive)
  (make-local-variable 'afile-size)
  (make-local-variable 'afile-list)
  (lister-buffer-pre-rewrite)
  (insert (concat (file-namestring *lister-archive-name*) "\n../\n"))
  (dolist (i (list-archive *lister-archive-name*))
	(let ((afile-name (car i))
		  (afile-size (caddr i)))
	  (with-output-to-buffer ((selected-buffer) (point-max))
		(format t "~A\n" afile-name))
	  (setq afile-list (cons (cons afile-name afile-size) afile-list))))
  (lister-foo-mode)
  (use-keymap *archive-mode-map*)
  (set-default-directory (default-directory)))

(defun lister-find-archived-file ()
  (interactive)
  (let* ((key (quote-string (lister-get-filename) #\& #\&))
		 (size (cdr (assoc key afile-list :test #'equal)))
		 aname b) 
	(cond ((lister-directory-p key)
		   (goto-bol)
		   (if (looking-at "^..")
			   (progn
				 (lister-ls (default-directory))
				 (scan-buffer (file-namestring
							   *lister-archive-name*) :tail nil)
				 (use-keymap *lister-directory-map*))
			 (popup-string "ディレクトリーです" (point) 1)))
		  (t
		   (setq aname (file-namestring key))
		   (if (> size 65536)
			   (popup-string "サイズがでかすぎるなー" (point) 1)
			 (progn
			   (setq b (create-new-buffer aname))
			   (switch-to-buffer-other-window b)
			   (insert (remove-ctl-m (unlha-extract-mem
									  *lister-archive-name* aname)))
			   (set-buffer-modified-p nil)))))))


;; ---------  UnlhaExtractMem でメモリに展開する ----------------
;; 使い方:(unlha-extract-mem "c:/henmi/sdk.lzh" "sdk/a323.txt")
(winapi::*define-dll-entry
 winapi::LONG *unlha-extract-mem (winapi::HWND
		      winapi::LPCSTR  ; szCmdLine
		      winapi::LPCSTR  ; szBuffer
		      winapi::DWORD   ; dwSize
		      winapi::DWORD   ; time_t*
		      winapi::DWORD   ; lpwAttr
		      winapi::DWORD   ; lpdwWriteSize
		     )
  "unlha32" "UnlhaExtractMem")

(defun unlha-extract-mem (arc file)
  (let* ((bufsize 65536)
		 (membuf (make-vector bufsize :element-type 'character))
		 (cmd (concat arc " " file))
		 (s (si:make-chunk nil 65536)))
	(*unlha-extract-mem 0 (si:make-string-chunk cmd) s bufsize 0 0 0)
	(si:unpack-string s 0)))

------------------------------------------------------------
須田誠也
EZU11330@xxxxxxxxxxx