diff --git a/arch.el b/arch.el index 54a4645..d86c3cf 100644 --- a/arch.el +++ b/arch.el @@ -1,9 +1,9 @@ ;;; -*- Emacs-Lisp -*- ;;; Multi format Archive file handler for Emacs. ;;; -;;; arch.el version 1.7 -;;; (c ) 1993,1994 by HIROSE Yuuji.[yuuji@ae.keio.ac.jp] -;;; Last modified Sat May 7 05:44:01 1994 on pajero +;;; arch.el version 1.8 w/ mtools +;;; (c ) 1993-1997 by HIROSE Yuuji.[yuuji@ae.keio.ac.jp] +;;; Last modified Fri Jan 17 11:15:52 1997 on supra ;; Marche is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -20,7 +20,7 @@ ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; -;;; This program enables your Emacs to walk through the archive file +;;; 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!" @@ -61,7 +61,7 @@ ;;; 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 +;;; 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 @@ -72,6 +72,9 @@ ;;; 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 @@ -99,6 +102,10 @@ ;;; 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 ;;; @@ -163,6 +170,8 @@ ;;; ;;; 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 @@ -230,7 +239,7 @@ ;;; ;;; *Can't customize to handle the archive of capital file name. ;;; -;;; Redifining am-file-name-regexp isn't enough. Set the variable +;;; 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] @@ -259,6 +268,13 @@ ;;; 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 @@ -268,8 +284,8 @@ ;;; Comments and bug reports are welcome. Don't hesitated to report. ;;; My possible e-mail address is following. ;;; -;;; yuuji@ae.keio.ac.jp -;;; pcs39334@ASCII-NET +;;; yuuji@ae.keio.ac.jp +;;; pcs39334@asciinet.or.jp ;;; ;;; Japanese document follows: ;;; @@ -312,13 +328,16 @@ ;;; TAB �t�@�C���̃}�[�N ;;; SPACE �t�@�C�����}�[�N���Ď��̍s�� ;;; BS ���O�̍s�̃}�[�N�̉��� -;;; u �}�[�N�t�@�C���̓W�J(extract) +;;; u �}�[�N�t�@�C���̓W�J(unpack) ;;; d �}�[�N�t�@�C���̍폜 ;;; g �A�[�J�C�u�t�@�C���̍ēǂݍ��� ;;; G ����(�A�[�J�C�o�̃��X�g�\���X�C�b�`�ύX) ;;; S SJIS����D�惂�[�hON/OFF ;;; z �t�@�C���̃}�[�N�̔��] ;;; * ���K�\���ɂ��t�@�C���ꊇ�}�[�N +;;; o �ʃE�B���h�E��(other-window) +;;; P �}�V���p�t�H�[�}���X�ă`�F�b�N +;;; & �o�b�N�O���E���h�őS�������e��p��(������) ;;; . �J�����g�t�@�C���̐擪�\�� ;;; ; �t�@�C���擪�\�����[�hON/OFF ;;; + / - �E�B���h�E�g��/�k�� @@ -339,11 +358,15 @@ ;;; j,e / k,y ��s�X�N���[���A�b�v/�_�E�� ;;; d / u ����ʃX�N���[���A�b�v/�_�E�� ;;; g / G �t�@�C���̐擪��/������ -;;; o other-window +;;; o �ׂ̃E�B���h�E�� +;;; / �O������ +;;; ? ������� +;;; n �O���Č��� +;;; N ����Č��� +;;; 1 �S��ʉ� +;;; 0 �J�[�\�����s���� ;;; h �w���v ;;; q view-mode �𔲂��� -;;; / ������� -;;; ? ������� ;;; ;;;�y�ҏW���[�h�z ;;; @@ -406,8 +429,10 @@ ;;; ;;; arc-mode-hook ;;; arc-mode �̏��������I������� +;;; am-view-mode-setup-hook +;;; �t�@�C���{���� view-mode �̃L�[�}�b�v�ݒ莞 ;;; am-view-mode-hook -;;; �t�@�C���{���� view-mode �ɓ��钼�O(�L�[�}�b�v���[�h��) +;;; �t�@�C���{���� view-mode �ɓ������� ;;; marche-load-hook ;;; ���̃t�@�C�������[�h���鎞(�t�@�C���̍Ō�) ;;; @@ -523,9 +548,9 @@ ;;; �v���O�������g�p���Đ����������Ȃ錋�ʂɑ΂��Ă���҂͈�؂̐ӔC ;;; �𕉂�Ȃ����̂Ƃ������܂����A�R�����g��o�O���|�[�g�͑傢�Ɋ��} ;;; �������܂��B���C�y�ɂ��A���������B�A���͈ȉ��̃A�h���X�܂ł��肢 -;;; �������܂�(1994/3����)�B -;;; yuuji@ae.keio.ac.jp -;;; pcs39334@ASCII-NET +;;; �������܂�(1997/3����)�B +;;; yuuji@ae.keio.ac.jp +;;; pcs39334@asciinet.or.jp (defconst am-version "$Id$" @@ -556,7 +581,7 @@ (if am-on-dos '("arc" "parc" "v" "p" "xo" "parc a" "parc d") '("arc" "arc" "l" "p" "e" "arc u" "arc d")) - '("zip" "unzip" "-lU" "-p" "-xo" "zip -u" "zip -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")) @@ -594,7 +619,7 @@ "*Name of command string to unlink files.") (defvar am-unpack-tmpdir (or (if (and am-on-dos debug) "j:/tmp") - (and (getenv "TMP") (am-convert-backslash (getenv "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 @@ -621,6 +646,7 @@ (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.") @@ -659,7 +685,7 @@ "Holds process object.") (defvar am-nonshow-file-names-default - "\\.\\(com\\|exe\\|obj\\|o\\|dvi\\|lib\\|a\\|fmt\\|.df\\)$" + "\\.\\(com\\|exe\\|obj\\|o\\|dvi\\|lib\\|a\\|fmt\\|.df\\|tar\\|taz\\|tgz\\)$" "Inihibit showing contents on this filename.") (defvar am-nonshow-file-names nil) @@ -684,7 +710,6 @@ `view-file' entered. If you want to see all the headers of files, set this variable to nil.") - ;;; ;; Marche functions ;;; @@ -712,25 +737,29 @@ (let (code (buffer-read-only nil) pbuf (sw (selected-window))) (save-excursion - (if (and proc (processp proc)) - (set-buffer (setq pbuf (process-buffer proc)))) + (if (and proc (processp proc) (setq pbuf (process-buffer proc)) + (buffer-name pbuf)) + (set-buffer pbuf)) (setq buffer-read-only nil) (cond - ((boundp 'MULE) + ((and pbuf (null (buffer-name pbuf)));;killed buffer + nil) ;maybe canceled + ((and (boundp 'MULE) (string< (substring mule-version 0 3) "1.1")) (setq code - (funcall - (if (boundp '*sjis*dos) ;Check Mule 1.0 or 1.1 - 'code-detect-region 'detect-code-category) - (point-min) (am-detect-range))) + (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*))) + (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))) - (convert-region-kanji-code - (point-min) (point-max) code am-nemacs-raw-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)) @@ -740,6 +769,19 @@ (set-buffer-modified-p nil)) ) +(defun am-quote-each-word (string) + "Quote each word by single quotation." + (if (eq system-type 'ms-dos) string ;quoting not required on dos. + (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 @@ -750,7 +792,8 @@ (list (if am-sjis-flag *sjis* *autoconv*))))) (if am-emacs-19 (cd default-directory)) (call-process shell-file-name nil buf 1 - (if (eq system-type 'ms-dos) "/c" "-c") cmd)) + (if (eq system-type 'ms-dos) "/c" "-c") + (am-quote-each-word cmd))) (if convert (am-refresh-kanji)) ) @@ -816,6 +859,45 @@ (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 (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 "-c" 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") @@ -851,16 +933,18 @@ (defun am-view-q () "Marche view mode: quit." (interactive) - (if (eq major-mode 'am-view-mode) - (let ((parent am-parent-buffer)) - (set-buffer-modified-p nil) - ;;(if am-current-process - ;; (progn - ;; (if (eq (process-status am-current-process) 'run) - ;; (interrupt-process am-current-process)) - ;; (delete-process am-current-process))) - (bury-buffer (current-buffer)) - (switch-to-buffer parent)))) + (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") @@ -874,14 +958,21 @@ 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 (copy-keymap global-map)) + (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) @@ -903,48 +994,13 @@ (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)) ) -(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 (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 "-c" 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 - ((boundp 'NEMACS) - (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-call-command cmd buffer t)) - (goto-char (point-min)) - (switch-to-buffer buffer) -) -(defun am-view-mode () - "View mode for marche. +(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] @@ -952,22 +1008,44 @@ scroll up (line): \\[am-view-j] scroll down(line): \\[am-view-k] beginning of buf: \\[beginning-of-buffer] -end of buf: \\[am-view-bottom]" - (interactive) - (setq mode-name "marche:view" - major-mode 'am-view-mode) +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 t) - (use-local-map am-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 " (file-name-nondirectory archive) "*")) + (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 "*" (file-name-nondirectory archive) ":" file "*")) + (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." @@ -975,22 +1053,22 @@ (if (not (am-on-file-name-line-p)) (error "Not on file name.")) (let*((curbuf (current-buffer)) (file (am-get-file-name)) - (archive (file-name-nondirectory am-archive-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) " " file))) + '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) - (run-hooks 'am-view-mode-hook) - (make-local-variable 'am-parent-buffer) - (setq am-parent-buffer curbuf) (am-prepare-view-contents buffer) (goto-char (point-min)) (set-buffer-modified-p nil) - (am-view-mode))) + (am-view-mode-entry curbuf))) ) (defun am-message-job-done (joblist) @@ -1033,10 +1111,16 @@ (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) - (am-message-job-done entry) + (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 @@ -1058,7 +1142,8 @@ )) ) -(defun am-start-proc-with-queue (buffer command sentinel &optional chop) +(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." @@ -1067,7 +1152,7 @@ (if (null chop) (cond ((eq am-queueing-method 'normal) - (setq am-process-queue (append am-process-queue (list entry)))) + (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))) @@ -1080,24 +1165,27 @@ (list entry))))) ) (setq am-max-process (max 1 am-max-process)) - (if (and (> (length am-process-queue) am-max-process) - (null chop)) nil - (message "Starting %s..." command) + (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 "\n") ;This newline works as start-process flag. - (setq proc + (setq am-running-process (start-process "marche:show" buffer shell-file-name "-c" command)) - (set-marker (process-mark proc) (point-min))) + (set-marker (process-mark am-running-process) (point-min))) (if (boundp 'MULE) (set-process-coding-system - proc (if am-sjis-flag *sjis* *autoconv*) nil)) + am-running-process (if am-sjis-flag *sjis* *autoconv*) nil)) (set-process-sentinel - proc (list 'lambda '(proc mes) - (list sentinel 'proc 'mes) - (list 'am-chop-queue (list 'quote entry)))))) + am-running-process + (list 'lambda '(proc mes) + (list sentinel 'proc 'mes) + (list 'am-chop-queue (list 'quote entry)))))) ) (defun am-flush-process-queue () @@ -1117,11 +1205,13 @@ (setq am-process-queue nil) ) -(defun am-show-contents (file) +(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 (file-name-nondirectory am-archive-file-name)) + (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)) @@ -1158,9 +1248,9 @@ (am-start-proc-with-queue buf (concat "nice " (am-build-command 'print arclist archive) - " " file " | head -" - (int-to-string (screen-height))) - 'am-refresh-kanji)) + " " (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)) @@ -1169,16 +1259,35 @@ (erase-buffer) (insert (format "** %s **\n" archive)) (setq buf nulbuf))) - (pop-to-buffer buf) + (set-buffer buf) (am-set-view-mode-map) (use-local-map am-view-mode-map) - (shrink-window (- (window-height) am-contents-height 1)) (goto-char (point-min)) - (bury-buffer (current-buffer)) + (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") @@ -1245,6 +1354,23 @@ (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") @@ -1252,7 +1378,7 @@ ) (defun am-this-line () - "Force file inspection." + "Force file inspection and erase process queue." (interactive) (if ;;(string= (elt (recent-keys) -1) (substring (recent-keys) -2 -1)) ;;For Emacs 19. @@ -1266,6 +1392,10 @@ (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)) ) @@ -1441,6 +1571,7 @@ (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. @@ -1508,7 +1639,7 @@ (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-unpack-tmpdir) + (setq default-directory (am-convert-backslash am-unpack-tmpdir)) (message "Call %s..." command) (am-call-command command t) (set-buffer cb) @@ -1583,7 +1714,8 @@ (curbuf (current-buffer))) (if (string= files "") (error "No file(s) specified.")) (set-buffer (get-buffer-create am-unpack-buffer)) - (setq default-directory am-unpack-tmpdir) + (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) @@ -1611,7 +1743,7 @@ extended-kanji-code-alist nil t) extended-kanji-code-alist))) ((boundp 'MULE) - (intern (read-coding-system "Coding system: "))))) + (read-coding-system "Coding system: ")))) (cond ((boundp 'NEMACS) (let ((kanji-expected-code code)) @@ -1695,6 +1827,13 @@ (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." ) @@ -1726,12 +1865,45 @@ (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 () @@ -1755,7 +1927,9 @@ (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... @@ -1909,9 +2083,12 @@ ;;;$Log$ -;;;Revision 1.7 1994/05/06 21:32:51 yuuji -;;;Couldn't view file on DOS, fixed. +;;;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. ; @@ -1941,12 +2118,12 @@ ;;;�c���`�m���H�w�����ȊǗ��H�w��U �L���Y�� ;;;Faculty of Science and technology, KEIO Univ. -;;;HIROSE, Yuuji. [yuuji@ae.keio.ac.jp, pcs39334@ASCII-NET] +;;;HIROSE, Yuuji. [yuuji@ae.keio.ac.jp, pcs39334@asciinet.or.jp] ;-- ;;;�p��Ńh�L�������g(English document): ;;;�}�g��w��w�@�����w������ �j�쒼�� ;;;Institute of Phyisics, Univ. of Tsukuba -;;;KATSURAGAWA, Naoki. [katsura@prc.tsukuba.ac.jp, net66331@ASCII-NET] +;;;KATSURAGAWA, Naoki. [katsura@prc.tsukuba.ac.jp, net66331@asciinet.or.jp] ; Local variables: ; fill-prefix: ";;; "