diff --git a/arch.el b/arch.el index 95254f2..3691bd3 100644 --- a/arch.el +++ b/arch.el @@ -1,11 +1,11 @@ ;;; -*- Emacs-Lisp -*- ;;; Multi format Archive file handler for Emacs. -;;; -;;; arch.el version 1.4 -;;; (c)1993 by HIROSE Yuuji.[yuuji@ae.keio.ac.jp] -;;; Last modified Mon Feb 14 16:51:52 1994 on figaro +;;; +;;; arch.el version 1.6 +;;; (c ) 1993,1994 by HIROSE Yuuji.[yuuji@ae.keio.ac.jp] +;;; Last modified Wed Mar 23 15:01:58 1994 on figaro -;; This program is free software; you can redistribute it and/or modify +;; Marche is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. @@ -27,13 +27,13 @@ ;;; ;;; Document: ;;; -;;; Multi format ARChived file Handler for Emacs: [MARCHE] +;;; Multi format ARChive file Handler for Emacs: [MARCHE] ;;; ;;;[What is MARCHE?] ;;; -;;; When you visit an archive file created by 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 +;;; 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] @@ -45,9 +45,9 @@ ;;; (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 'arc-mode) +;;; (cons (cons am-file-name-regexp 'marche) ;;; auto-mode-alist)) -;;; (autoload 'arc-mode "arch" "Archived file mode." t) +;;; (autoload 'marche "arch" "Archive file mode." t) ;;; ;;;[Listing Buffer] ;;; @@ -104,17 +104,15 @@ ;;; ;;;[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 +;;; 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. You need to remember that pressing the key normally -;;; assigned to the function save-buffer(C-x C-s by default) saves -;;; the current buffer and updates the archive in which the file -;;; belongs. And pressing the key normally assigned to the function -;;; 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). +;;; 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] ;;; @@ -141,10 +139,10 @@ ;;; 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 the queue. There are 3 +;;; 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. +;;; 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' @@ -164,9 +162,7 @@ ;;; Here are the all hook variables of MARCHE. ;;; ;;; arc-mode-hook will be parsed at -;;; the end of initialization of arc-mode. -;;; am-setup-edit-mode-map-hook will be parsed at -;;; the first time of find-file in archive +;;; the end of initialization of MARCHE. ;;; am-view-mode-hook will be parsed at ;;; every time before entering view-mode ;;; marche-load-hook will be parsed at @@ -230,16 +226,23 @@ ;;; ;;; *My archiver does not allow / as a path delimiter(MS-DOS). ;;; -;;; Write (put 'ArchvierName 'use-backslash t) in your .emacs. +;;; Write (put 'ArchiverName 'use-backslash t) in your .emacs. +;;; +;;; *Can't customize to handle the archive of capital file name. +;;; +;;; Redifining 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.4 (C)1994 by yuuji |<-titles +;;; MARCHE ver 1.6 (C)1994 by yuuji |<-titles ;;; Size Time Date Name |<-column table ;;; ----- ----- -------- -------------- |<-section line -;;; 62936 15:42 94/02/10 arch.el |<-table +;;; 69440 15:01 94/03/21 arch.el |<-table ;;; : | : ;;; ----- ----- -------- -------------- |<-section line ;;; @@ -265,7 +268,6 @@ ;;; 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 ;;; @@ -290,9 +292,9 @@ ;;; (defvar am-file-name-regexp "\\.\\(lzh\\|arj\\|arc\\|zip\\|zoo\\)$" ;;; "*[�܂邵��]���N������t�@�C�����̐��K�\��.") ;;; (setq auto-mode-alist -;;; (cons (cons am-file-name-regexp 'arc-mode) +;;; (cons (cons am-file-name-regexp 'marche) ;;; auto-mode-alist)) -;;; (autoload 'arc-mode "arch" "Archived file mode." t) +;;; (autoload 'marche "arch" "Archive file mode." t) ;;; ;;;�y�ꗗ��ʁz ;;; @@ -404,8 +406,6 @@ ;;; ;;; arc-mode-hook ;;; arc-mode �̏��������I������� -;;; am-setup-edit-mode-map-hook -;;; �A�[�J�C�u���̃t�@�C���ҏW���A�L�[�}�b�v��ύX�������� ;;; am-view-mode-hook ;;; �t�@�C���{���� view-mode �ɓ��钼�O(�L�[�}�b�v���[�h��) ;;; marche-load-hook @@ -473,6 +473,13 @@ ;;; ;;; (put '�A�[�J�C�o�� 'use-backslash t) �Ƃ��ĉ������B ;;; +;;; �E�啶���̃t�@�C������������悤�ɃJ�X�^�}�C�Y�ł��Ȃ��B +;;; +;;; am-file-name-regexp �ɑ啶���p�^�[�����`���邾���ł͕s�\���� +;;; ���B�ϐ� am-archiver-alist �ɁA�������̎��Ɏg����`�́u�g���q�v +;;; �̕�����啶���ɕς������̂��`���Ă�������(�y�J�X�^�}�C�Y�z�� +;;; ���Q��)�B +;;; ;;;�y�햾�����z ;;; ;;; �E�e�[�u���t�H�[�}�b�g @@ -480,10 +487,10 @@ ;;; �A�[�J�C�o�̏o�͂���e�[�u���́A���̂悤�ȃt�H�[�}�b�g�ł���� ;;; ���肵�Ă��܂��B ;;; -;;; MARCHE ver 1.4 (C)1994 by yuuji |���^�C�g���Ȃ� +;;; MARCHE ver 1.6 (C)1994 by yuuji |���^�C�g���Ȃ� ;;; Size Time Date Name |�����ڌ��o�� ;;; ----- ----- -------- -------------- |����r�� -;;; 62936 15:42 94/02/10 arch.el |�����ۂ̃e�[�u�� +;;; 69440 15:01 94/03/21 arch.el |�����ۂ̃e�[�u�� ;;; : | : ;;; ----- ----- -------- -------------- |�����r�� ;;; @@ -532,11 +539,13 @@ "T if marche is running on OS which ignores file name case." ) (defconst 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.") + "*Regexp of file name Arc mode should begin.") (defvar am-archiver-alist-default (list ;; ext cmd view print extract udpate delete @@ -583,8 +592,15 @@ (defvar am-unpack-buffer "*Unpack*") (defvar am-unlink-command "rm -f" "*Name of command string to unlink files.") -(defvar am-unpack-tmpdir (if (and am-on-dos debug) "j:/tmp" nil) - "By default, edited file will be extacted into directory where +(defvar am-unpack-tmpdir + (or (if (and am-on-dos debug) "j:/tmp") + (and (getenv "TMP") (am-convert-backslash (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." ) @@ -600,8 +616,30 @@ (defvar am-sjis-flag am-on-dos "Assume file contents consist of sjis." ) -(defvar am-archive-file-name nil - "Keeps file name of the archive.") +(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.") +(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 @@ -609,10 +647,10 @@ (defconst am-can-inspect (and (fboundp 'start-process) (fboundp 'set-process-sentinel) (fboundp 'interrupt-process)) - "T if running OS can have multi process.") + "Non-nil if running OS can have multi process.") (defvar am-inspect-mode am-can-inspect - "*T for viewing the contents of file on other window.") + "*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.") @@ -633,26 +671,19 @@ (defvar am-process-queue nil "Queue used for process of inspection.") -(defvar am-max-process 3 - "*Maximum number of process running at the same time.") - (defvar am-queueing-method 'newestonly - "*Method of queueing of process for inspection. Possible methods are... + "*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 - "*If non-nil, discard process queue (not running yet) when + "*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.") -(defvar am-children-list nil - "Holds the child files of archive file." -) -(defvar am-favorite-listing nil - "Keeps the temporary listing switch to view listing of the table." -) ;;; ;; Marche functions @@ -677,15 +708,19 @@ ) (defun am-refresh-kanji (&optional proc mes) - "Check kanji code of currnet buffer and refresh it so that it -will be readable." - (let (code (buffer-read-only nil)) + "Check kanji code of currnet buffer and refresh it to be readable." + (let (code (buffer-read-only nil) (pbuf (process-buffer proc)) + (sw (selected-window))) (save-excursion - (if (and proc (processp proc)) (set-buffer (process-buffer proc))) + (if (and proc (processp proc)) (set-buffer pbuf)) (setq buffer-read-only nil) (cond ((boundp 'MULE) - (setq code (detect-code-category (point-min) (am-detect-range))) + (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))) (if (listp code) (setq code (car code))) (if (eq code t) nil (code-convert (point-min) (point-max) code *internal*))) @@ -694,24 +729,32 @@ ;;(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))))) + (point-min) (point-max) code am-nemacs-raw-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-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 + "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 (if (eq system-type 'ms-dos) "/c" "-c") 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 ?\\ )) @@ -719,6 +762,7 @@ 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 ?/)) @@ -726,6 +770,7 @@ 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 @@ -733,8 +778,9 @@ ) (defun am-build-command (type list file &optional arg) - "Build command line in order to do the job of TYPE, -referring the argument LIST and FILE." + "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)))) @@ -757,7 +803,7 @@ ) (defun am-get-file-name () - "Get file name on current line." + "Get the file name on the current line." (cond ((am-on-file-name-line-p) (move-to-column am-file-name-column) @@ -765,36 +811,44 @@ (buffer-substring (point) (save-excursion - (skip-chars-forward "^ \t\n" (point-end-of-line)) (point))))) + (skip-chars-forward "^ \t\n" (am-point-end-of-line)) (point))))) (t nil)) ) (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) (if (eq major-mode 'am-view-mode) (let ((parent am-parent-buffer)) @@ -807,17 +861,21 @@ (bury-buffer (current-buffer)) (switch-to-buffer parent)))) (defun am-view-search-next (arg) + "Marche view mode: Continuous search forward." (interactive "p") - (search-forward search-last-string nil t arg) + (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 search-last-string nil t arg) + (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." + "Key map used in view-mode in Arc mode." ) (defun am-set-view-mode-map () "Set `less' oriented extended view mode map." @@ -848,6 +906,7 @@ ) (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) @@ -902,9 +961,11 @@ ) (defun am-view-buffer-name (archive file) + "Return the buffer name of view-buffer." (concat "*" file " in " (file-name-nondirectory archive) "*")) (defun am-show-buffer-name (archive file) + "Return the buffer name of show-buffer." (concat "*" (file-name-nondirectory archive) ":" file "*")) (defun am-view-file () @@ -932,12 +993,47 @@ ) (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) ;???? + (t 10) ;?????? + )) + (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))) + (defun am-chop-queue (entry) + "Chop the process entry ENTRY in am-process-queue." (if (null am-process-queue) (am-message-job-done entry) (let ((qlist am-process-queue) (i 0) (len (length am-process-queue)) queue) @@ -962,6 +1058,9 @@ ) (defun am-start-proc-with-queue (buffer command sentinel &optional chop) + "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) @@ -1001,6 +1100,7 @@ ) (defun am-flush-process-queue () + "Flush the proces queue." (if am-process-queue (let ((curbuf (current-buffer))) (mapcar '(lambda (entry) @@ -1016,35 +1116,8 @@ (setq am-process-queue nil) ) -(defun am-suitable-max-process () - "Guess the number of processes emacs can run at the same time without -losing reasonable response. -** 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) ;???? - (t 10) ;?????? - )) - (message "%s...Done(count:%d, level:%d)" mes i result) - (sit-for 1) ;bothering?? (^^;) - result) -) - (defun am-show-contents (file) + "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)) @@ -1106,8 +1179,7 @@ ) (defun am-change-column (arg) - "Change am-file-name-column to the column where cursor belongs, -and call am-view-file." + "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)) @@ -1123,7 +1195,7 @@ ) (defun am-guess-file-name-column () - "Guess the column of the file names in the listing table, and return it." + "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)) @@ -1145,13 +1217,14 @@ (goto-char am-begin-position) (move-to-column col) (skip-chars-backward "^ \t^\n" ;`^' for zip - (point-beginning-of-line)) + (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) (point-end-of-line)))))) + (progn (forward-line -1) + (am-point-end-of-line)))))) col) (t (am-unkown-table))))) ) @@ -1166,7 +1239,7 @@ (let ((file (am-get-file-name))) (move-to-column am-file-name-column) (if (looking-at " ") (am-next-line arg) - (skip-chars-backward "^ \t" (point-end-of-line)) + (skip-chars-backward "^ \t" (am-point-end-of-line)) (if am-inspect-mode (am-show-contents file)))) (beginning-of-line)) ) @@ -1178,8 +1251,12 @@ ) (defun am-this-line () + "Force file inspection." (interactive) - (if (string= (substring (recent-keys) -1) (substring (recent-keys) -2 -1)) + (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)) @@ -1210,20 +1287,20 @@ (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)) - (if (and (= (screen-width) (nth 0 config)) - (= (screen-height) (nth 1 config))) - (set-window-configuration (nth 2 config)))) + (set-window-configuration config)) ) (defun am-mark-file-forward (arg &optional sw) @@ -1235,7 +1312,7 @@ (let ((file (am-get-file-name))) (setq buffer-read-only nil) (set-buffer-modified-p t) ;to avoid locking - (skip-chars-backward "^ \*" (point-beginning-of-line)) + (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)) @@ -1272,24 +1349,31 @@ (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)) - (delete-file file) + (am-remove-file file) (error "Aborted.")) (if (file-exists-p file) (error "Cannot unlink %s" file)) )) ) -(defun am-revert-buffer () - "Replace the buffer with the archive contents on disk and initialize all." +(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) - (setq buffer-file-name am-archive-file-name) (message "Reverting buffer...") (save-excursion (let ((buf (current-buffer)) @@ -1303,6 +1387,7 @@ (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) @@ -1312,6 +1397,7 @@ ) (defun am-change-listing (cmd) + "Change the listing switch of the corresponding archiver." (interactive "sListing switch: ") (setq am-favorite-listing cmd) (am-revert-buffer) @@ -1401,56 +1487,89 @@ )) ) -(defun am-save-buffer (&optional arg) - "Save this buffer and update archive." - (interactive "p") +(defun am-save-buffer () + "Save this buffer and update archive. +This function can be called interactively." + (interactive) (save-excursion - (if (buffer-modified-p) - (let ((command am-update-command) - (pbuf am-parent-buffer)) - (save-buffer arg) - (set-buffer (get-buffer-create am-update-buffer)) - (setq default-directory am-unpack-tmpdir) - (message "Call %s..." command) - (am-call-command command t) - (message "Call %s...Done" command)) - (message "No changes need to be saved"))) + (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-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-kill-buffer (arg) - "Kill buffer and erase temporary file." - (interactive "bKill buffer and erase file: ") - (if (or (and (stringp arg) (string= (buffer-name) arg)) - (eq (current-buffer) arg)) - (delete-file (if am-on-dos (downcase (buffer-file-name)) - (buffer-file-name)))) - (kill-buffer arg) +(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) - (find-file file) - (make-local-variable 'am-parent-archive) - (setq am-parent-archive archive) + (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*))))) + (t (find-file file))) (make-local-variable 'am-parent-buffer) (setq am-parent-buffer curbuf) - (make-local-variable 'am-myname) - (setq am-myname file) (make-local-variable 'am-update-command) (setq am-update-command (am-build-command 'update list archive file)) - (make-local-variable 'am-edit-mode-map) - (am-setup-edit-mode-map) - (use-local-map am-edit-mode-map) - (global-set-key "\ex" 'execute-extended-command) - ))) + (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." + "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 " ")) @@ -1470,32 +1589,50 @@ (mapcar 'am-ask-overwrite flist)) (am-call-command (am-build-command 'extract list archive files) nil) (mapcar 'am-find-file flist) - (message - (substitute-command-keys - "Type \\[am-kill-buffer] to both kill-buffer and erase temporary file.")) - (sit-for 3) - (message - (substitute-command-keys - "Type \\[am-save-buffer] to both save-buffer and update archive.")) (set-buffer curbuf) - ) + (if (or (boundp 'NEMACS) (boundp 'MULE)) + (message "�����������Ă����� M-x am-re-find-file"))) ) -(defvar am-edit-mode-map nil - "Key map used in archive file edit mode." -) -(defun am-setup-edit-mode-map () - (if am-edit-mode-map nil - (message "Setting up edit mode keymap...") - (setq am-edit-mode-map - (if (current-local-map) (copy-keymap (current-local-map)) - (make-sparse-keymap))) - (mapcar '(lambda (key) (define-key am-edit-mode-map key 'am-save-buffer)) - (where-is-internal 'save-buffer)) - (mapcar '(lambda (key) (define-key am-edit-mode-map key 'am-kill-buffer)) - (where-is-internal 'kill-buffer)) - (run-hooks 'am-setup-edit-mode-map-hook) - (message "Setting up edit mode keymap...Done.")) +(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) + (intern (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 () @@ -1518,12 +1655,10 @@ (defun am-undo (arg) "Undo function for listing buffer." (interactive "P") - (setq buffer-read-only nil) - (set-buffer-modified-p t) - (undo arg) - (am-get-marks) - (set-buffer-modified-p nil) - (setq buffer-read-only t) + (let ((buffer-read-only nil)) + (undo arg) + (am-get-marks) + (setq buffer-read-only t)) ) (defun am-mark-files-regexp (regexp) @@ -1560,7 +1695,7 @@ ) (defvar arc-mode-map nil - "Key map used in arc-mode." + "Key map used in Arc mode." ) (if arc-mode-map nil @@ -1572,7 +1707,7 @@ (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" 'am-revert-buffer) + (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) @@ -1586,6 +1721,7 @@ (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) @@ -1605,10 +1741,11 @@ ) (defun am-initiate-buffer () + "Make the initial Arc mode's buffer." (setq buffer-read-only nil) (save-excursion (if am-file-name-column - (progn (delete-region (point-min) (point-max)) (widen))) + (widen)) (erase-buffer) (am-insert-listing) (make-local-variable 'am-file-name-column) @@ -1626,7 +1763,7 @@ ) (defun am-get-buffer (file) - "Get arc-mode buffer named FILE." + "Get Arc mode buffer named FILE." (let ((list (buffer-list))) (save-excursion (catch 'found @@ -1647,7 +1784,7 @@ (fset 'am:saved-find-file-noselect (symbol-function 'find-file-noselect)) (defun find-file-noselect (filename &optional nowarn) (setq filename (expand-file-name filename)) - (let ((buf (am-get-buffer filename)) ;find arc-mode buffer + (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) @@ -1659,13 +1796,29 @@ (setq default-directory (file-name-directory filename)) (setq buffer-file-name filename) ;;Entrust normal-mode with error operations. - (normal-mode t)) ;;must be (arc-mode);; + (normal-mode t) + ;;;(setq buf (marche filename)) + ) ;;must be (arc-mode);; (setq buf (am:saved-find-file-noselect filename nowarn)))) 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] + "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 @@ -1684,67 +1837,83 @@ \\[am-enlarge-window] Enlarge window \\[am-shrink-window] Shrink window \\[am-undo] Undo - \\[am-revert-buffer] Revert buffer + \\[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', `am-setup-edit-mode-map-hook' and `am-view-mode-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 - (list (screen-width) (screen-height) (current-window-configuration))) + (setq am-initial-configuration (current-window-configuration)) (auto-save-mode 0) (goto-char (point-min)) (make-local-variable 'am-archive-file-name) - (if am-archive-file-name nil - (setq am-archive-file-name (buffer-file-name)) - (setq buffer-file-name nil)) ;;Disconnect to the file + (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))) + (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.") - (run-hooks 'arc-mode-hook) (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) -(setq am-unpack-tmpdir - (or am-unpack-tmpdir - (and (getenv "TMP") (am-convert-backslash (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 - "/")) -(setq am-max-process (am-suitable-max-process)) -;; --------------- General sub functions --------------- -(defun point-beginning-of-line () - (save-excursion (beginning-of-line)(point)) -) - -(defun point-end-of-line () - (save-excursion (end-of-line)(point)) -) ;;;$Log$ -;;;Revision 1.5 1994/02/14 08:19:48 yuuji -;;;Sent to GNU. +;;;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. ;