aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2005-06-30 21:52:17 +0000
committerStefan Monnier2005-06-30 21:52:17 +0000
commite545bb99ddf5b40a7a818f0f0ce4d61c3f69f618 (patch)
treeb5d95c913b56ee3883c8fbd33147ed51c611f7ac
parent0a0157ba2ca8e3fade0f7f225cdfd125573e59d6 (diff)
downloademacs-e545bb99ddf5b40a7a818f0f0ce4d61c3f69f618.tar.gz
emacs-e545bb99ddf5b40a7a818f0f0ce4d61c3f69f618.zip
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.
-rw-r--r--lisp/arc-mode.el107
1 files changed, 48 insertions, 59 deletions
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 13f4559cfaf..5ed0eb494c0 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -218,11 +218,10 @@ Archive and member name will be added."
218;; Zip archive configuration 218;; Zip archive configuration
219 219
220(defcustom archive-zip-extract 220(defcustom archive-zip-extract
221 (if (locate-file "unzip" nil 'file-executable-p) 221 (if (and (not (executable-find "unzip"))
222 '("unzip" "-qq" "-c") 222 (executable-find "pkunzip"))
223 (if (locate-file "pkunzip" nil 'file-executable-p) 223 '("pkunzip" "-e" "-o-")
224 '("pkunzip" "-e" "-o-") 224 '("unzip" "-qq" "-c"))
225 '("unzip" "-qq" "-c")))
226 "*Program and its options to run in order to extract a zip file member. 225 "*Program and its options to run in order to extract a zip file member.
227Extraction should happen to standard output. Archive and member name will 226Extraction should happen to standard output. Archive and member name will
228be added. If `archive-zip-use-pkzip' is non-nil then this program is 227be added. If `archive-zip-use-pkzip' is non-nil then this program is
@@ -239,11 +238,10 @@ expected to extract to a file junking the directory part of the name."
239;; names. 238;; names.
240 239
241(defcustom archive-zip-expunge 240(defcustom archive-zip-expunge
242 (if (locate-file "zip" nil 'file-executable-p) 241 (if (and (not (executable-find "zip"))
243 '("zip" "-d" "-q") 242 (executable-find "pkzip"))
244 (if (locate-file "pkzip" nil 'file-executable-p) 243 '("pkzip" "-d")
245 '("pkzip" "-d") 244 '("zip" "-d" "-q"))
246 '("zip" "-d" "-q")))
247 "*Program and its options to run in order to delete zip file members. 245 "*Program and its options to run in order to delete zip file members.
248Archive and member names will be added." 246Archive and member names will be added."
249 :type '(list (string :tag "Program") 247 :type '(list (string :tag "Program")
@@ -253,11 +251,10 @@ Archive and member names will be added."
253 :group 'archive-zip) 251 :group 'archive-zip)
254 252
255(defcustom archive-zip-update 253(defcustom archive-zip-update
256 (if (locate-file "zip" nil 'file-executable-p) 254 (if (and (not (executable-find "zip"))
257 '("zip" "-q") 255 (executable-find "pkzip"))
258 (if (locate-file "pkzip" nil 'file-executable-p) 256 '("pkzip" "-u" "-P")
259 '("pkzip" "-u" "-P") 257 '("zip" "-q"))
260 '("zip" "-q")))
261 "*Program and its options to run in order to update a zip file member. 258 "*Program and its options to run in order to update a zip file member.
262Options should ensure that specified directory will be put into the zip 259Options should ensure that specified directory will be put into the zip
263file. Archive and member name will be added." 260file. Archive and member name will be added."
@@ -268,11 +265,10 @@ file. Archive and member name will be added."
268 :group 'archive-zip) 265 :group 'archive-zip)
269 266
270(defcustom archive-zip-update-case 267(defcustom archive-zip-update-case
271 (if (locate-file "zip" nil 'file-executable-p) 268 (if (and (not (executable-find "zip"))
272 '("zip" "-q" "-k") 269 (executable-find "pkzip"))
273 (if (locate-file "pkzip" nil 'file-executable-p) 270 '("pkzip" "-u" "-P")
274 '("pkzip" "-u" "-P") 271 '("zip" "-q" "-k"))
275 '("zip" "-q" "-k")))
276 "*Program and its options to run in order to update a case fiddled zip member. 272 "*Program and its options to run in order to update a case fiddled zip member.
277Options should ensure that specified directory will be put into the zip file. 273Options should ensure that specified directory will be put into the zip file.
278Archive and member name will be added." 274Archive and member name will be added."
@@ -715,7 +711,7 @@ Optional argument SHUT-UP, if non-nil, means don't print messages
715when parsing the archive." 711when parsing the archive."
716 (widen) 712 (widen)
717 (set-buffer-multibyte nil) 713 (set-buffer-multibyte nil)
718 (let (buffer-read-only) 714 (let ((inhibit-read-only t))
719 (or shut-up 715 (or shut-up
720 (message "Parsing archive file...")) 716 (message "Parsing archive file..."))
721 (buffer-disable-undo (current-buffer)) 717 (buffer-disable-undo (current-buffer))
@@ -733,11 +729,11 @@ when parsing the archive."
733 "Recreate the contents listing of an archive." 729 "Recreate the contents listing of an archive."
734 (let ((modified (buffer-modified-p)) 730 (let ((modified (buffer-modified-p))
735 (no (archive-get-lineno)) 731 (no (archive-get-lineno))
736 buffer-read-only) 732 (inhibit-read-only t))
737 (widen) 733 (widen)
738 (delete-region (point-min) archive-proper-file-start) 734 (delete-region (point-min) archive-proper-file-start)
739 (archive-summarize t) 735 (archive-summarize t)
740 (set-buffer-modified-p modified) 736 (restore-buffer-modified-p modified)
741 (goto-char archive-file-list-start) 737 (goto-char archive-file-list-start)
742 (archive-next-line no))) 738 (archive-next-line no)))
743 739
@@ -832,7 +828,7 @@ using `make-temp-file', and the generated name is returned."
832 (modified (buffer-modified-p)) 828 (modified (buffer-modified-p))
833 (coding-system-for-read 'no-conversion) 829 (coding-system-for-read 'no-conversion)
834 (lno (archive-get-lineno)) 830 (lno (archive-get-lineno))
835 buffer-read-only) 831 (inhibit-read-only t))
836 (if unchanged nil 832 (if unchanged nil
837 (setq archive-files nil) 833 (setq archive-files nil)
838 (erase-buffer) 834 (erase-buffer)
@@ -932,8 +928,7 @@ using `make-temp-file', and the generated name is returned."
932 (setq archive (archive-maybe-copy archive)) 928 (setq archive (archive-maybe-copy archive))
933 (setq buffer (get-buffer-create bufname)) 929 (setq buffer (get-buffer-create bufname))
934 (setq just-created t) 930 (setq just-created t)
935 (save-excursion 931 (with-current-buffer buffer
936 (set-buffer buffer)
937 (setq buffer-file-name 932 (setq buffer-file-name
938 (expand-file-name (concat arcname ":" iname))) 933 (expand-file-name (concat arcname ":" iname)))
939 (setq buffer-file-truename 934 (setq buffer-file-truename
@@ -1056,11 +1051,10 @@ using `make-temp-file', and the generated name is returned."
1056 (read-buffer "Buffer containing archive: " 1051 (read-buffer "Buffer containing archive: "
1057 ;; Find first archive buffer and suggest that 1052 ;; Find first archive buffer and suggest that
1058 (let ((bufs (buffer-list))) 1053 (let ((bufs (buffer-list)))
1059 (while (and bufs (not (eq (save-excursion 1054 (while (and bufs
1060 (set-buffer (car bufs)) 1055 (not (with-current-buffer (car bufs)
1061 major-mode) 1056 (derived-mode-p 'archive-mode))))
1062 'archive-mode))) 1057 (setq bufs (cdr bufs)))
1063 (setq bufs (cdr bufs)))
1064 (if bufs 1058 (if bufs
1065 (car bufs) 1059 (car bufs)
1066 (error "There are no archive buffers"))) 1060 (error "There are no archive buffers")))
@@ -1069,8 +1063,7 @@ using `make-temp-file', and the generated name is returned."
1069 (if buffer-file-name 1063 (if buffer-file-name
1070 (file-name-nondirectory buffer-file-name) 1064 (file-name-nondirectory buffer-file-name)
1071 "")))) 1065 ""))))
1072 (save-excursion 1066 (with-current-buffer arcbuf
1073 (set-buffer arcbuf)
1074 (or (eq major-mode 'archive-mode) 1067 (or (eq major-mode 'archive-mode)
1075 (error "Buffer is not an archive buffer")) 1068 (error "Buffer is not an archive buffer"))
1076 (if archive-read-only 1069 (if archive-read-only
@@ -1079,12 +1072,11 @@ using `make-temp-file', and the generated name is returned."
1079 (error "An archive buffer cannot be added to itself")) 1072 (error "An archive buffer cannot be added to itself"))
1080 (if (string= name "") 1073 (if (string= name "")
1081 (error "Archive members may not be given empty names")) 1074 (error "Archive members may not be given empty names"))
1082 (let ((func (save-excursion (set-buffer arcbuf) 1075 (let ((func (with-current-buffer arcbuf
1083 (archive-name "add-new-member"))) 1076 (archive-name "add-new-member")))
1084 (membuf (current-buffer))) 1077 (membuf (current-buffer)))
1085 (if (fboundp func) 1078 (if (fboundp func)
1086 (save-excursion 1079 (with-current-buffer arcbuf
1087 (set-buffer arcbuf)
1088 (funcall func buffer-file-name membuf name)) 1080 (funcall func buffer-file-name membuf name))
1089 (error "Adding a new member is not supported for this archive type")))) 1081 (error "Adding a new member is not supported for this archive type"))))
1090;; ------------------------------------------------------------------------- 1082;; -------------------------------------------------------------------------
@@ -1095,10 +1087,10 @@ using `make-temp-file', and the generated name is returned."
1095 (save-restriction 1087 (save-restriction
1096 (message "Updating archive...") 1088 (message "Updating archive...")
1097 (widen) 1089 (widen)
1098 (let ((writer (save-excursion (set-buffer archive-superior-buffer) 1090 (let ((writer (with-current-buffer archive-superior-buffer
1099 (archive-name "write-file-member"))) 1091 (archive-name "write-file-member")))
1100 (archive (save-excursion (set-buffer archive-superior-buffer) 1092 (archive (with-current-buffer archive-superior-buffer
1101 (archive-maybe-copy (buffer-file-name))))) 1093 (archive-maybe-copy (buffer-file-name)))))
1102 (if (fboundp writer) 1094 (if (fboundp writer)
1103 (funcall writer archive archive-subfile-mode) 1095 (funcall writer archive archive-subfile-mode)
1104 (archive-*-write-file-member archive 1096 (archive-*-write-file-member archive
@@ -1167,7 +1159,7 @@ With a prefix argument, mark that many files."
1167 (beginning-of-line) 1159 (beginning-of-line)
1168 (let ((sign (if (>= p 0) +1 -1)) 1160 (let ((sign (if (>= p 0) +1 -1))
1169 (modified (buffer-modified-p)) 1161 (modified (buffer-modified-p))
1170 buffer-read-only) 1162 (inhibit-read-only t))
1171 (while (not (zerop p)) 1163 (while (not (zerop p))
1172 (if (archive-get-descr t) 1164 (if (archive-get-descr t)
1173 (progn 1165 (progn
@@ -1175,7 +1167,7 @@ With a prefix argument, mark that many files."
1175 (insert type))) 1167 (insert type)))
1176 (forward-line sign) 1168 (forward-line sign)
1177 (setq p (- p sign))) 1169 (setq p (- p sign)))
1178 (set-buffer-modified-p modified)) 1170 (restore-buffer-modified-p modified))
1179 (archive-next-line 0)) 1171 (archive-next-line 0))
1180 1172
1181(defun archive-unflag (p) 1173(defun archive-unflag (p)
@@ -1194,14 +1186,14 @@ With a prefix argument, un-mark that many members backward."
1194 "Remove all marks." 1186 "Remove all marks."
1195 (interactive) 1187 (interactive)
1196 (let ((modified (buffer-modified-p)) 1188 (let ((modified (buffer-modified-p))
1197 buffer-read-only) 1189 (inhibit-read-only t))
1198 (save-excursion 1190 (save-excursion
1199 (goto-char archive-file-list-start) 1191 (goto-char archive-file-list-start)
1200 (while (< (point) archive-file-list-end) 1192 (while (< (point) archive-file-list-end)
1201 (or (= (following-char) ? ) 1193 (or (= (following-char) ? )
1202 (progn (delete-char 1) (insert ? ))) 1194 (progn (delete-char 1) (insert ? )))
1203 (forward-line 1))) 1195 (forward-line 1)))
1204 (set-buffer-modified-p modified))) 1196 (restore-buffer-modified-p modified)))
1205 1197
1206(defun archive-mark (p) 1198(defun archive-mark (p)
1207 "In archive mode, mark this member for group operations. 1199 "In archive mode, mark this member for group operations.
@@ -1339,7 +1331,7 @@ as a relative change like \"g+rw\" as for chmod(2)"
1339 "Undo in an archive buffer. 1331 "Undo in an archive buffer.
1340This doesn't recover lost files, it just undoes changes in the buffer itself." 1332This doesn't recover lost files, it just undoes changes in the buffer itself."
1341 (interactive) 1333 (interactive)
1342 (let (buffer-read-only) 1334 (let ((inhibit-read-only t))
1343 (undo))) 1335 (undo)))
1344;; ------------------------------------------------------------------------- 1336;; -------------------------------------------------------------------------
1345;; Section: Arc Archives 1337;; Section: Arc Archives
@@ -1398,7 +1390,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1398 (error "File names in arc files are limited to 12 characters")) 1390 (error "File names in arc files are limited to 12 characters"))
1399 (let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0" 1391 (let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0"
1400 (length newname)))) 1392 (length newname))))
1401 buffer-read-only) 1393 (inhibit-read-only t))
1402 (save-restriction 1394 (save-restriction
1403 (save-excursion 1395 (save-excursion
1404 (widen) 1396 (widen)
@@ -1570,7 +1562,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1570 (oldfnlen (char-after (+ p 21))) 1562 (oldfnlen (char-after (+ p 21)))
1571 (newfnlen (length newname)) 1563 (newfnlen (length newname))
1572 (newhsize (+ oldhsize newfnlen (- oldfnlen))) 1564 (newhsize (+ oldhsize newfnlen (- oldfnlen)))
1573 buffer-read-only) 1565 (inhibit-read-only t))
1574 (if (> newhsize 255) 1566 (if (> newhsize 255)
1575 (error "The file name is too long")) 1567 (error "The file name is too long"))
1576 (goto-char (+ p 21)) 1568 (goto-char (+ p 21))
@@ -1585,14 +1577,13 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1585 (save-excursion 1577 (save-excursion
1586 (widen) 1578 (widen)
1587 (set-buffer-multibyte nil) 1579 (set-buffer-multibyte nil)
1588 (while files 1580 (dolist (fil files)
1589 (let* ((fil (car files)) 1581 (let* ((p (+ archive-proper-file-start (aref fil 4)))
1590 (p (+ archive-proper-file-start (aref fil 4)))
1591 (hsize (char-after p)) 1582 (hsize (char-after p))
1592 (fnlen (char-after (+ p 21))) 1583 (fnlen (char-after (+ p 21)))
1593 (p2 (+ p 22 fnlen)) 1584 (p2 (+ p 22 fnlen))
1594 (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0)) 1585 (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
1595 buffer-read-only) 1586 (inhibit-read-only t))
1596 (if (= creator ?U) 1587 (if (= creator ?U)
1597 (progn 1588 (progn
1598 (or (numberp newval) 1589 (or (numberp newval)
@@ -1604,8 +1595,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1604 (delete-char 1) 1595 (delete-char 1)
1605 (insert (archive-lzh-resum (1+ p) hsize))) 1596 (insert (archive-lzh-resum (1+ p) hsize)))
1606 (message "Member %s does not have %s field" 1597 (message "Member %s does not have %s field"
1607 (aref fil 1) errtxt))) 1598 (aref fil 1) errtxt)))))))
1608 (setq files (cdr files))))))
1609 1599
1610(defun archive-lzh-chown-entry (newuid files) 1600(defun archive-lzh-chown-entry (newuid files)
1611 (archive-lzh-ogm newuid files "an uid" 10)) 1601 (archive-lzh-ogm newuid files "an uid" 10))
@@ -1709,13 +1699,12 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1709 (save-excursion 1699 (save-excursion
1710 (widen) 1700 (widen)
1711 (set-buffer-multibyte nil) 1701 (set-buffer-multibyte nil)
1712 (while files 1702 (dolist (fil files)
1713 (let* ((fil (car files)) 1703 (let* ((p (+ archive-proper-file-start (car (aref fil 4))))
1714 (p (+ archive-proper-file-start (car (aref fil 4))))
1715 (creator (char-after (+ p 5))) 1704 (creator (char-after (+ p 5)))
1716 (oldmode (aref fil 3)) 1705 (oldmode (aref fil 3))
1717 (newval (archive-calc-mode oldmode newmode t)) 1706 (newval (archive-calc-mode oldmode newmode t))
1718 buffer-read-only) 1707 (inhibit-read-only t))
1719 (cond ((memq creator '(2 3)) ; Unix + VMS 1708 (cond ((memq creator '(2 3)) ; Unix + VMS
1720 (goto-char (+ p 40)) 1709 (goto-char (+ p 40))
1721 (delete-char 2) 1710 (delete-char 2)
@@ -1726,7 +1715,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1726 (logand (logxor 1 (lsh newval -7)) 1))) 1715 (logand (logxor 1 (lsh newval -7)) 1)))
1727 (delete-char 1)) 1716 (delete-char 1))
1728 (t (message "Don't know how to change mode for this member")))) 1717 (t (message "Don't know how to change mode for this member"))))
1729 (setq files (cdr files)))))) 1718 ))))
1730;; ------------------------------------------------------------------------- 1719;; -------------------------------------------------------------------------
1731;; Section: Zoo Archives 1720;; Section: Zoo Archives
1732 1721