/[emacs]/emacs/lisp/arc-mode.el
ViewVC logotype

Diff of /emacs/lisp/arc-mode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.61 by lute, Thu May 26 12:11:10 2005 UTC revision 1.62 by monnier, Thu Jun 30 21:52:17 2005 UTC
# Line 218  Archive and member name will be added." Line 218  Archive and member name will be added."
218  ;; Zip archive configuration  ;; Zip archive configuration
219    
220  (defcustom archive-zip-extract  (defcustom archive-zip-extract
221    (if (locate-file "unzip" nil 'file-executable-p)    (if (and (not (executable-find "unzip"))
222        '("unzip" "-qq" "-c")             (executable-find "pkunzip"))
223      (if (locate-file "pkunzip" nil 'file-executable-p)        '("pkunzip" "-e" "-o-")
224          '("pkunzip" "-e" "-o-")      '("unzip" "-qq" "-c"))
       '("unzip" "-qq" "-c")))  
225    "*Program and its options to run in order to extract a zip file member.    "*Program and its options to run in order to extract a zip file member.
226  Extraction should happen to standard output.  Archive and member name will  Extraction should happen to standard output.  Archive and member name will
227  be added.  If `archive-zip-use-pkzip' is non-nil then this program is  be added.  If `archive-zip-use-pkzip' is non-nil then this program is
# Line 239  expected to extract to a file junking th Line 238  expected to extract to a file junking th
238  ;; names.  ;; names.
239    
240  (defcustom archive-zip-expunge  (defcustom archive-zip-expunge
241    (if (locate-file "zip" nil 'file-executable-p)    (if (and (not (executable-find "zip"))
242        '("zip" "-d" "-q")             (executable-find "pkzip"))
243      (if (locate-file "pkzip" nil 'file-executable-p)        '("pkzip" "-d")
244           '("pkzip" "-d")      '("zip" "-d" "-q"))
       '("zip" "-d" "-q")))  
245    "*Program and its options to run in order to delete zip file members.    "*Program and its options to run in order to delete zip file members.
246  Archive and member names will be added."  Archive and member names will be added."
247    :type '(list (string :tag "Program")    :type '(list (string :tag "Program")
# Line 253  Archive and member names will be added." Line 251  Archive and member names will be added."
251    :group 'archive-zip)    :group 'archive-zip)
252    
253  (defcustom archive-zip-update  (defcustom archive-zip-update
254    (if (locate-file "zip" nil 'file-executable-p)    (if (and (not (executable-find "zip"))
255        '("zip" "-q")             (executable-find "pkzip"))
256      (if (locate-file "pkzip" nil 'file-executable-p)        '("pkzip" "-u" "-P")
257           '("pkzip" "-u" "-P")      '("zip" "-q"))
       '("zip" "-q")))  
258    "*Program and its options to run in order to update a zip file member.    "*Program and its options to run in order to update a zip file member.
259  Options should ensure that specified directory will be put into the zip  Options should ensure that specified directory will be put into the zip
260  file.  Archive and member name will be added."  file.  Archive and member name will be added."
# Line 268  file.  Archive and member name will be a Line 265  file.  Archive and member name will be a
265    :group 'archive-zip)    :group 'archive-zip)
266    
267  (defcustom archive-zip-update-case  (defcustom archive-zip-update-case
268    (if (locate-file "zip" nil 'file-executable-p)    (if (and (not (executable-find "zip"))
269        '("zip" "-q" "-k")             (executable-find "pkzip"))
270      (if (locate-file "pkzip" nil 'file-executable-p)        '("pkzip" "-u" "-P")
271           '("pkzip" "-u" "-P")      '("zip" "-q" "-k"))
       '("zip" "-q" "-k")))  
272    "*Program and its options to run in order to update a case fiddled zip member.    "*Program and its options to run in order to update a case fiddled zip member.
273  Options should ensure that specified directory will be put into the zip file.  Options should ensure that specified directory will be put into the zip file.
274  Archive and member name will be added."  Archive and member name will be added."
# Line 715  Optional argument SHUT-UP, if non-nil, m Line 711  Optional argument SHUT-UP, if non-nil, m
711  when parsing the archive."  when parsing the archive."
712    (widen)    (widen)
713    (set-buffer-multibyte nil)    (set-buffer-multibyte nil)
714    (let (buffer-read-only)    (let ((inhibit-read-only t))
715      (or shut-up      (or shut-up
716          (message "Parsing archive file..."))          (message "Parsing archive file..."))
717      (buffer-disable-undo (current-buffer))      (buffer-disable-undo (current-buffer))
# Line 733  when parsing the archive." Line 729  when parsing the archive."
729    "Recreate the contents listing of an archive."    "Recreate the contents listing of an archive."
730    (let ((modified (buffer-modified-p))    (let ((modified (buffer-modified-p))
731          (no (archive-get-lineno))          (no (archive-get-lineno))
732          buffer-read-only)          (inhibit-read-only t))
733      (widen)      (widen)
734      (delete-region (point-min) archive-proper-file-start)      (delete-region (point-min) archive-proper-file-start)
735      (archive-summarize t)      (archive-summarize t)
736      (set-buffer-modified-p modified)      (restore-buffer-modified-p modified)
737      (goto-char archive-file-list-start)      (goto-char archive-file-list-start)
738      (archive-next-line no)))      (archive-next-line no)))
739    
# Line 832  using `make-temp-file', and the generate Line 828  using `make-temp-file', and the generate
828              (modified (buffer-modified-p))              (modified (buffer-modified-p))
829              (coding-system-for-read 'no-conversion)              (coding-system-for-read 'no-conversion)
830              (lno (archive-get-lineno))              (lno (archive-get-lineno))
831              buffer-read-only)              (inhibit-read-only t))
832          (if unchanged nil          (if unchanged nil
833            (setq archive-files nil)            (setq archive-files nil)
834            (erase-buffer)            (erase-buffer)
# Line 932  using `make-temp-file', and the generate Line 928  using `make-temp-file', and the generate
928          (setq archive (archive-maybe-copy archive))          (setq archive (archive-maybe-copy archive))
929          (setq buffer (get-buffer-create bufname))          (setq buffer (get-buffer-create bufname))
930          (setq just-created t)          (setq just-created t)
931          (save-excursion          (with-current-buffer buffer
           (set-buffer buffer)  
932            (setq buffer-file-name            (setq buffer-file-name
933                  (expand-file-name (concat arcname ":" iname)))                  (expand-file-name (concat arcname ":" iname)))
934            (setq buffer-file-truename            (setq buffer-file-truename
# Line 1056  using `make-temp-file', and the generate Line 1051  using `make-temp-file', and the generate
1051            (read-buffer "Buffer containing archive: "            (read-buffer "Buffer containing archive: "
1052                         ;; Find first archive buffer and suggest that                         ;; Find first archive buffer and suggest that
1053                         (let ((bufs (buffer-list)))                         (let ((bufs (buffer-list)))
1054                           (while (and bufs (not (eq (save-excursion                           (while (and bufs
1055                                                       (set-buffer (car bufs))                                       (not (with-current-buffer (car bufs)
1056                                                       major-mode)                                              (derived-mode-p 'archive-mode))))
1057                                                     'archive-mode)))                             (setq bufs (cdr bufs)))
                            (setq bufs (cdr bufs)))  
1058                           (if bufs                           (if bufs
1059                               (car bufs)                               (car bufs)
1060                             (error "There are no archive buffers")))                             (error "There are no archive buffers")))
# Line 1069  using `make-temp-file', and the generate Line 1063  using `make-temp-file', and the generate
1063                        (if buffer-file-name                        (if buffer-file-name
1064                            (file-name-nondirectory buffer-file-name)                            (file-name-nondirectory buffer-file-name)
1065                          ""))))                          ""))))
1066    (save-excursion    (with-current-buffer arcbuf
     (set-buffer arcbuf)  
1067      (or (eq major-mode 'archive-mode)      (or (eq major-mode 'archive-mode)
1068          (error "Buffer is not an archive buffer"))          (error "Buffer is not an archive buffer"))
1069      (if archive-read-only      (if archive-read-only
# Line 1079  using `make-temp-file', and the generate Line 1072  using `make-temp-file', and the generate
1072        (error "An archive buffer cannot be added to itself"))        (error "An archive buffer cannot be added to itself"))
1073    (if (string= name "")    (if (string= name "")
1074        (error "Archive members may not be given empty names"))        (error "Archive members may not be given empty names"))
1075    (let ((func (save-excursion (set-buffer arcbuf)    (let ((func (with-current-buffer arcbuf
1076                                (archive-name "add-new-member")))                  (archive-name "add-new-member")))
1077          (membuf (current-buffer)))          (membuf (current-buffer)))
1078      (if (fboundp func)      (if (fboundp func)
1079          (save-excursion          (with-current-buffer arcbuf
           (set-buffer arcbuf)  
1080            (funcall func buffer-file-name membuf name))            (funcall func buffer-file-name membuf name))
1081        (error "Adding a new member is not supported for this archive type"))))        (error "Adding a new member is not supported for this archive type"))))
1082  ;; -------------------------------------------------------------------------  ;; -------------------------------------------------------------------------
# Line 1095  using `make-temp-file', and the generate Line 1087  using `make-temp-file', and the generate
1087      (save-restriction      (save-restriction
1088        (message "Updating archive...")        (message "Updating archive...")
1089        (widen)        (widen)
1090        (let ((writer  (save-excursion (set-buffer archive-superior-buffer)        (let ((writer  (with-current-buffer archive-superior-buffer
1091                                       (archive-name "write-file-member")))                         (archive-name "write-file-member")))
1092              (archive (save-excursion (set-buffer archive-superior-buffer)              (archive (with-current-buffer archive-superior-buffer
1093                                       (archive-maybe-copy (buffer-file-name)))))                         (archive-maybe-copy (buffer-file-name)))))
1094          (if (fboundp writer)          (if (fboundp writer)
1095              (funcall writer archive archive-subfile-mode)              (funcall writer archive archive-subfile-mode)
1096            (archive-*-write-file-member archive            (archive-*-write-file-member archive
# Line 1167  With a prefix argument, mark that many f Line 1159  With a prefix argument, mark that many f
1159    (beginning-of-line)    (beginning-of-line)
1160    (let ((sign (if (>= p 0) +1 -1))    (let ((sign (if (>= p 0) +1 -1))
1161          (modified (buffer-modified-p))          (modified (buffer-modified-p))
1162          buffer-read-only)          (inhibit-read-only t))
1163      (while (not (zerop p))      (while (not (zerop p))
1164        (if (archive-get-descr t)        (if (archive-get-descr t)
1165            (progn            (progn
# Line 1175  With a prefix argument, mark that many f Line 1167  With a prefix argument, mark that many f
1167              (insert type)))              (insert type)))
1168        (forward-line sign)        (forward-line sign)
1169        (setq p (- p sign)))        (setq p (- p sign)))
1170      (set-buffer-modified-p modified))      (restore-buffer-modified-p modified))
1171    (archive-next-line 0))    (archive-next-line 0))
1172    
1173  (defun archive-unflag (p)  (defun archive-unflag (p)
# Line 1194  With a prefix argument, un-mark that man Line 1186  With a prefix argument, un-mark that man
1186    "Remove all marks."    "Remove all marks."
1187    (interactive)    (interactive)
1188    (let ((modified (buffer-modified-p))    (let ((modified (buffer-modified-p))
1189          buffer-read-only)          (inhibit-read-only t))
1190      (save-excursion      (save-excursion
1191        (goto-char archive-file-list-start)        (goto-char archive-file-list-start)
1192        (while (< (point) archive-file-list-end)        (while (< (point) archive-file-list-end)
1193          (or (= (following-char) ? )          (or (= (following-char) ? )
1194              (progn (delete-char 1) (insert ? )))              (progn (delete-char 1) (insert ? )))
1195          (forward-line 1)))          (forward-line 1)))
1196      (set-buffer-modified-p modified)))      (restore-buffer-modified-p modified)))
1197    
1198  (defun archive-mark (p)  (defun archive-mark (p)
1199    "In archive mode, mark this member for group operations.    "In archive mode, mark this member for group operations.
# Line 1339  as a relative change like \"g+rw\" as fo Line 1331  as a relative change like \"g+rw\" as fo
1331    "Undo in an archive buffer.    "Undo in an archive buffer.
1332  This doesn't recover lost files, it just undoes changes in the buffer itself."  This doesn't recover lost files, it just undoes changes in the buffer itself."
1333    (interactive)    (interactive)
1334    (let (buffer-read-only)    (let ((inhibit-read-only t))
1335      (undo)))      (undo)))
1336  ;; -------------------------------------------------------------------------  ;; -------------------------------------------------------------------------
1337  ;; Section: Arc Archives  ;; Section: Arc Archives
# Line 1398  This doesn't recover lost files, it just Line 1390  This doesn't recover lost files, it just
1390        (error "File names in arc files are limited to 12 characters"))        (error "File names in arc files are limited to 12 characters"))
1391    (let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0"    (let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0"
1392                                           (length newname))))                                           (length newname))))
1393          buffer-read-only)          (inhibit-read-only t))
1394      (save-restriction      (save-restriction
1395        (save-excursion        (save-excursion
1396          (widen)          (widen)
# Line 1570  This doesn't recover lost files, it just Line 1562  This doesn't recover lost files, it just
1562               (oldfnlen (char-after (+ p 21)))               (oldfnlen (char-after (+ p 21)))
1563               (newfnlen (length newname))               (newfnlen (length newname))
1564               (newhsize (+ oldhsize newfnlen (- oldfnlen)))               (newhsize (+ oldhsize newfnlen (- oldfnlen)))
1565               buffer-read-only)               (inhibit-read-only t))
1566          (if (> newhsize 255)          (if (> newhsize 255)
1567              (error "The file name is too long"))              (error "The file name is too long"))
1568          (goto-char (+ p 21))          (goto-char (+ p 21))
# Line 1585  This doesn't recover lost files, it just Line 1577  This doesn't recover lost files, it just
1577      (save-excursion      (save-excursion
1578        (widen)        (widen)
1579        (set-buffer-multibyte nil)        (set-buffer-multibyte nil)
1580        (while files        (dolist (fil files)
1581          (let* ((fil (car files))          (let* ((p (+ archive-proper-file-start (aref fil 4)))
                (p (+ archive-proper-file-start (aref fil 4)))  
1582                 (hsize   (char-after p))                 (hsize   (char-after p))
1583                 (fnlen   (char-after (+ p 21)))                 (fnlen   (char-after (+ p 21)))
1584                 (p2      (+ p 22 fnlen))                 (p2      (+ p 22 fnlen))
1585                 (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))                 (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
1586                 buffer-read-only)                 (inhibit-read-only t))
1587            (if (= creator ?U)            (if (= creator ?U)
1588                (progn                (progn
1589                  (or (numberp newval)                  (or (numberp newval)
# Line 1604  This doesn't recover lost files, it just Line 1595  This doesn't recover lost files, it just
1595                  (delete-char 1)                  (delete-char 1)
1596                  (insert (archive-lzh-resum (1+ p) hsize)))                  (insert (archive-lzh-resum (1+ p) hsize)))
1597              (message "Member %s does not have %s field"              (message "Member %s does not have %s field"
1598                       (aref fil 1) errtxt)))                       (aref fil 1) errtxt)))))))
         (setq files (cdr files))))))  
1599    
1600  (defun archive-lzh-chown-entry (newuid files)  (defun archive-lzh-chown-entry (newuid files)
1601    (archive-lzh-ogm newuid files "an uid" 10))    (archive-lzh-ogm newuid files "an uid" 10))
# Line 1709  This doesn't recover lost files, it just Line 1699  This doesn't recover lost files, it just
1699      (save-excursion      (save-excursion
1700        (widen)        (widen)
1701        (set-buffer-multibyte nil)        (set-buffer-multibyte nil)
1702        (while files        (dolist (fil files)
1703          (let* ((fil (car files))          (let* ((p (+ archive-proper-file-start (car (aref fil 4))))
                (p (+ archive-proper-file-start (car (aref fil 4))))  
1704                 (creator (char-after (+ p 5)))                 (creator (char-after (+ p 5)))
1705                 (oldmode (aref fil 3))                 (oldmode (aref fil 3))
1706                 (newval  (archive-calc-mode oldmode newmode t))                 (newval  (archive-calc-mode oldmode newmode t))
1707                 buffer-read-only)                 (inhibit-read-only t))
1708            (cond ((memq creator '(2 3)) ; Unix + VMS            (cond ((memq creator '(2 3)) ; Unix + VMS
1709                   (goto-char (+ p 40))                   (goto-char (+ p 40))
1710                   (delete-char 2)                   (delete-char 2)
# Line 1726  This doesn't recover lost files, it just Line 1715  This doesn't recover lost files, it just
1715                                   (logand (logxor 1 (lsh newval -7)) 1)))                                   (logand (logxor 1 (lsh newval -7)) 1)))
1716                   (delete-char 1))                   (delete-char 1))
1717                  (t (message "Don't know how to change mode for this member"))))                  (t (message "Don't know how to change mode for this member"))))
1718          (setq files (cdr files))))))          ))))
1719  ;; -------------------------------------------------------------------------  ;; -------------------------------------------------------------------------
1720  ;; Section: Zoo Archives  ;; Section: Zoo Archives
1721    

Legend:
Removed from v.1.61  
changed lines
  Added in v.1.62

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26