;;; -*- Emacs-Lisp -*-
;;; A Front-end of mtools for Marche
;;; mtools.el version 1.2
;;; $Id: mtools.el,v 1.2 1997/06/19 05:53:15 yuuji Exp $
;;; (c )1994 HIROSE Yuuji [yuuji@ae.keio.ac.jp]
;;; Last modified Thu Jun 19 14:52:55 1997 on crx

;;; Installation:
;;;	* Put perlscript `mtools' into your command search path.
;;;	* Put `mtools.el' and `arch.el' into your elisp load-path.
;;;	* Put the expression below into your ~/.emacs.
;;;
;;;		(autoload 'mtools-mode "mtools" "Mtools mode" t)
;;;
;;;	* If you use NEC-PC98 and your floppy drive is associated
;;;	  with C: drive, put the next expression into your ~/.emacs
;;;
;;;		(setq mtools-operation-alist
;;;		        '("C:" "mtools" "l" "p" "x" "mtools u" "mtools d"))

;;;
;;; Usage:
;;;	M-x mtools-mode

(require 'arch)

(defvar mtools-mode-map nil "Keymap used in mtools-mode")
(if mtools-mode-map nil
  (setq mtools-mode-map (copy-keymap arc-mode-map))
  (define-key mtools-mode-map "f" 'mtools-edit-file)
  (define-key mtools-mode-map "v" 'mtools-view-file)
  (define-key mtools-mode-map "n" 'mtools-next-line)
  (define-key mtools-mode-map "j" 'mtools-next-line)
  (define-key mtools-mode-map "p" 'mtools-previous-line)
  (define-key mtools-mode-map "k" 'mtools-previous-line)
  )

(defvar mtools-operation-alist
  '("A:" "mtools" "l" "p" "x" "mtools u" "mtools d"))

(defun mtools-edit-file (arg)
  "Mread 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))
	(l am-marked-file-list))
    (if (string= files "") (error "No file(s) specified."))
    (setq files (concat files " ."))
    (save-excursion
      (while l
	(goto-char (car (cdr (car l))))
	(search-forward (car (car l)))
	(skip-chars-forward " \t")
	(if (looking-at "<DIR>")
	    (error "Cannot read directory %s" (car (car list))))
	(setq l (cdr l))))
    (save-excursion
      (skip-chars-forward "^ \t")
      (skip-chars-forward " \t")
      (if (looking-at "<DIR>")
	  ;;if directory, start another mtools-mode
	  (let ((file (car (car flist))))
	    (cond
	     ((string= "." file) nil)	;do nothing
	     ((string= ".." file)
	      (setq file
		    (substring am-archive-file-name
			       0
			       (1+ (string-match
				    "/[^/]*$" am-archive-file-name))))
	      (or (string-match ":/$" file)
		  (setq file (substring file 0 -1)))
	      (if (get-buffer file) (switch-to-buffer file)
		(mtools-mode file)))
	     (t
	      (let ((file (car (car flist))))
		(setq file (concat
			    am-archive-file-name
			    (if (string-match "/$" am-archive-file-name)
				"" "/")
			    file))
		(if (get-buffer file)
		    (switch-to-buffer file)
		  (mtools-mode file)))
	      )))
	;;or mread and edit it.
	(set-buffer (get-buffer-create am-unpack-buffer))
	(setq default-directory am-unpack-tmpdir)
	(cd default-directory)
	(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 mtools-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))
	  (save-excursion
	    (if (search-forward "<DIR>" (am-point-end-of-line) t)
		nil
	      (if am-inspect-mode (am-show-contents file))))))
    (beginning-of-line))
)

(defun mtools-previous-line (arg)
  "Move to previous line and set cursor on the file name maybe."
  (interactive "p")
  (mtools-next-line (- arg))
)

(defun mtools-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 (or (null file) (string-match "^\." 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 mtools-mread-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
    (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 mtools-mode (path)
  "Mtools mode."
  (interactive "smdir directory: ")
  (if (string-match "^[A-Za-z]:$" path) (setq path (concat path "/")))
  (switch-to-buffer (get-buffer-create path))
  (kill-all-local-variables)
  (mapcar 'make-local-variable
	  '(am-archive-list am-children-list am-favorite-listing
	    revert-buffer-function kill-buffer-hook write-file-hooks
	    am-initial-configuration am-archive-file-name))
  (setq am-initial-configuration (current-window-configuration))
  (auto-save-mode 0)
  (make-local-variable 'am-archive-file-name)
  (or am-archive-file-name (setq am-archive-file-name (buffer-name)))
  (setq am-archive-list mtools-operation-alist)
  (am-append-to-hook
   'kill-buffer-hook '(lambda () (am-kill-relevant-buffers am-children-list)))
  (setq mode-name "mtools"
	major-mode 'mtools-mode)
  (am-initiate-buffer)
  (use-local-map mtools-mode-map)
  (run-hooks 'mtools-mode-hook)
)