diff options
| author | Stefan Monnier | 2005-06-30 21:52:17 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2005-06-30 21:52:17 +0000 |
| commit | e545bb99ddf5b40a7a818f0f0ce4d61c3f69f618 (patch) | |
| tree | b5d95c913b56ee3883c8fbd33147ed51c611f7ac | |
| parent | 0a0157ba2ca8e3fade0f7f225cdfd125573e59d6 (diff) | |
| download | emacs-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.el | 107 |
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. |
| 227 | Extraction should happen to standard output. Archive and member name will | 226 | Extraction should happen to standard output. Archive and member name will |
| 228 | be added. If `archive-zip-use-pkzip' is non-nil then this program is | 227 | be 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. |
| 248 | Archive and member names will be added." | 246 | Archive 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. |
| 262 | Options should ensure that specified directory will be put into the zip | 259 | Options should ensure that specified directory will be put into the zip |
| 263 | file. Archive and member name will be added." | 260 | file. 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. |
| 277 | Options should ensure that specified directory will be put into the zip file. | 273 | Options should ensure that specified directory will be put into the zip file. |
| 278 | Archive and member name will be added." | 274 | Archive and member name will be added." |
| @@ -715,7 +711,7 @@ Optional argument SHUT-UP, if non-nil, means don't print messages | |||
| 715 | when parsing the archive." | 711 | when 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. |
| 1340 | This doesn't recover lost files, it just undoes changes in the buffer itself." | 1332 | This 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 | ||