Mercurial > emacs

changeset 63889:abe14daaa679

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Bind inhibit-read-only rather than buffer-read-only. (archive-zip-extract, archive-zip-expunge) (archive-zip-update, archive-zip-update-case): Use executable-find. (archive-resummarize, archive-flag-deleted, archive-unmark-all-files): Use restore-buffer-modified-p. (archive-extract, archive-add-new-member, archive-write-file-member): Use with-current-buffer. (archive-lzh-ogm, archive-zip-chmod-entry): Use dolist.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Thu, 30 Jun 2005 21:52:17 +0000
parents ccf4a0e5ff34
children ad8b4e99c0fa
files lisp/arc-mode.el
diffstat 1 files changed, 48 insertions(+), 59 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/arc-mode.el	Thu Jun 30 21:10:27 2005 +0000
+++ b/lisp/arc-mode.el	Thu Jun 30 21:52:17 2005 +0000
@@ -218,11 +218,10 @@
 ;; Zip archive configuration
 
 (defcustom archive-zip-extract
-  (if (locate-file "unzip" nil 'file-executable-p)
-      '("unzip" "-qq" "-c")
-    (if (locate-file "pkunzip" nil 'file-executable-p)
-	'("pkunzip" "-e" "-o-")
-      '("unzip" "-qq" "-c")))
+  (if (and (not (executable-find "unzip"))
+           (executable-find "pkunzip"))
+      '("pkunzip" "-e" "-o-")
+    '("unzip" "-qq" "-c"))
   "*Program and its options to run in order to extract a zip file member.
 Extraction should happen to standard output.  Archive and member name will
 be added.  If `archive-zip-use-pkzip' is non-nil then this program is
@@ -239,11 +238,10 @@
 ;; names.
 
 (defcustom archive-zip-expunge
-  (if (locate-file "zip" nil 'file-executable-p)
-      '("zip" "-d" "-q")
-    (if (locate-file "pkzip" nil 'file-executable-p)
-	 '("pkzip" "-d")
-      '("zip" "-d" "-q")))
+  (if (and (not (executable-find "zip"))
+           (executable-find "pkzip"))
+      '("pkzip" "-d")
+    '("zip" "-d" "-q"))
   "*Program and its options to run in order to delete zip file members.
 Archive and member names will be added."
   :type '(list (string :tag "Program")
@@ -253,11 +251,10 @@
   :group 'archive-zip)
 
 (defcustom archive-zip-update
-  (if (locate-file "zip" nil 'file-executable-p)
-      '("zip" "-q")
-    (if (locate-file "pkzip" nil 'file-executable-p)
-	 '("pkzip" "-u" "-P")
-      '("zip" "-q")))
+  (if (and (not (executable-find "zip"))
+           (executable-find "pkzip"))
+      '("pkzip" "-u" "-P")
+    '("zip" "-q"))
   "*Program and its options to run in order to update a zip file member.
 Options should ensure that specified directory will be put into the zip
 file.  Archive and member name will be added."
@@ -268,11 +265,10 @@
   :group 'archive-zip)
 
 (defcustom archive-zip-update-case
-  (if (locate-file "zip" nil 'file-executable-p)
-      '("zip" "-q" "-k")
-    (if (locate-file "pkzip" nil 'file-executable-p)
-	 '("pkzip" "-u" "-P")
-      '("zip" "-q" "-k")))
+  (if (and (not (executable-find "zip"))
+           (executable-find "pkzip"))
+      '("pkzip" "-u" "-P")
+    '("zip" "-q" "-k"))
   "*Program and its options to run in order to update a case fiddled zip member.
 Options should ensure that specified directory will be put into the zip file.
 Archive and member name will be added."
@@ -715,7 +711,7 @@
 when parsing the archive."
   (widen)
   (set-buffer-multibyte nil)
-  (let (buffer-read-only)
+  (let ((inhibit-read-only t))
     (or shut-up
 	(message "Parsing archive file..."))
     (buffer-disable-undo (current-buffer))
@@ -733,11 +729,11 @@
   "Recreate the contents listing of an archive."
   (let ((modified (buffer-modified-p))
 	(no (archive-get-lineno))
-	buffer-read-only)
+	(inhibit-read-only t))
     (widen)
     (delete-region (point-min) archive-proper-file-start)
     (archive-summarize t)
-    (set-buffer-modified-p modified)
+    (restore-buffer-modified-p modified)
     (goto-char archive-file-list-start)
     (archive-next-line no)))
 
@@ -832,7 +828,7 @@
 	    (modified (buffer-modified-p))
 	    (coding-system-for-read 'no-conversion)
 	    (lno (archive-get-lineno))
-	    buffer-read-only)
+	    (inhibit-read-only t))
 	(if unchanged nil
 	  (setq archive-files nil)
 	  (erase-buffer)
@@ -932,8 +928,7 @@
 	(setq archive (archive-maybe-copy archive))
         (setq buffer (get-buffer-create bufname))
         (setq just-created t)
-        (save-excursion
-          (set-buffer buffer)
+        (with-current-buffer buffer
           (setq buffer-file-name
                 (expand-file-name (concat arcname ":" iname)))
           (setq buffer-file-truename
@@ -1056,11 +1051,10 @@
 	  (read-buffer "Buffer containing archive: "
 		       ;; Find first archive buffer and suggest that
 		       (let ((bufs (buffer-list)))
-			 (while (and bufs (not (eq (save-excursion
-						     (set-buffer (car bufs))
-						     major-mode)
-						   'archive-mode)))
-			   (setq bufs (cdr bufs)))
+			 (while (and bufs
+                                     (not (with-current-buffer (car bufs)
+                                            (derived-mode-p 'archive-mode))))
+                           (setq bufs (cdr bufs)))
 			 (if bufs
 			     (car bufs)
 			   (error "There are no archive buffers")))
@@ -1069,8 +1063,7 @@
 		      (if buffer-file-name
 			  (file-name-nondirectory buffer-file-name)
 			""))))
-  (save-excursion
-    (set-buffer arcbuf)
+  (with-current-buffer arcbuf
     (or (eq major-mode 'archive-mode)
 	(error "Buffer is not an archive buffer"))
     (if archive-read-only
@@ -1079,12 +1072,11 @@
       (error "An archive buffer cannot be added to itself"))
   (if (string= name "")
       (error "Archive members may not be given empty names"))
-  (let ((func (save-excursion (set-buffer arcbuf)
-			      (archive-name "add-new-member")))
+  (let ((func (with-current-buffer arcbuf
+                (archive-name "add-new-member")))
 	(membuf (current-buffer)))
     (if (fboundp func)
-	(save-excursion
-	  (set-buffer arcbuf)
+	(with-current-buffer arcbuf
 	  (funcall func buffer-file-name membuf name))
       (error "Adding a new member is not supported for this archive type"))))
 ;; -------------------------------------------------------------------------
@@ -1095,10 +1087,10 @@
     (save-restriction
       (message "Updating archive...")
       (widen)
-      (let ((writer  (save-excursion (set-buffer archive-superior-buffer)
-				     (archive-name "write-file-member")))
-	    (archive (save-excursion (set-buffer archive-superior-buffer)
-				     (archive-maybe-copy (buffer-file-name)))))
+      (let ((writer  (with-current-buffer archive-superior-buffer
+                       (archive-name "write-file-member")))
+	    (archive (with-current-buffer archive-superior-buffer
+                       (archive-maybe-copy (buffer-file-name)))))
 	(if (fboundp writer)
 	    (funcall writer archive archive-subfile-mode)
 	  (archive-*-write-file-member archive
@@ -1167,7 +1159,7 @@
   (beginning-of-line)
   (let ((sign (if (>= p 0) +1 -1))
 	(modified (buffer-modified-p))
-        buffer-read-only)
+        (inhibit-read-only t))
     (while (not (zerop p))
       (if (archive-get-descr t)
           (progn
@@ -1175,7 +1167,7 @@
             (insert type)))
       (forward-line sign)
       (setq p (- p sign)))
-    (set-buffer-modified-p modified))
+    (restore-buffer-modified-p modified))
   (archive-next-line 0))
 
 (defun archive-unflag (p)
@@ -1194,14 +1186,14 @@
   "Remove all marks."
   (interactive)
   (let ((modified (buffer-modified-p))
-	buffer-read-only)
+	(inhibit-read-only t))
     (save-excursion
       (goto-char archive-file-list-start)
       (while (< (point) archive-file-list-end)
         (or (= (following-char) ? )
             (progn (delete-char 1) (insert ? )))
         (forward-line 1)))
-    (set-buffer-modified-p modified)))
+    (restore-buffer-modified-p modified)))
 
 (defun archive-mark (p)
   "In archive mode, mark this member for group operations.
@@ -1339,7 +1331,7 @@
   "Undo in an archive buffer.
 This doesn't recover lost files, it just undoes changes in the buffer itself."
   (interactive)
-  (let (buffer-read-only)
+  (let ((inhibit-read-only t))
     (undo)))
 ;; -------------------------------------------------------------------------
 ;; Section: Arc Archives
@@ -1398,7 +1390,7 @@
       (error "File names in arc files are limited to 12 characters"))
   (let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0"
 					 (length newname))))
-	buffer-read-only)
+	(inhibit-read-only t))
     (save-restriction
       (save-excursion
 	(widen)
@@ -1570,7 +1562,7 @@
 	     (oldfnlen (char-after (+ p 21)))
 	     (newfnlen (length newname))
 	     (newhsize (+ oldhsize newfnlen (- oldfnlen)))
-	     buffer-read-only)
+	     (inhibit-read-only t))
 	(if (> newhsize 255)
 	    (error "The file name is too long"))
 	(goto-char (+ p 21))
@@ -1585,14 +1577,13 @@
     (save-excursion
       (widen)
       (set-buffer-multibyte nil)
-      (while files
-	(let* ((fil (car files))
-	       (p (+ archive-proper-file-start (aref fil 4)))
+      (dolist (fil files)
+	(let* ((p (+ archive-proper-file-start (aref fil 4)))
 	       (hsize   (char-after p))
 	       (fnlen   (char-after (+ p 21)))
 	       (p2      (+ p 22 fnlen))
 	       (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
-	       buffer-read-only)
+	       (inhibit-read-only t))
 	  (if (= creator ?U)
 	      (progn
 		(or (numberp newval)
@@ -1604,8 +1595,7 @@
 		(delete-char 1)
 		(insert (archive-lzh-resum (1+ p) hsize)))
 	    (message "Member %s does not have %s field"
-		     (aref fil 1) errtxt)))
-	(setq files (cdr files))))))
+		     (aref fil 1) errtxt)))))))
 
 (defun archive-lzh-chown-entry (newuid files)
   (archive-lzh-ogm newuid files "an uid" 10))
@@ -1709,13 +1699,12 @@
     (save-excursion
       (widen)
       (set-buffer-multibyte nil)
-      (while files
-	(let* ((fil (car files))
-	       (p (+ archive-proper-file-start (car (aref fil 4))))
+      (dolist (fil files)
+	(let* ((p (+ archive-proper-file-start (car (aref fil 4))))
 	       (creator (char-after (+ p 5)))
 	       (oldmode (aref fil 3))
 	       (newval  (archive-calc-mode oldmode newmode t))
-	       buffer-read-only)
+	       (inhibit-read-only t))
 	  (cond ((memq creator '(2 3)) ; Unix + VMS
 		 (goto-char (+ p 40))
 		 (delete-char 2)
@@ -1726,7 +1715,7 @@
 				 (logand (logxor 1 (lsh newval -7)) 1)))
 		 (delete-char 1))
 		(t (message "Don't know how to change mode for this member"))))
-	(setq files (cdr files))))))
+        ))))
 ;; -------------------------------------------------------------------------
 ;; Section: Zoo Archives