aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndrea Corallo2020-04-05 22:08:17 +0100
committerAndrea Corallo2020-04-05 22:08:17 +0100
commit3608623eba9870aff8b5eb842fb8ae10f092c6bb (patch)
treebdf007ee88dc518ee3ec62e746a2534258d4d5a4
parent4263f2fd15e8439b8e8676ebeb6ab2f7f9339025 (diff)
parent95a7c6ec58c8c8c905f3e11be49419750737ec97 (diff)
downloademacs-3608623eba9870aff8b5eb842fb8ae10f092c6bb.tar.gz
emacs-3608623eba9870aff8b5eb842fb8ae10f092c6bb.zip
Merge remote-tracking branch 'savannah/master' into HEAD
Diffstat
-rw-r--r--etc/NEWS6
-rw-r--r--lib-src/Makefile.in2
-rw-r--r--lisp/arc-mode.el973
-rw-r--r--lisp/faces.el2
-rw-r--r--lisp/progmodes/cc-engine.el13
-rw-r--r--lisp/progmodes/gdb-mi.el11
-rw-r--r--src/Makefile.in7
-rw-r--r--src/character.c39
-rw-r--r--src/lisp.h22
9 files changed, 521 insertions, 554 deletions
diff --git a/etc/NEWS b/etc/NEWS
index fa333640548..81a70e9a974 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -101,6 +101,12 @@ horizontal movements now stop at the edge of the board.
101 101
102* Changes in Specialized Modes and Packages in Emacs 28.1 102* Changes in Specialized Modes and Packages in Emacs 28.1
103 103
104** archive-mode
105*** Can now modify members of 'ar' archives.
106*** Display of summaries unified between backends
107*** New var 'archive-hidden-columns' and cmd 'archive-hideshow-column'
108These let you control which columns are displayed and which are kept hidden
109
104** Emacs-Lisp mode 110** Emacs-Lisp mode
105 111
106*** The mode-line now indicates whether we're using lexical or dynamic scoping. 112*** The mode-line now indicates whether we're using lexical or dynamic scoping.
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index 29b34d9363b..a2d27eab001 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -231,8 +231,6 @@ BASE_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \
231 -I${srcdir} -I${srcdir}/../src -I${srcdir}/../lib 231 -I${srcdir} -I${srcdir}/../src -I${srcdir}/../lib
232 232
233ALL_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS} 233ALL_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS}
234## Unused.
235LINK_CFLAGS = ${BASE_CFLAGS} ${LDFLAGS} ${CFLAGS}
236CPP_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${CPPFLAGS} ${CFLAGS} 234CPP_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${CPPFLAGS} ${CFLAGS}
237 235
238# Configuration files for .o files to depend on. 236# Configuration files for .o files to depend on.
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 677483e49f2..4d366679690 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1,4 +1,4 @@
1;;; arc-mode.el --- simple editing of archives 1;;; arc-mode.el --- simple editing of archives -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1995, 1997-1998, 2001-2020 Free Software Foundation, 3;; Copyright (C) 1995, 1997-1998, 2001-2020 Free Software Foundation,
4;; Inc. 4;; Inc.
@@ -52,17 +52,17 @@
52;; ARCHIVE TYPES: Currently only the archives below are handled, but the 52;; ARCHIVE TYPES: Currently only the archives below are handled, but the
53;; structure for handling just about anything is in place. 53;; structure for handling just about anything is in place.
54;; 54;;
55;; Arc Lzh Zip Zoo Rar 7z 55;; Arc Lzh Zip Zoo Rar 7z Ar
56;; -------------------------------------------- 56;; --------------------------------------------------
57;; View listing Intern Intern Intern Intern Y Y 57;; View listing Intern Intern Intern Intern Y Y Y
58;; Extract member Y Y Y Y Y Y 58;; Extract member Y Y Y Y Y Y Y
59;; Save changed member Y Y Y Y N Y 59;; Save changed member Y Y Y Y N Y Y
60;; Add new member N N N N N N 60;; Add new member N N N N N N N
61;; Delete member Y Y Y Y N Y 61;; Delete member Y Y Y Y N Y N
62;; Rename member Y Y N N N N 62;; Rename member Y Y N N N N N
63;; Chmod - Y Y - N N 63;; Chmod - Y Y - N N N
64;; Chown - Y - - N N 64;; Chown - Y - - N N N
65;; Chgrp - Y - - N N 65;; Chgrp - Y - - N N N
66;; 66;;
67;; Special thanks to Bill Brodie <wbrodie@panix.com> for very useful tips 67;; Special thanks to Bill Brodie <wbrodie@panix.com> for very useful tips
68;; on the first released version of this package. 68;; on the first released version of this package.
@@ -101,6 +101,8 @@
101 101
102;;; Code: 102;;; Code:
103 103
104(eval-when-compile (require 'cl-lib))
105
104;; ------------------------------------------------------------------------- 106;; -------------------------------------------------------------------------
105;;; Section: Configuration. 107;;; Section: Configuration.
106 108
@@ -108,22 +110,6 @@
108 "Simple editing of archives." 110 "Simple editing of archives."
109 :group 'data) 111 :group 'data)
110 112
111(defgroup archive-arc nil
112 "ARC-specific options to archive."
113 :group 'archive)
114
115(defgroup archive-lzh nil
116 "LZH-specific options to archive."
117 :group 'archive)
118
119(defgroup archive-zip nil
120 "ZIP-specific options to archive."
121 :group 'archive)
122
123(defgroup archive-zoo nil
124 "ZOO-specific options to archive."
125 :group 'archive)
126
127(defcustom archive-tmpdir 113(defcustom archive-tmpdir
128 ;; make-temp-name is safe here because we use this name 114 ;; make-temp-name is safe here because we use this name
129 ;; to create a directory. 115 ;; to create a directory.
@@ -131,35 +117,48 @@
131 (expand-file-name (if (eq system-type 'ms-dos) "ar" "archive.tmp") 117 (expand-file-name (if (eq system-type 'ms-dos) "ar" "archive.tmp")
132 temporary-file-directory)) 118 temporary-file-directory))
133 "Directory for temporary files made by `arc-mode.el'." 119 "Directory for temporary files made by `arc-mode.el'."
134 :type 'directory 120 :type 'directory)
135 :group 'archive)
136 121
137(defcustom archive-remote-regexp "^/[^/:]*[^/:.]:" 122(defcustom archive-remote-regexp "^/[^/:]*[^/:.]:"
138 "Regexp recognizing archive files names that are not local. 123 "Regexp recognizing archive files names that are not local.
139A non-local file is one whose file name is not proper outside Emacs. 124A non-local file is one whose file name is not proper outside Emacs.
140A local copy of the archive will be used when updating." 125A local copy of the archive will be used when updating."
141 :type 'regexp 126 :type 'regexp)
142 :group 'archive)
143 127
144(define-obsolete-variable-alias 'archive-extract-hooks 128(define-obsolete-variable-alias 'archive-extract-hooks
145 'archive-extract-hook "24.3") 129 'archive-extract-hook "24.3")
146(defcustom archive-extract-hook nil 130(defcustom archive-extract-hook nil
147 "Hook run when an archive member has been extracted." 131 "Hook run when an archive member has been extracted."
148 :type 'hook 132 :type 'hook)
149 :group 'archive)
150 133
151(defcustom archive-visit-single-files nil 134(defcustom archive-visit-single-files nil
152 "If non-nil, opening an archive with a single file visits that file. 135 "If non-nil, opening an archive with a single file visits that file.
153If nil, visiting such an archive displays the archive summary." 136If nil, visiting such an archive displays the archive summary."
154 :version "25.1" 137 :version "25.1"
155 :type '(choice (const :tag "Visit the single file" t) 138 :type '(choice (const :tag "Visit the single file" t)
156 (const :tag "Show the archive summary" nil)) 139 (const :tag "Show the archive summary" nil)))
157 :group 'archive) 140
141(defcustom archive-hidden-columns '(Ids)
142 "Columns hidden from display."
143 :version "28.1"
144 :type '(set (const Mode)
145 (const Ids)
146 (const Date&Time)
147 (const Ratio)))
148
149(defconst archive-alternate-hidden-columns '(Mode Date&Time)
150 "Columns hidden when `archive-alternate-display' is used.")
151
158;; ------------------------------ 152;; ------------------------------
159;; Arc archive configuration 153;; Arc archive configuration
160 154
161;; We always go via a local file since there seems to be no reliable way 155;; We always go via a local file since there seems to be no reliable way
162;; to extract to stdout without junk getting added. 156;; to extract to stdout without junk getting added.
157
158(defgroup archive-arc nil
159 "ARC-specific options to archive."
160 :group 'archive)
161
163(defcustom archive-arc-extract 162(defcustom archive-arc-extract
164 '("arc" "x") 163 '("arc" "x")
165 "Program and its options to run in order to extract an arc file member. 164 "Program and its options to run in order to extract an arc file member.
@@ -168,8 +167,7 @@ name will be added."
168 :type '(list (string :tag "Program") 167 :type '(list (string :tag "Program")
169 (repeat :tag "Options" 168 (repeat :tag "Options"
170 :inline t 169 :inline t
171 (string :format "%v"))) 170 (string :format "%v"))))
172 :group 'archive-arc)
173 171
174(defcustom archive-arc-expunge 172(defcustom archive-arc-expunge
175 '("arc" "d") 173 '("arc" "d")
@@ -178,8 +176,7 @@ Archive and member names will be added."
178 :type '(list (string :tag "Program") 176 :type '(list (string :tag "Program")
179 (repeat :tag "Options" 177 (repeat :tag "Options"
180 :inline t 178 :inline t
181 (string :format "%v"))) 179 (string :format "%v"))))
182 :group 'archive-arc)
183 180
184(defcustom archive-arc-write-file-member 181(defcustom archive-arc-write-file-member
185 '("arc" "u") 182 '("arc" "u")
@@ -188,11 +185,14 @@ Archive and member name will be added."
188 :type '(list (string :tag "Program") 185 :type '(list (string :tag "Program")
189 (repeat :tag "Options" 186 (repeat :tag "Options"
190 :inline t 187 :inline t
191 (string :format "%v"))) 188 (string :format "%v"))))
192 :group 'archive-arc)
193;; ------------------------------ 189;; ------------------------------
194;; Lzh archive configuration 190;; Lzh archive configuration
195 191
192(defgroup archive-lzh nil
193 "LZH-specific options to archive."
194 :group 'archive)
195
196(defcustom archive-lzh-extract 196(defcustom archive-lzh-extract
197 '("lha" "pq") 197 '("lha" "pq")
198 "Program and its options to run in order to extract an lzh file member. 198 "Program and its options to run in order to extract an lzh file member.
@@ -201,8 +201,7 @@ be added."
201 :type '(list (string :tag "Program") 201 :type '(list (string :tag "Program")
202 (repeat :tag "Options" 202 (repeat :tag "Options"
203 :inline t 203 :inline t
204 (string :format "%v"))) 204 (string :format "%v"))))
205 :group 'archive-lzh)
206 205
207(defcustom archive-lzh-expunge 206(defcustom archive-lzh-expunge
208 '("lha" "d") 207 '("lha" "d")
@@ -211,8 +210,7 @@ Archive and member names will be added."
211 :type '(list (string :tag "Program") 210 :type '(list (string :tag "Program")
212 (repeat :tag "Options" 211 (repeat :tag "Options"
213 :inline t 212 :inline t
214 (string :format "%v"))) 213 (string :format "%v"))))
215 :group 'archive-lzh)
216 214
217(defcustom archive-lzh-write-file-member 215(defcustom archive-lzh-write-file-member
218 '("lha" "a") 216 '("lha" "a")
@@ -221,8 +219,7 @@ Archive and member name will be added."
221 :type '(list (string :tag "Program") 219 :type '(list (string :tag "Program")
222 (repeat :tag "Options" 220 (repeat :tag "Options"
223 :inline t 221 :inline t
224 (string :format "%v"))) 222 (string :format "%v"))))
225 :group 'archive-lzh)
226;; ------------------------------ 223;; ------------------------------
227;; Zip archive configuration 224;; Zip archive configuration
228 225
@@ -231,6 +228,10 @@ Archive and member name will be added."
231 (when 7z 228 (when 7z
232 (file-name-nondirectory 7z)))) 229 (file-name-nondirectory 7z))))
233 230
231(defgroup archive-zip nil
232 "ZIP-specific options to archive."
233 :group 'archive)
234
234(defcustom archive-zip-extract 235(defcustom archive-zip-extract
235 (cond ((executable-find "unzip") '("unzip" "-qq" "-c")) 236 (cond ((executable-find "unzip") '("unzip" "-qq" "-c"))
236 (archive-7z-program `(,archive-7z-program "x" "-so")) 237 (archive-7z-program `(,archive-7z-program "x" "-so"))
@@ -242,8 +243,7 @@ be added."
242 :type '(list (string :tag "Program") 243 :type '(list (string :tag "Program")
243 (repeat :tag "Options" 244 (repeat :tag "Options"
244 :inline t 245 :inline t
245 (string :format "%v"))) 246 (string :format "%v"))))
246 :group 'archive-zip)
247 247
248;; For several reasons the latter behavior is not desirable in general. 248;; For several reasons the latter behavior is not desirable in general.
249;; (1) It uses more disk space. (2) Error checking is worse or non- 249;; (1) It uses more disk space. (2) Error checking is worse or non-
@@ -260,8 +260,7 @@ Archive and member names will be added."
260 :type '(list (string :tag "Program") 260 :type '(list (string :tag "Program")
261 (repeat :tag "Options" 261 (repeat :tag "Options"
262 :inline t 262 :inline t
263 (string :format "%v"))) 263 (string :format "%v"))))
264 :group 'archive-zip)
265 264
266(defcustom archive-zip-update 265(defcustom archive-zip-update
267 (cond ((executable-find "zip") '("zip" "-q")) 266 (cond ((executable-find "zip") '("zip" "-q"))
@@ -274,8 +273,7 @@ file. Archive and member name will be added."
274 :type '(list (string :tag "Program") 273 :type '(list (string :tag "Program")
275 (repeat :tag "Options" 274 (repeat :tag "Options"
276 :inline t 275 :inline t
277 (string :format "%v"))) 276 (string :format "%v"))))
278 :group 'archive-zip)
279 277
280(defcustom archive-zip-update-case 278(defcustom archive-zip-update-case
281 (cond ((executable-find "zip") '("zip" "-q" "-k")) 279 (cond ((executable-find "zip") '("zip" "-q" "-k"))
@@ -288,8 +286,7 @@ Archive and member name will be added."
288 :type '(list (string :tag "Program") 286 :type '(list (string :tag "Program")
289 (repeat :tag "Options" 287 (repeat :tag "Options"
290 :inline t 288 :inline t
291 (string :format "%v"))) 289 (string :format "%v"))))
292 :group 'archive-zip)
293 290
294(declare-function msdos-long-file-names "msdos.c") 291(declare-function msdos-long-file-names "msdos.c")
295(defcustom archive-zip-case-fiddle (and (eq system-type 'ms-dos) 292(defcustom archive-zip-case-fiddle (and (eq system-type 'ms-dos)
@@ -300,11 +297,14 @@ that uses caseless file names.
300In addition, this flag forces members added/updated in the zip archive 297In addition, this flag forces members added/updated in the zip archive
301to be truncated to DOS 8+3 file-name restrictions." 298to be truncated to DOS 8+3 file-name restrictions."
302 :type 'boolean 299 :type 'boolean
303 :version "27.1" 300 :version "27.1")
304 :group 'archive-zip)
305;; ------------------------------ 301;; ------------------------------
306;; Zoo archive configuration 302;; Zoo archive configuration
307 303
304(defgroup archive-zoo nil
305 "ZOO-specific options to archive."
306 :group 'archive)
307
308(defcustom archive-zoo-extract 308(defcustom archive-zoo-extract
309 '("zoo" "xpq") 309 '("zoo" "xpq")
310 "Program and its options to run in order to extract a zoo file member. 310 "Program and its options to run in order to extract a zoo file member.
@@ -313,8 +313,7 @@ be added."
313 :type '(list (string :tag "Program") 313 :type '(list (string :tag "Program")
314 (repeat :tag "Options" 314 (repeat :tag "Options"
315 :inline t 315 :inline t
316 (string :format "%v"))) 316 (string :format "%v"))))
317 :group 'archive-zoo)
318 317
319(defcustom archive-zoo-expunge 318(defcustom archive-zoo-expunge
320 '("zoo" "DqPP") 319 '("zoo" "DqPP")
@@ -323,8 +322,7 @@ Archive and member names will be added."
323 :type '(list (string :tag "Program") 322 :type '(list (string :tag "Program")
324 (repeat :tag "Options" 323 (repeat :tag "Options"
325 :inline t 324 :inline t
326 (string :format "%v"))) 325 (string :format "%v"))))
327 :group 'archive-zoo)
328 326
329(defcustom archive-zoo-write-file-member 327(defcustom archive-zoo-write-file-member
330 '("zoo" "a") 328 '("zoo" "a")
@@ -333,11 +331,14 @@ Archive and member name will be added."
333 :type '(list (string :tag "Program") 331 :type '(list (string :tag "Program")
334 (repeat :tag "Options" 332 (repeat :tag "Options"
335 :inline t 333 :inline t
336 (string :format "%v"))) 334 (string :format "%v"))))
337 :group 'archive-zoo)
338;; ------------------------------ 335;; ------------------------------
339;; 7z archive configuration 336;; 7z archive configuration
340 337
338(defgroup archive-7z nil
339 "7Z-specific options to archive."
340 :group 'archive)
341
341(defcustom archive-7z-extract 342(defcustom archive-7z-extract
342 `(,(or archive-7z-program "7z") "x" "-so") 343 `(,(or archive-7z-program "7z") "x" "-so")
343 "Program and its options to run in order to extract a 7z file member. 344 "Program and its options to run in order to extract a 7z file member.
@@ -347,8 +348,7 @@ be added."
347 :type '(list (string :tag "Program") 348 :type '(list (string :tag "Program")
348 (repeat :tag "Options" 349 (repeat :tag "Options"
349 :inline t 350 :inline t
350 (string :format "%v"))) 351 (string :format "%v"))))
351 :group 'archive-7z)
352 352
353(defcustom archive-7z-expunge 353(defcustom archive-7z-expunge
354 `(,(or archive-7z-program "7z") "d") 354 `(,(or archive-7z-program "7z") "d")
@@ -358,8 +358,7 @@ Archive and member names will be added."
358 :type '(list (string :tag "Program") 358 :type '(list (string :tag "Program")
359 (repeat :tag "Options" 359 (repeat :tag "Options"
360 :inline t 360 :inline t
361 (string :format "%v"))) 361 (string :format "%v"))))
362 :group 'archive-7z)
363 362
364(defcustom archive-7z-update 363(defcustom archive-7z-update
365 `(,(or archive-7z-program "7z") "u") 364 `(,(or archive-7z-program "7z") "u")
@@ -370,18 +369,17 @@ file. Archive and member name will be added."
370 :type '(list (string :tag "Program") 369 :type '(list (string :tag "Program")
371 (repeat :tag "Options" 370 (repeat :tag "Options"
372 :inline t 371 :inline t
373 (string :format "%v"))) 372 (string :format "%v"))))
374 :group 'archive-7z)
375 373
376;; ------------------------------------------------------------------------- 374;; -------------------------------------------------------------------------
377;;; Section: Variables 375;;; Section: Variables
378 376
379(defvar archive-subtype nil "Symbol describing archive type.") 377(defvar archive-subtype nil "Symbol describing archive type.")
380(defvar archive-file-list-start nil "Position of first contents line.") 378(defvar-local archive-file-list-start nil "Position of first contents line.")
381(defvar archive-file-list-end nil "Position just after last contents line.") 379(defvar-local archive-file-list-end nil "Position just after last contents line.")
382(defvar archive-proper-file-start nil "Position of real archive's start.") 380(defvar-local archive-proper-file-start nil "Position of real archive's start.")
383(defvar archive-read-only nil "Non-nil if the archive is read-only on disk.") 381(defvar archive-read-only nil "Non-nil if the archive is read-only on disk.")
384(defvar archive-local-name nil "Name of local copy of remote archive.") 382(defvar-local archive-local-name nil "Name of local copy of remote archive.")
385(defvar archive-mode-map 383(defvar archive-mode-map
386 (let ((map (make-keymap))) 384 (let ((map (make-keymap)))
387 (set-keymap-parent map special-mode-map) 385 (set-keymap-parent map special-mode-map)
@@ -428,7 +426,6 @@ file. Archive and member name will be added."
428 (cons "Immediate" (make-sparse-keymap "Immediate"))) 426 (cons "Immediate" (make-sparse-keymap "Immediate")))
429 (define-key map [menu-bar immediate alternate] 427 (define-key map [menu-bar immediate alternate]
430 '(menu-item "Alternate Display" archive-alternate-display 428 '(menu-item "Alternate Display" archive-alternate-display
431 :enable (boundp (archive-name "alternate-display"))
432 :help "Toggle alternate file info display")) 429 :help "Toggle alternate file info display"))
433 (define-key map [menu-bar immediate view] 430 (define-key map [menu-bar immediate view]
434 '(menu-item "View This File" archive-view 431 '(menu-item "View This File" archive-view
@@ -483,36 +480,58 @@ file. Archive and member name will be added."
483 :help "Delete all flagged files from archive")) 480 :help "Delete all flagged files from archive"))
484 map) 481 map)
485 "Local keymap for archive mode listings.") 482 "Local keymap for archive mode listings.")
486(defvar archive-file-name-indent nil "Column where file names start.") 483(defvar-local archive-file-name-indent nil "Column where file names start.")
487 484
488(defvar archive-remote nil "Non-nil if the archive is outside file system.") 485(defvar-local archive-remote nil "Non-nil if the archive is outside file system.")
489(make-variable-buffer-local 'archive-remote)
490(put 'archive-remote 'permanent-local t) 486(put 'archive-remote 'permanent-local t)
491 487
492(defvar archive-member-coding-system nil "Coding-system of archive member.") 488(defvar-local archive-member-coding-system nil "Coding-system of archive member.")
493(make-variable-buffer-local 'archive-member-coding-system)
494 489
495(defvar archive-alternate-display nil 490(defvar-local archive-alternate-display nil
496 "Non-nil when alternate information is shown.") 491 "Non-nil when alternate information is shown.")
497(make-variable-buffer-local 'archive-alternate-display)
498(put 'archive-alternate-display 'permanent-local t) 492(put 'archive-alternate-display 'permanent-local t)
499 493
500(defvar archive-superior-buffer nil "In archive members, points to archive.") 494(defvar archive-superior-buffer nil "In archive members, points to archive.")
501(put 'archive-superior-buffer 'permanent-local t) 495(put 'archive-superior-buffer 'permanent-local t)
502 496
503(defvar archive-subfile-mode nil "Non-nil in archive member buffers.") 497(defvar-local archive-subfile-mode nil
504(make-variable-buffer-local 'archive-subfile-mode) 498 "Non-nil in archive member buffers.
499Its value is an `archive--file-desc'.")
505(put 'archive-subfile-mode 'permanent-local t) 500(put 'archive-subfile-mode 'permanent-local t)
506 501
507(defvar archive-file-name-coding-system nil) 502(defvar-local archive-file-name-coding-system nil)
508(make-variable-buffer-local 'archive-file-name-coding-system)
509(put 'archive-file-name-coding-system 'permanent-local t) 503(put 'archive-file-name-coding-system 'permanent-local t)
510 504
511(defvar archive-files nil 505(cl-defstruct (archive--file-desc
512 "Vector of file descriptors. 506 (:constructor nil)
513Each descriptor is a vector of the form 507 (:constructor archive--file-desc
514 [EXT-FILE-NAME INT-FILE-NAME CASE-FIDDLED MODE ...]") 508 ;; ext-file-name and int-file-name are usually `eq'
515(make-variable-buffer-local 'archive-files) 509 ;; except when int-file-name is the downcased
510 ;; ext-file-name.
511 (ext-file-name int-file-name mode size time
512 &key pos ratio uid gid)))
513 ext-file-name int-file-name
514 (mode nil :type integer)
515 (size nil :type integer)
516 (time nil :type string)
517 (ratio nil :type string)
518 uid gid
519 pos)
520
521;; Features in formats:
522;;
523;; ARC: size, date&time (date and time strings internally generated)
524;; LZH: size, date&time, mode, uid, gid (mode, date, time generated, ugid:int)
525;; ZIP: size, date&time, mode (mode, date, time generated)
526;; ZOO: size, date&time (date and time strings internally generated)
527;; AR : size, date&time, mode, user, group (internally generated)
528;; RAR: size, date&time, ratio (all as strings, using `lsar')
529;; 7Z : size, date&time (all as strings, using `7z' or `7za')
530;;
531;; LZH has alternate display (with UID/GID i.s.o MODE/DATE/TIME
532
533(defvar-local archive-files nil
534 "Vector of `archive--file-desc' objects.")
516 535
517;; ------------------------------------------------------------------------- 536;; -------------------------------------------------------------------------
518;;; Section: Support functions. 537;;; Section: Support functions.
@@ -520,9 +539,9 @@ Each descriptor is a vector of the form
520(defun arc-insert-unibyte (&rest args) 539(defun arc-insert-unibyte (&rest args)
521 "Like insert but don't make unibyte string and eight-bit char multibyte." 540 "Like insert but don't make unibyte string and eight-bit char multibyte."
522 (dolist (elt args) 541 (dolist (elt args)
523 (if (integerp elt) 542 (insert (if (and (integerp elt) (>= elt 128))
524 (insert (if (< elt 128) elt (decode-char 'eight-bit elt))) 543 (decode-char 'eight-bit elt)
525 (insert elt)))) 544 elt))))
526 545
527(defsubst archive-name (suffix) 546(defsubst archive-name (suffix)
528 (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix))) 547 (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix)))
@@ -547,70 +566,36 @@ in which case a second argument, length LEN, should be supplied."
547(defun archive-int-to-mode (mode) 566(defun archive-int-to-mode (mode)
548 "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------." 567 "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------."
549 ;; FIXME: merge with tar-grind-file-mode. 568 ;; FIXME: merge with tar-grind-file-mode.
550 (string 569 (if (null mode)
551 (if (zerop (logand 8192 mode)) 570 "??????????"
552 (if (zerop (logand 16384 mode)) ?- ?d) 571 (string
553 ?c) ; completeness 572 (if (zerop (logand 8192 mode))
554 (if (zerop (logand 256 mode)) ?- ?r) 573 (if (zerop (logand 16384 mode)) ?- ?d)
555 (if (zerop (logand 128 mode)) ?- ?w) 574 ?c) ; completeness
556 (if (zerop (logand 64 mode)) 575 (if (zerop (logand 256 mode)) ?- ?r)
557 (if (zerop (logand 2048 mode)) ?- ?S) 576 (if (zerop (logand 128 mode)) ?- ?w)
558 (if (zerop (logand 2048 mode)) ?x ?s)) 577 (if (zerop (logand 64 mode))
559 (if (zerop (logand 32 mode)) ?- ?r) 578 (if (zerop (logand 2048 mode)) ?- ?S)
560 (if (zerop (logand 16 mode)) ?- ?w) 579 (if (zerop (logand 2048 mode)) ?x ?s))
561 (if (zerop (logand 8 mode)) 580 (if (zerop (logand 32 mode)) ?- ?r)
562 (if (zerop (logand 1024 mode)) ?- ?S) 581 (if (zerop (logand 16 mode)) ?- ?w)
563 (if (zerop (logand 1024 mode)) ?x ?s)) 582 (if (zerop (logand 8 mode))
564 (if (zerop (logand 4 mode)) ?- ?r) 583 (if (zerop (logand 1024 mode)) ?- ?S)
565 (if (zerop (logand 2 mode)) ?- ?w) 584 (if (zerop (logand 1024 mode)) ?x ?s))
566 (if (zerop (logand 1 mode)) ?- ?x))) 585 (if (zerop (logand 4 mode)) ?- ?r)
567 586 (if (zerop (logand 2 mode)) ?- ?w)
568(defun archive-calc-mode (oldmode newmode &optional error) 587 (if (zerop (logand 1 mode)) ?- ?x))))
588
589(defun archive-calc-mode (oldmode newmode)
569 "From the integer OLDMODE and the string NEWMODE calculate a new file mode. 590 "From the integer OLDMODE and the string NEWMODE calculate a new file mode.
570NEWMODE may be an octal number including a leading zero in which case it 591NEWMODE may be an octal number including a leading zero in which case it
571will become the new mode.\n 592will become the new mode.\n
572NEWMODE may also be a relative specification like \"og-rwx\" in which case 593NEWMODE may also be a relative specification like \"og-rwx\" in which case
573OLDMODE will be modified accordingly just like chmod(2) would have done.\n 594OLDMODE will be modified accordingly just like chmod(2) would have done."
574If optional third argument ERROR is non-nil an error will be signaled if 595 ;; FIXME: Use `file-modes-symbolic-to-number'!
575the mode is invalid. If ERROR is nil then nil will be returned." 596 (if (string-match "\\`0[0-7]*\\'" newmode)
576 (cond ((string-match "^0[0-7]*$" newmode) 597 (logior (logand oldmode #o177000) (string-to-number newmode 8))
577 (let ((result 0) 598 (file-modes-symbolic-to-number newmode oldmode)))
578 (len (length newmode))
579 (i 1))
580 (while (< i len)
581 (setq result (+ (ash result 3) (aref newmode i) (- ?0))
582 i (1+ i)))
583 (logior (logand oldmode 65024) result)))
584 ((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode)
585 (let ((who 0)
586 (result oldmode)
587 (op (aref newmode (match-beginning 2)))
588 (bits 0)
589 (i (match-beginning 3)))
590 (while (< i (match-end 3))
591 (let ((rwx (aref newmode i)))
592 (setq bits (logior bits (cond ((= rwx ?r) 292)
593 ((= rwx ?w) 146)
594 ((= rwx ?x) 73)
595 ((= rwx ?s) 3072)
596 ((= rwx ?t) 512)))
597 i (1+ i))))
598 (while (< who (match-end 1))
599 (let* ((whoc (aref newmode who))
600 (whomask (cond ((= whoc ?a) 4095)
601 ((= whoc ?u) 1472)
602 ((= whoc ?g) 2104)
603 ((= whoc ?o) 7))))
604 (if (= op ?=)
605 (setq result (logand result (lognot whomask))))
606 (if (= op ?-)
607 (setq result (logand result (lognot (logand whomask bits))))
608 (setq result (logior result (logand whomask bits)))))
609 (setq who (1+ who)))
610 result))
611 (t
612 (if error
613 (error "Invalid mode specification: %s" newmode)))))
614 599
615(defun archive-dosdate (date) 600(defun archive-dosdate (date)
616 "Stringify dos packed DATE record." 601 "Stringify dos packed DATE record."
@@ -622,7 +607,8 @@ the mode is invalid. If ERROR is nil then nil will be returned."
622 (format "%2d-%s-%d" 607 (format "%2d-%s-%d"
623 day 608 day
624 (aref ["Jan" "Feb" "Mar" "Apr" "May" "Jun" 609 (aref ["Jan" "Feb" "Mar" "Apr" "May" "Jun"
625 "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] (1- month)) 610 "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]
611 (1- month))
626 year)))) 612 year))))
627 613
628(defun archive-dostime (time) 614(defun archive-dostime (time)
@@ -658,10 +644,12 @@ Does not signal an error if optional argument NOERROR is non-nil."
658 (if (and (>= (point) archive-file-list-start) 644 (if (and (>= (point) archive-file-list-start)
659 (< no (length archive-files))) 645 (< no (length archive-files)))
660 (let ((item (aref archive-files no))) 646 (let ((item (aref archive-files no)))
661 (if (vectorp item) 647 (if (and (archive--file-desc-p item)
648 (let ((mode (archive--file-desc-mode item)))
649 (zerop (logand 16384 mode))))
662 item 650 item
663 (if (not noerror) 651 (if (not noerror)
664 (error "Entry is not a regular member of the archive")))) 652 (user-error "Entry is not a regular member of the archive"))))
665 (if (not noerror) 653 (if (not noerror)
666 (error "Line does not describe a member of the archive"))))) 654 (error "Line does not describe a member of the archive")))))
667;; ------------------------------------------------------------------------- 655;; -------------------------------------------------------------------------
@@ -684,41 +672,34 @@ archive.
684 ;; mode on and off. You can corrupt things that way. 672 ;; mode on and off. You can corrupt things that way.
685 (if (zerop (buffer-size)) 673 (if (zerop (buffer-size))
686 ;; At present we cannot create archives from scratch 674 ;; At present we cannot create archives from scratch
687 (funcall (or (default-value 'major-mode) 'fundamental-mode)) 675 (funcall (or (default-value 'major-mode) #'fundamental-mode))
688 (if (and (not force) archive-files) nil 676 (if (and (not force) archive-files) nil
689 (kill-all-local-variables) 677 (kill-all-local-variables)
690 (let* ((type (archive-find-type)) 678 (let* ((type (archive-find-type))
691 (typename (capitalize (symbol-name type)))) 679 (typename (capitalize (symbol-name type))))
692 (make-local-variable 'archive-subtype) 680 (setq-local archive-subtype type)
693 (setq archive-subtype type)
694 681
695 ;; Buffer contains treated image of file before the file contents 682 ;; Buffer contains treated image of file before the file contents
696 (make-local-variable 'revert-buffer-function) 683 (add-function :around (local 'revert-buffer-function)
697 (setq revert-buffer-function 'archive-mode-revert) 684 #'archive--mode-revert)
698 (auto-save-mode 0)
699 685
700 (add-hook 'write-contents-functions 'archive-write-file nil t) 686 (add-hook 'write-contents-functions #'archive-write-file nil t)
701 687
702 (make-local-variable 'require-final-newline) 688 (setq-local truncate-lines t)
703 (setq require-final-newline nil) 689 (setq-local require-final-newline nil)
704 (make-local-variable 'local-enable-local-variables) 690 (setq-local local-enable-local-variables nil)
705 (setq local-enable-local-variables nil)
706 691
707 ;; Prevent loss of data when saving the file. 692 ;; Prevent loss of data when saving the file.
708 (make-local-variable 'file-precious-flag) 693 (setq-local file-precious-flag t)
709 (setq file-precious-flag t)
710 694
711 (make-local-variable 'archive-read-only)
712 ;; Archives which are inside other archives and whose 695 ;; Archives which are inside other archives and whose
713 ;; names are invalid for this OS, can't be written. 696 ;; names are invalid for this OS, can't be written.
714 (setq archive-read-only 697 (setq-local archive-read-only
715 (or (not (file-writable-p (buffer-file-name))) 698 (or (not (file-writable-p (buffer-file-name)))
716 (and archive-subfile-mode 699 (and archive-subfile-mode
717 (string-match file-name-invalid-regexp 700 (string-match file-name-invalid-regexp
718 (aref archive-subfile-mode 0))))) 701 (archive--file-desc-ext-file-name
719 702 archive-subfile-mode)))))
720 ;; Should we use a local copy when accessing from outside Emacs?
721 (make-local-variable 'archive-local-name)
722 703
723 ;; An archive can contain another archive whose name is invalid 704 ;; An archive can contain another archive whose name is invalid
724 ;; on local filesystem. Treat such archives as remote. 705 ;; on local filesystem. Treat such archives as remote.
@@ -728,16 +709,12 @@ archive.
728 (string-match file-name-invalid-regexp 709 (string-match file-name-invalid-regexp
729 (buffer-file-name))))) 710 (buffer-file-name)))))
730 711
731 (setq major-mode 'archive-mode) 712 (setq major-mode #'archive-mode)
732 (setq mode-name (concat typename "-Archive")) 713 (setq mode-name (concat typename "-Archive"))
733 ;; Run archive-foo-mode-hook and archive-mode-hook 714 ;; Run archive-foo-mode-hook and archive-mode-hook
734 (run-mode-hooks (archive-name "mode-hook") 'archive-mode-hook) 715 (run-mode-hooks (archive-name "mode-hook") 'archive-mode-hook)
735 (use-local-map archive-mode-map)) 716 (use-local-map archive-mode-map))
736 717
737 (make-local-variable 'archive-proper-file-start)
738 (make-local-variable 'archive-file-list-start)
739 (make-local-variable 'archive-file-list-end)
740 (make-local-variable 'archive-file-name-indent)
741 (setq archive-file-name-coding-system 718 (setq archive-file-name-coding-system
742 (or file-name-coding-system 719 (or file-name-coding-system
743 default-file-name-coding-system 720 default-file-name-coding-system
@@ -803,7 +780,7 @@ when parsing the archive."
803 (let ((create-lockfiles nil) ; avoid changing dir mtime by lock_file 780 (let ((create-lockfiles nil) ; avoid changing dir mtime by lock_file
804 (inhibit-read-only t)) 781 (inhibit-read-only t))
805 (setq archive-proper-file-start (copy-marker (point-min) t)) 782 (setq archive-proper-file-start (copy-marker (point-min) t))
806 (set (make-local-variable 'change-major-mode-hook) 'archive-desummarize) 783 (add-hook 'change-major-mode-hook #'archive-desummarize nil t)
807 (or shut-up 784 (or shut-up
808 (message "Parsing archive file...")) 785 (message "Parsing archive file..."))
809 (buffer-disable-undo (current-buffer)) 786 (buffer-disable-undo (current-buffer))
@@ -825,27 +802,35 @@ when parsing the archive."
825 (goto-char archive-file-list-start) 802 (goto-char archive-file-list-start)
826 (archive-next-line no))) 803 (archive-next-line no)))
827 804
805(cl-defstruct (archive--file-summary
806 (:constructor nil)
807 (:constructor archive--file-summary (text name-start name-end)))
808 text name-start name-end)
809
828(defun archive-summarize-files (files) 810(defun archive-summarize-files (files)
829 "Insert a description of a list of files annotated with proper mouse face." 811 "Insert a description of a list of files annotated with proper mouse face."
830 (setq archive-file-list-start (point-marker)) 812 (setq archive-file-list-start (point-marker))
831 (setq archive-file-name-indent (if files (aref (car files) 1) 0)) 813 ;; Here we assume that they all start at the same column.
814 (setq archive-file-name-indent
815 ;; FIXME: We assume chars=columns (no double-wide chars and such).
816 (if files (archive--file-summary-name-start (car files)) 0))
832 ;; We don't want to do an insert for each element since that takes too 817 ;; We don't want to do an insert for each element since that takes too
833 ;; long when the archive -- which has to be moved in memory -- is large. 818 ;; long when the archive -- which has to be moved in memory -- is large.
834 (insert 819 (insert
835 (apply 820 (mapconcat
836 #'concat 821 (lambda (fil)
837 (mapcar 822 ;; Using `concat' here copies the text also, so we can add
838 (lambda (fil) 823 ;; properties without problems.
839 ;; Using `concat' here copies the text also, so we can add 824 (let ((text (concat (archive--file-summary-text fil) "\n")))
840 ;; properties without problems. 825 (add-text-properties
841 (let ((text (concat (aref fil 0) "\n"))) 826 (archive--file-summary-name-start fil)
842 (add-text-properties 827 (archive--file-summary-name-end fil)
843 (aref fil 1) (aref fil 2) 828 '(mouse-face highlight
844 '(mouse-face highlight 829 help-echo "mouse-2: extract this file into a buffer")
845 help-echo "mouse-2: extract this file into a buffer") 830 text)
846 text) 831 text))
847 text)) 832 files
848 files))) 833 ""))
849 (setq archive-file-list-end (point-marker))) 834 (setq archive-file-list-end (point-marker)))
850 835
851(defun archive-alternate-display () 836(defun archive-alternate-display ()
@@ -854,7 +839,27 @@ To avoid very long lines archive mode does not show all information.
854This function changes the set of information shown for each files." 839This function changes the set of information shown for each files."
855 (interactive) 840 (interactive)
856 (setq archive-alternate-display (not archive-alternate-display)) 841 (setq archive-alternate-display (not archive-alternate-display))
842 (setq-local archive-hidden-columns
843 (if archive-alternate-display
844 archive-alternate-hidden-columns
845 (eval (car (or (get 'archive-hidden-columns 'customized-value)
846 (get 'archive-hidden-columns 'standard-value)))
847 t)))
848 (archive-resummarize))
849
850(defun archive-hideshow-column (column)
851 "Toggle visibility of COLUMN."
852 (interactive
853 (list (intern
854 (completing-read "Toggle visibility of: "
855 '(Mode Ids Ratio Date&Time)
856 nil t))))
857 (setq-local archive-hidden-columns
858 (if (memq column archive-hidden-columns)
859 (remove column archive-hidden-columns)
860 (cons column archive-hidden-columns)))
857 (archive-resummarize)) 861 (archive-resummarize))
862
858;; ------------------------------------------------------------------------- 863;; -------------------------------------------------------------------------
859;;; Section: Local archive copy handling 864;;; Section: Local archive copy handling
860 865
@@ -899,7 +904,8 @@ using `make-temp-file', and the generated name is returned."
899 ;; "foo.zip:bar.zip", which is invalid on DOS/Windows. 904 ;; "foo.zip:bar.zip", which is invalid on DOS/Windows.
900 ;; So use the actual name if available. 905 ;; So use the actual name if available.
901 (archive-name 906 (archive-name
902 (or (and archive-subfile-mode (aref archive-subfile-mode 0)) 907 (or (and archive-subfile-mode (archive--file-desc-ext-file-name
908 archive-subfile-mode))
903 archive))) 909 archive)))
904 (setq archive-local-name 910 (setq archive-local-name
905 (archive-unique-fname archive-name archive-tmpdir)) 911 (archive-unique-fname archive-name archive-tmpdir))
@@ -918,6 +924,7 @@ using `make-temp-file', and the generated name is returned."
918 (lno (archive-get-lineno)) 924 (lno (archive-get-lineno))
919 (inhibit-read-only t)) 925 (inhibit-read-only t))
920 (if unchanged nil 926 (if unchanged nil
927 ;; FIXME: Use archive-resummarize?
921 (setq archive-files nil) 928 (setq archive-files nil)
922 (erase-buffer) 929 (erase-buffer)
923 (insert-file-contents name) 930 (insert-file-contents name)
@@ -968,7 +975,7 @@ using `make-temp-file', and the generated name is returned."
968 (delete-file tmpfile))))) 975 (delete-file tmpfile)))))
969 976
970(defun archive-file-name-handler (op &rest args) 977(defun archive-file-name-handler (op &rest args)
971 (or (eq op 'file-exists-p) 978 (or (eq op #'file-exists-p)
972 (let ((file-name-handler-alist nil)) 979 (let ((file-name-handler-alist nil))
973 (apply op args)))) 980 (apply op args))))
974 981
@@ -1008,8 +1015,8 @@ using `make-temp-file', and the generated name is returned."
1008 (if event (posn-set-point (event-end event))) 1015 (if event (posn-set-point (event-end event)))
1009 (let* ((view-p (eq other-window-p 'view)) 1016 (let* ((view-p (eq other-window-p 'view))
1010 (descr (archive-get-descr)) 1017 (descr (archive-get-descr))
1011 (ename (aref descr 0)) 1018 (ename (archive--file-desc-ext-file-name descr))
1012 (iname (aref descr 1)) 1019 (iname (archive--file-desc-int-file-name descr))
1013 (archive-buffer (current-buffer)) 1020 (archive-buffer (current-buffer))
1014 (arcdir default-directory) 1021 (arcdir default-directory)
1015 (archive (buffer-file-name)) 1022 (archive (buffer-file-name))
@@ -1038,8 +1045,7 @@ using `make-temp-file', and the generated name is returned."
1038 (abbreviate-file-name buffer-file-name)) 1045 (abbreviate-file-name buffer-file-name))
1039 ;; Set the default-directory to the dir of the superior buffer. 1046 ;; Set the default-directory to the dir of the superior buffer.
1040 (setq default-directory arcdir) 1047 (setq default-directory arcdir)
1041 (make-local-variable 'archive-superior-buffer) 1048 (setq-local archive-superior-buffer archive-buffer)
1042 (setq archive-superior-buffer archive-buffer)
1043 (add-hook 'write-file-functions #'archive-write-file-member nil t) 1049 (add-hook 'write-file-functions #'archive-write-file-member nil t)
1044 (setq archive-subfile-mode descr) 1050 (setq archive-subfile-mode descr)
1045 (setq archive-file-name-coding-system file-name-coding) 1051 (setq archive-file-name-coding-system file-name-coding)
@@ -1253,7 +1259,7 @@ using `make-temp-file', and the generated name is returned."
1253 t) 1259 t)
1254 1260
1255(defun archive-*-write-file-member (archive descr command) 1261(defun archive-*-write-file-member (archive descr command)
1256 (let* ((ename (aref descr 0)) 1262 (let* ((ename (archive--file-desc-ext-file-name descr))
1257 (tmpfile (expand-file-name ename archive-tmpdir)) 1263 (tmpfile (expand-file-name ename archive-tmpdir))
1258 (top (directory-file-name (file-name-as-directory archive-tmpdir))) 1264 (top (directory-file-name (file-name-as-directory archive-tmpdir)))
1259 (default-directory (file-name-as-directory top))) 1265 (default-directory (file-name-as-directory top)))
@@ -1270,9 +1276,10 @@ using `make-temp-file', and the generated name is returned."
1270 ;; further processing clobbers it (we restore it in 1276 ;; further processing clobbers it (we restore it in
1271 ;; archive-write-file-member, above). 1277 ;; archive-write-file-member, above).
1272 (setq archive-member-coding-system last-coding-system-used) 1278 (setq archive-member-coding-system last-coding-system-used)
1273 (if (aref descr 3) 1279 (if (archive--file-desc-mode descr)
1274 ;; Set the file modes, but make sure we can read it. 1280 ;; Set the file modes, but make sure we can read it.
1275 (set-file-modes tmpfile (logior ?\400 (aref descr 3)))) 1281 (set-file-modes tmpfile
1282 (logior ?\400 (archive--file-desc-mode descr))))
1276 (setq ename 1283 (setq ename
1277 (encode-coding-string ename archive-file-name-coding-system)) 1284 (encode-coding-string ename archive-file-name-coding-system))
1278 (let* ((coding-system-for-write 'no-conversion) 1285 (let* ((coding-system-for-write 'no-conversion)
@@ -1376,7 +1383,7 @@ Use \\[archive-unmark-all-files] to remove all marks."
1376 "Change the protection bits associated with all marked or this member. 1383 "Change the protection bits associated with all marked or this member.
1377The new protection bits can either be specified as an octal number or 1384The new protection bits can either be specified as an octal number or
1378as a relative change like \"g+rw\" as for chmod(2)." 1385as a relative change like \"g+rw\" as for chmod(2)."
1379 (interactive "sNew mode (octal or relative): ") 1386 (interactive "sNew mode (octal or symbolic): ")
1380 (if archive-read-only (error "Archive is read-only")) 1387 (if archive-read-only (error "Archive is read-only"))
1381 (let ((func (archive-name "chmod-entry"))) 1388 (let ((func (archive-name "chmod-entry")))
1382 (if (fboundp func) 1389 (if (fboundp func)
@@ -1415,7 +1422,9 @@ as a relative change like \"g+rw\" as for chmod(2)."
1415 (goto-char archive-file-list-start) 1422 (goto-char archive-file-list-start)
1416 (while (< (point) archive-file-list-end) 1423 (while (< (point) archive-file-list-end)
1417 (if (= (following-char) ?D) 1424 (if (= (following-char) ?D)
1418 (setq files (cons (aref (archive-get-descr) 0) files))) 1425 (setq files (cons (archive--file-desc-ext-file-name
1426 (archive-get-descr))
1427 files)))
1419 (forward-line 1))) 1428 (forward-line 1)))
1420 (setq files (nreverse files)) 1429 (setq files (nreverse files))
1421 (and files 1430 (and files
@@ -1461,12 +1470,11 @@ as a relative change like \"g+rw\" as for chmod(2)."
1461 (error "Renaming is not supported for this archive type")))) 1470 (error "Renaming is not supported for this archive type"))))
1462 1471
1463;; Revert the buffer and recompute the dired-like listing. 1472;; Revert the buffer and recompute the dired-like listing.
1464(defun archive-mode-revert (&optional _no-auto-save _no-confirm) 1473(defun archive--mode-revert (orig-fun &rest args)
1465 (let ((no (archive-get-lineno))) 1474 (let ((no (archive-get-lineno)))
1466 (setq archive-files nil) 1475 (setq archive-files nil)
1467 (let ((revert-buffer-function nil) 1476 (let ((coding-system-for-read 'no-conversion))
1468 (coding-system-for-read 'no-conversion)) 1477 (apply orig-fun t t (cddr args)))
1469 (revert-buffer t t))
1470 (archive-mode) 1478 (archive-mode)
1471 (goto-char archive-file-list-start) 1479 (goto-char archive-file-list-start)
1472 (archive-next-line no))) 1480 (archive-next-line no)))
@@ -1477,15 +1485,135 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1477 (interactive) 1485 (interactive)
1478 (let ((inhibit-read-only t)) 1486 (let ((inhibit-read-only t))
1479 (undo))) 1487 (undo)))
1488
1489(defun archive--fit (str len)
1490 (let* ((spaces (- len (string-width str)))
1491 (pre (/ spaces 2)))
1492 (if (< spaces 1)
1493 (substring str 0 len)
1494 (concat (make-string pre ?\s) str (make-string (- spaces pre) ?\s)))))
1495
1496(defun archive--fit2 (str1 str2 len)
1497 (let* ((spaces (- len (string-width str1) (string-width str2))))
1498 (if (< spaces 1)
1499 (substring (concat str1 str2) 0 len)
1500 (concat str1 (make-string spaces ?\s) str2))))
1501
1502(defun archive--enabled-p (column)
1503 (not (memq column archive-hidden-columns)))
1504
1505(defun archive--summarize-descs (descs)
1506 (goto-char (point-min))
1507 (if (null descs)
1508 (progn (insert "M ... Filename\n")
1509 (insert "- ----- ---------------\n")
1510 (archive-summarize-files nil)
1511 (insert "- ----- ---------------\n"))
1512 (let* ((sample (car descs))
1513 (maxsize 0)
1514 (maxidlen 0)
1515 (totalsize 0)
1516 (times (archive--enabled-p 'Date&Time))
1517 (ids (and (archive--enabled-p 'Ids)
1518 (or (archive--file-desc-uid sample)
1519 (archive--file-desc-gid sample))))
1520 ;; For ratio, date/time, and mode, we presume that
1521 ;; they're either present on all entries or on nonel, and that they
1522 ;; take the same space on each of them.
1523 (ratios (and (archive--enabled-p 'Ratio)
1524 (archive--file-desc-ratio sample)))
1525 (ratiolen (if ratios (string-width ratios)))
1526 (timelen (length (archive--file-desc-time sample)))
1527 (samplemode (and (archive--enabled-p 'Mode)
1528 (archive--file-desc-mode sample)))
1529 (modelen (length (if samplemode (archive-int-to-mode samplemode)))))
1530 (dolist (desc descs)
1531 (when ids
1532 (let* ((uid (archive--file-desc-uid desc))
1533 (gid (archive--file-desc-uid desc))
1534 (len (cond
1535 ((not uid) (string-width gid))
1536 ((not gid) (string-width uid))
1537 (t (+ (string-width uid) (string-width gid) 1)))))
1538 (if (> len maxidlen) (setq maxidlen len))))
1539 (let ((size (archive--file-desc-size desc)))
1540 (cl-incf totalsize size)
1541 (if (> size maxsize) (setq maxsize size))))
1542 (let* ((sizelen (length (number-to-string maxsize)))
1543 (dash
1544 (concat
1545 "- "
1546 (if (> modelen 0) (concat (make-string modelen ?-) " "))
1547 (if ids (concat (make-string maxidlen ?-) " "))
1548 (make-string sizelen ?-) " "
1549 (if ratios (concat (make-string (1+ ratiolen) ?-) " "))
1550 " "
1551 (if times (concat (make-string timelen ?-) " "))
1552 "----------------\n"))
1553 (startcol (+ 2
1554 (if (> modelen 0) (+ 2 modelen) 0)
1555 (if ids (+ maxidlen 2) 0)
1556 sizelen 2
1557 (if ratios (+ 2 ratiolen) 0)
1558 (if times (+ timelen 2) 0))))
1559 (insert
1560 (concat "M "
1561 (if (> modelen 0) (concat (archive--fit "Mode" modelen) " "))
1562 (if ids (concat (archive--fit2 "Uid" "Gid" maxidlen) " "))
1563 (archive--fit "Size" sizelen) " "
1564 (if ratios (concat (archive--fit "Cmp" (1+ ratiolen)) " "))
1565 " "
1566 (if times (concat (archive--fit "Date&time" timelen) " "))
1567 " Filename\n"))
1568 (insert dash)
1569 (archive-summarize-files
1570 (mapcar (lambda (desc)
1571 (let* ((size (number-to-string
1572 (archive--file-desc-size desc)))
1573 (text
1574 (concat " "
1575 (when (> modelen 0)
1576 (concat (archive-int-to-mode
1577 (archive--file-desc-mode desc))
1578 " "))
1579 (when ids
1580 (concat (archive--fit2
1581 (archive--file-desc-uid desc)
1582 (archive--file-desc-gid desc)
1583 maxidlen) " "))
1584 (make-string (- sizelen (length size)) ?\s)
1585 size
1586 " "
1587 (when ratios
1588 (concat (archive--file-desc-ratio desc)
1589 "% "))
1590 " "
1591 (when times
1592 (concat (archive--file-desc-time desc)
1593 " "))
1594 (archive--file-desc-int-file-name desc))))
1595 (archive--file-summary
1596 text startcol (length text))))
1597 descs))
1598 (insert dash)
1599 (insert (format (format "%%%dd %%s %%d files\n"
1600 (+ 2
1601 (if (> modelen 0) (+ 2 modelen) 0)
1602 (if ids (+ maxidlen 2) 0)
1603 sizelen))
1604 totalsize
1605 (make-string (+ (if times (+ 2 timelen) 0)
1606 (if ratios (+ 2 ratiolen) 0) 1)
1607 ?\s)
1608 (length descs))))))
1609 (apply #'vector descs))
1610
1480;; ------------------------------------------------------------------------- 1611;; -------------------------------------------------------------------------
1481;;; Section: Arc Archives 1612;;; Section: Arc Archives
1482 1613
1483(defun archive-arc-summarize () 1614(defun archive-arc-summarize ()
1484 (let ((p 1) 1615 (let ((p 1)
1485 (totalsize 0) 1616 files)
1486 (maxlen 8)
1487 files
1488 visual)
1489 (while (and (< (+ p 29) (point-max)) 1617 (while (and (< (+ p 29) (point-max))
1490 (= (get-byte p) ?\C-z) 1618 (= (get-byte p) ?\C-z)
1491 (> (get-byte (1+ p)) 0)) 1619 (> (get-byte (1+ p)) 0))
@@ -1498,48 +1626,28 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1498 (modtime (archive-l-e (+ p 21) 2)) 1626 (modtime (archive-l-e (+ p 21) 2))
1499 (ucsize (archive-l-e (+ p 25) 4)) 1627 (ucsize (archive-l-e (+ p 25) 4))
1500 (fiddle (string= efnname (upcase efnname))) 1628 (fiddle (string= efnname (upcase efnname)))
1501 (ifnname (if fiddle (downcase efnname) efnname)) 1629 (ifnname (if fiddle (downcase efnname) efnname)))
1502 (text (format " %8d %-11s %-8s %s" 1630 (setq files (cons (archive--file-desc
1503 ucsize 1631 efnname ifnname nil ucsize
1504 (archive-dosdate moddate) 1632 (concat (archive-dosdate moddate)
1505 (archive-dostime modtime) 1633 " " (archive-dostime modtime))
1506 ifnname))) 1634 :pos (1- p))
1507 (setq maxlen (max maxlen fnlen)
1508 totalsize (+ totalsize ucsize)
1509 visual (cons (vector text
1510 (- (length text) (length ifnname))
1511 (length text))
1512 visual)
1513 files (cons (vector efnname ifnname fiddle nil (1- p))
1514 files) 1635 files)
1515 p (+ p 29 csize)))) 1636 p (+ p 29 csize))))
1516 (goto-char (point-min)) 1637 (archive--summarize-descs (nreverse files))))
1517 (let ((dash (concat "- -------- ----------- -------- "
1518 (make-string maxlen ?-)
1519 "\n")))
1520 (insert "M Length Date Time File\n"
1521 dash)
1522 (archive-summarize-files (nreverse visual))
1523 (insert dash
1524 (format " %8d %d file%s"
1525 totalsize
1526 (length files)
1527 (if (= 1 (length files)) "" "s"))
1528 "\n"))
1529 (apply #'vector (nreverse files))))
1530 1638
1531(defun archive-arc-rename-entry (newname descr) 1639(defun archive-arc-rename-entry (newname descr)
1532 (if (string-match "[:\\/]" newname) 1640 (if (string-match "[:\\/]" newname)
1533 (error "File names in arc files must not contain a directory component")) 1641 (error "File names in arc files must not contain a directory component"))
1534 (if (> (length newname) 12) 1642 (if (> (length newname) 12)
1535 (error "File names in arc files are limited to 12 characters")) 1643 (error "File names in arc files are limited to 12 characters"))
1536 (let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0" 1644 (let ((name (concat newname (make-string (- 13 (length newname)) ?\0)))
1537 (length newname))))
1538 (inhibit-read-only t)) 1645 (inhibit-read-only t))
1539 (save-restriction 1646 (save-restriction
1540 (save-excursion 1647 (save-excursion
1541 (widen) 1648 (widen)
1542 (goto-char (+ archive-proper-file-start (aref descr 4) 2)) 1649 (goto-char (+ archive-proper-file-start 2
1650 (archive--file-desc-pos descr)))
1543 (delete-char 13) 1651 (delete-char 13)
1544 (arc-insert-unibyte name))))) 1652 (arc-insert-unibyte name)))))
1545;; ------------------------------------------------------------------------- 1653;; -------------------------------------------------------------------------
@@ -1547,10 +1655,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1547 1655
1548(defun archive-lzh-summarize (&optional start) 1656(defun archive-lzh-summarize (&optional start)
1549 (let ((p (or start 1)) ;; 1 for .lzh, something further on for .exe 1657 (let ((p (or start 1)) ;; 1 for .lzh, something further on for .exe
1550 (totalsize 0) 1658 files)
1551 (maxlen 8)
1552 files
1553 visual)
1554 (while (progn (goto-char p) ;beginning of a base header. 1659 (while (progn (goto-char p) ;beginning of a base header.
1555 (looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-")) 1660 (looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-"))
1556 (let* ((hsize (get-byte p)) ;size of the base header (level 0 and 1) 1661 (let* ((hsize (get-byte p)) ;size of the base header (level 0 and 1)
@@ -1561,9 +1666,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1561 (time2 (archive-l-e (+ p 17) 2)) ;and UNIX format in level 2 header.) 1666 (time2 (archive-l-e (+ p 17) 2)) ;and UNIX format in level 2 header.)
1562 (hdrlvl (get-byte (+ p 20))) ;header level 1667 (hdrlvl (get-byte (+ p 20))) ;header level
1563 thsize ;total header size (base + extensions) 1668 thsize ;total header size (base + extensions)
1564 fnlen efnname osid fiddle ifnname width p2 1669 fnlen efnname osid fiddle ifnname p2
1565 neh ;beginning of next extension header (level 1 and 2) 1670 neh ;beginning of next extension header (level 1 and 2)
1566 mode modestr uid gid text dir prname 1671 mode uid gid dir prname
1567 gname uname modtime moddate) 1672 gname uname modtime moddate)
1568 (if (= hdrlvl 3) (error "can't handle lzh level 3 header type")) 1673 (if (= hdrlvl 3) (error "can't handle lzh level 3 header type"))
1569 (when (or (= hdrlvl 0) (= hdrlvl 1)) 1674 (when (or (= hdrlvl 0) (= hdrlvl 1))
@@ -1576,26 +1681,26 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1576 (setq neh (+ p2 3)) ;specific to level 1 header 1681 (setq neh (+ p2 3)) ;specific to level 1 header
1577 (if (= hdrlvl 2) 1682 (if (= hdrlvl 2)
1578 (setq neh (+ p 24)))) ;specific to level 2 header 1683 (setq neh (+ p 24)))) ;specific to level 2 header
1579 (if neh ;if level 1 or 2 we expect extension headers to follow 1684 (if neh ;if level 1 or 2 we expect extension headers to follow
1580 (let* ((ehsize (archive-l-e neh 2)) ;size of the extension header 1685 (let* ((ehsize (archive-l-e neh 2)) ;size of the extension header
1581 (etype (get-byte (+ neh 2)))) ;extension type 1686 (etype (get-byte (+ neh 2)))) ;extension type
1582 (while (not (= ehsize 0)) 1687 (while (not (= ehsize 0))
1583 (cond 1688 (cond
1584 ((= etype 1) ;file name 1689 ((= etype 1) ;file name
1585 (let ((i (+ neh 3))) 1690 (let ((i (+ neh 3)))
1586 (while (< i (+ neh ehsize)) 1691 (while (< i (+ neh ehsize))
1587 (setq efnname (concat efnname (char-to-string (get-byte i)))) 1692 (setq efnname (concat efnname (char-to-string (get-byte i))))
1588 (setq i (1+ i))))) 1693 (setq i (1+ i)))))
1589 ((= etype 2) ;directory name 1694 ((= etype 2) ;directory name
1590 (let ((i (+ neh 3))) 1695 (let ((i (+ neh 3)))
1591 (while (< i (+ neh ehsize)) 1696 (while (< i (+ neh ehsize))
1592 (setq dir (concat dir 1697 (setq dir (concat dir
1593 (if (= (get-byte i) 1698 (if (= (get-byte i)
1594 255) 1699 255)
1595 "/" 1700 "/"
1596 (char-to-string 1701 (char-to-string
1597 (char-after i))))) 1702 (char-after i)))))
1598 (setq i (1+ i))))) 1703 (setq i (1+ i)))))
1599 ((= etype 80) ;Unix file permission 1704 ((= etype 80) ;Unix file permission
1600 (setq mode (archive-l-e (+ neh 3) 2))) 1705 (setq mode (archive-l-e (+ neh 3) 2)))
1601 ((= etype 81) ;UNIX file group/user ID 1706 ((= etype 81) ;UNIX file group/user ID
@@ -1611,7 +1716,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1611 (while (< i (+ neh ehsize)) 1716 (while (< i (+ neh ehsize))
1612 (setq uname (concat uname (char-to-string (char-after i)))) 1717 (setq uname (concat uname (char-to-string (char-after i))))
1613 (setq i (1+ i))))) 1718 (setq i (1+ i)))))
1614 ) 1719 )
1615 (setq neh (+ neh ehsize)) 1720 (setq neh (+ neh ehsize))
1616 (setq ehsize (archive-l-e neh 2)) 1721 (setq ehsize (archive-l-e neh 2))
1617 (setq etype (get-byte (+ neh 2)))) 1722 (setq etype (get-byte (+ neh 2))))
@@ -1637,60 +1742,25 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1637 ((= 0 osid) (string= efnname (upcase efnname))))) 1742 ((= 0 osid) (string= efnname (upcase efnname)))))
1638 (setq ifnname (if fiddle (downcase efnname) efnname)) 1743 (setq ifnname (if fiddle (downcase efnname) efnname))
1639 (setq prname (if dir (concat dir ifnname) ifnname)) 1744 (setq prname (if dir (concat dir ifnname) ifnname))
1640 (setq width (if prname (string-width prname) 0))
1641 (setq modestr (if mode (archive-int-to-mode mode) "??????????"))
1642 (setq moddate (if (= hdrlvl 2) 1745 (setq moddate (if (= hdrlvl 2)
1643 (archive-unixdate time1 time2) ;level 2 header in UNIX format 1746 (archive-unixdate time1 time2) ;level 2 header in UNIX format
1644 (archive-dosdate time2))) ;level 0 and 1 header in DOS format 1747 (archive-dosdate time2))) ;level 0 and 1 header in DOS format
1645 (setq modtime (if (= hdrlvl 2) 1748 (setq modtime (if (= hdrlvl 2)
1646 (archive-unixtime time1 time2) 1749 (archive-unixtime time1 time2)
1647 (archive-dostime time1))) 1750 (archive-dostime time1)))
1648 (setq text (if archive-alternate-display 1751 (push (archive--file-desc
1649 (format " %8d %5S %5S %s" 1752 prname ifnname mode ucsize
1650 ucsize 1753 (concat moddate " " modtime)
1651 (or uid "?") 1754 :pos (1- p)
1652 (or gid "?") 1755 :uid (or uname (if uid (number-to-string uid)))
1653 ifnname) 1756 :gid (or gname (if gid (number-to-string gid))))
1654 (format " %10s %8d %-11s %-8s %s" 1757 files)
1655 modestr
1656 ucsize
1657 moddate
1658 modtime
1659 prname)))
1660 (setq maxlen (max maxlen width)
1661 totalsize (+ totalsize ucsize)
1662 visual (cons (vector text
1663 (- (length text) (length prname))
1664 (length text))
1665 visual)
1666 files (cons (vector prname ifnname fiddle mode (1- p))
1667 files))
1668 (cond ((= hdrlvl 1) 1758 (cond ((= hdrlvl 1)
1669 (setq p (+ p hsize 2 csize))) 1759 (setq p (+ p hsize 2 csize)))
1670 ((or (= hdrlvl 2) (= hdrlvl 0)) 1760 ((or (= hdrlvl 2) (= hdrlvl 0))
1671 (setq p (+ p thsize 2 csize)))) 1761 (setq p (+ p thsize 2 csize))))
1672 )) 1762 ))
1673 (goto-char (point-min)) 1763 (archive--summarize-descs (nreverse files))))
1674 (let ((dash (concat (if archive-alternate-display
1675 "- -------- ----- ----- "
1676 "- ---------- -------- ----------- -------- ")
1677 (make-string maxlen ?-)
1678 "\n"))
1679 (header (if archive-alternate-display
1680 "M Length Uid Gid File\n"
1681 "M Filemode Length Date Time File\n"))
1682 (sumline (if archive-alternate-display
1683 " %8.0f %d file%s"
1684 " %8.0f %d file%s")))
1685 (insert header dash)
1686 (archive-summarize-files (nreverse visual))
1687 (insert dash
1688 (format sumline
1689 totalsize
1690 (length files)
1691 (if (= 1 (length files)) "" "s"))
1692 "\n"))
1693 (apply #'vector (nreverse files))))
1694 1764
1695(defconst archive-lzh-alternate-display t) 1765(defconst archive-lzh-alternate-display t)
1696 1766
@@ -1709,7 +1779,8 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1709 (save-restriction 1779 (save-restriction
1710 (save-excursion 1780 (save-excursion
1711 (widen) 1781 (widen)
1712 (let* ((p (+ archive-proper-file-start (aref descr 4))) 1782 (let* ((p (+ archive-proper-file-start
1783 (archive--file-desc-pos descr)))
1713 (oldhsize (get-byte p)) 1784 (oldhsize (get-byte p))
1714 (oldfnlen (get-byte (+ p 21))) 1785 (oldfnlen (get-byte (+ p 21)))
1715 (newfnlen (length newname)) 1786 (newfnlen (length newname))
@@ -1729,7 +1800,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1729 (save-restriction 1800 (save-restriction
1730 (widen) 1801 (widen)
1731 (dolist (fil files) 1802 (dolist (fil files)
1732 (let* ((p (+ archive-proper-file-start (aref fil 4))) 1803 (let* ((p (+ archive-proper-file-start (archive--file-desc-pos fil)))
1733 (hsize (get-byte p)) 1804 (hsize (get-byte p))
1734 (fnlen (get-byte (+ p 21))) 1805 (fnlen (get-byte (+ p 21)))
1735 (p2 (+ p 22 fnlen)) 1806 (p2 (+ p 22 fnlen))
@@ -1746,7 +1817,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1746 (delete-char 1) 1817 (delete-char 1)
1747 (arc-insert-unibyte (archive-lzh-resum (1+ p) hsize))) 1818 (arc-insert-unibyte (archive-lzh-resum (1+ p) hsize)))
1748 (message "Member %s does not have %s field" 1819 (message "Member %s does not have %s field"
1749 (aref fil 1) errtxt))))))) 1820 (archive--file-desc-int-file-name fil) errtxt)))))))
1750 1821
1751(defun archive-lzh-chown-entry (newuid files) 1822(defun archive-lzh-chown-entry (newuid files)
1752 (archive-lzh-ogm newuid files "an uid" 10)) 1823 (archive-lzh-ogm newuid files "an uid" 10))
@@ -1756,8 +1827,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1756 1827
1757(defun archive-lzh-chmod-entry (newmode files) 1828(defun archive-lzh-chmod-entry (newmode files)
1758 (archive-lzh-ogm 1829 (archive-lzh-ogm
1759 ;; This should work even though newmode will be dynamically accessed. 1830 (lambda (old) (archive-calc-mode old newmode))
1760 (lambda (old) (archive-calc-mode old newmode t))
1761 files "a unix-style mode" 8)) 1831 files "a unix-style mode" 8))
1762 1832
1763;; ------------------------------------------------------------------------- 1833;; -------------------------------------------------------------------------
@@ -1794,10 +1864,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1794 (goto-char (- (point-max) (- 22 18))) 1864 (goto-char (- (point-max) (- 22 18)))
1795 (search-backward-regexp "[P]K\005\006") 1865 (search-backward-regexp "[P]K\005\006")
1796 (let ((p (archive-l-e (+ (point) 16) 4)) 1866 (let ((p (archive-l-e (+ (point) 16) 4))
1797 (maxlen 8) 1867 files)
1798 (totalsize 0)
1799 files
1800 visual)
1801 (when (= p -1) 1868 (when (= p -1)
1802 ;; If the offset of end-of-central-directory is -1, this is a 1869 ;; If the offset of end-of-central-directory is -1, this is a
1803 ;; Zip64 extended ZIP file format, and we need to glean the info 1870 ;; Zip64 extended ZIP file format, and we need to glean the info
@@ -1823,7 +1890,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1823 (fnlen (archive-l-e (+ p 28) 2)) 1890 (fnlen (archive-l-e (+ p 28) 2))
1824 (exlen (archive-l-e (+ p 30) 2)) 1891 (exlen (archive-l-e (+ p 30) 2))
1825 (fclen (archive-l-e (+ p 32) 2)) 1892 (fclen (archive-l-e (+ p 32) 2))
1826 (lheader (archive-l-e (+ p 42) 4)) 1893 ;; (lheader (archive-l-e (+ p 42) 4))
1827 (efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen)))) 1894 (efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen))))
1828 (decode-coding-string 1895 (decode-coding-string
1829 str archive-file-name-coding-system))) 1896 str archive-file-name-coding-system)))
@@ -1838,44 +1905,18 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1838 (logand 1 (get-byte (+ p 38)))) 1905 (logand 1 (get-byte (+ p 38))))
1839 ?\222 0))) 1906 ?\222 0)))
1840 (t nil))) 1907 (t nil)))
1841 (modestr (if mode (archive-int-to-mode mode) "??????????"))
1842 (fiddle (and archive-zip-case-fiddle 1908 (fiddle (and archive-zip-case-fiddle
1843 (not (not (memq creator '(0 2 4 5 9)))) 1909 (memq creator '(0 2 4 5 9))
1844 (string= (upcase efnname) efnname))) 1910 (string= (upcase efnname) efnname)))
1845 (ifnname (if fiddle (downcase efnname) efnname)) 1911 (ifnname (if fiddle (downcase efnname) efnname)))
1846 (width (string-width ifnname)) 1912 (setq files (cons (archive--file-desc
1847 (text (format " %10s %8d %-11s %-8s %s" 1913 efnname ifnname mode ucsize
1848 modestr 1914 (concat (archive-dosdate moddate)
1849 ucsize 1915 " " (archive-dostime modtime))
1850 (archive-dosdate moddate) 1916 :pos (1- p))
1851 (archive-dostime modtime) 1917 files)
1852 ifnname)))
1853 (setq maxlen (max maxlen width)
1854 totalsize (+ totalsize ucsize)
1855 visual (cons (vector text
1856 (- (length text) (length ifnname))
1857 (length text))
1858 visual)
1859 files (cons (if isdir
1860 nil
1861 (vector efnname ifnname fiddle mode
1862 (list (1- p) lheader)))
1863 files)
1864 p (+ p 46 fnlen exlen fclen)))) 1918 p (+ p 46 fnlen exlen fclen))))
1865 (goto-char (point-min)) 1919 (archive--summarize-descs (nreverse files))))
1866 (let ((dash (concat "- ---------- -------- ----------- -------- "
1867 (make-string maxlen ?-)
1868 "\n")))
1869 (insert "M Filemode Length Date Time File\n"
1870 dash)
1871 (archive-summarize-files (nreverse visual))
1872 (insert dash
1873 (format " %8d %d file%s"
1874 totalsize
1875 (length files)
1876 (if (= 1 (length files)) "" "s"))
1877 "\n"))
1878 (apply #'vector (nreverse files))))
1879 1920
1880(defun archive-zip-extract (archive name) 1921(defun archive-zip-extract (archive name)
1881 (cond 1922 (cond
@@ -1900,21 +1941,27 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1900 name) 1941 name)
1901 archive-zip-extract)))) 1942 archive-zip-extract))))
1902 1943
1944(defun archive--file-desc-case-fiddled (fd)
1945 (not (eq (archive--file-desc-int-file-name fd)
1946 (archive--file-desc-ext-file-name fd))))
1947
1903(defun archive-zip-write-file-member (archive descr) 1948(defun archive-zip-write-file-member (archive descr)
1904 (archive-*-write-file-member 1949 (archive-*-write-file-member
1905 archive 1950 archive
1906 descr 1951 descr
1907 (if (aref descr 2) archive-zip-update-case archive-zip-update))) 1952 (if (archive--file-desc-case-fiddled descr)
1953 archive-zip-update-case archive-zip-update)))
1908 1954
1909(defun archive-zip-chmod-entry (newmode files) 1955(defun archive-zip-chmod-entry (newmode files)
1910 (save-restriction 1956 (save-restriction
1911 (save-excursion 1957 (save-excursion
1912 (widen) 1958 (widen)
1913 (dolist (fil files) 1959 (dolist (fil files)
1914 (let* ((p (+ archive-proper-file-start (car (aref fil 4)))) 1960 (let* ((p (+ archive-proper-file-start
1961 (archive--file-desc-pos fil)))
1915 (creator (get-byte (+ p 5))) 1962 (creator (get-byte (+ p 5)))
1916 (oldmode (aref fil 3)) 1963 (oldmode (archive--file-desc-mode fil))
1917 (newval (archive-calc-mode oldmode newmode t)) 1964 (newval (archive-calc-mode oldmode newmode))
1918 (inhibit-read-only t)) 1965 (inhibit-read-only t))
1919 (cond ((memq creator '(2 3)) ; Unix 1966 (cond ((memq creator '(2 3)) ; Unix
1920 (goto-char (+ p 40)) 1967 (goto-char (+ p 40))
@@ -1933,10 +1980,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1933 1980
1934(defun archive-zoo-summarize () 1981(defun archive-zoo-summarize ()
1935 (let ((p (1+ (archive-l-e 25 4))) 1982 (let ((p (1+ (archive-l-e 25 4)))
1936 (maxlen 8) 1983 files)
1937 (totalsize 0)
1938 files
1939 visual)
1940 (while (and (string= "\334\247\304\375" (buffer-substring p (+ p 4))) 1984 (while (and (string= "\334\247\304\375" (buffer-substring p (+ p 4)))
1941 (> (archive-l-e (+ p 6) 4) 0)) 1985 (> (archive-l-e (+ p 6) 4) 0))
1942 (let* ((next (1+ (archive-l-e (+ p 6) 4))) 1986 (let* ((next (1+ (archive-l-e (+ p 6) 4)))
@@ -1963,36 +2007,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1963 (decode-coding-string 2007 (decode-coding-string
1964 str archive-file-name-coding-system))) 2008 str archive-file-name-coding-system)))
1965 (fiddle (and (= lfnlen 0) (string= efnname (upcase efnname)))) 2009 (fiddle (and (= lfnlen 0) (string= efnname (upcase efnname))))
1966 (ifnname (if fiddle (downcase efnname) efnname)) 2010 (ifnname (if fiddle (downcase efnname) efnname)))
1967 (width (string-width ifnname)) 2011 (setq files (cons (archive--file-desc
1968 (text (format " %8d %-11s %-8s %s" 2012 efnname ifnname nil ucsize
1969 ucsize 2013 (concat (archive-dosdate moddate)
1970 (archive-dosdate moddate) 2014 " " (archive-dostime modtime)))
1971 (archive-dostime modtime)
1972 ifnname)))
1973 (setq maxlen (max maxlen width)
1974 totalsize (+ totalsize ucsize)
1975 visual (cons (vector text
1976 (- (length text) (length ifnname))
1977 (length text))
1978 visual)
1979 files (cons (vector efnname ifnname fiddle nil (1- p))
1980 files) 2015 files)
1981 p next))) 2016 p next)))
1982 (goto-char (point-min)) 2017 (archive--summarize-descs (nreverse files))))
1983 (let ((dash (concat "- -------- ----------- -------- "
1984 (make-string maxlen ?-)
1985 "\n")))
1986 (insert "M Length Date Time File\n"
1987 dash)
1988 (archive-summarize-files (nreverse visual))
1989 (insert dash
1990 (format " %8d %d file%s"
1991 totalsize
1992 (length files)
1993 (if (= 1 (length files)) "" "s"))
1994 "\n"))
1995 (apply #'vector (nreverse files))))
1996 2018
1997(defun archive-zoo-extract (archive name) 2019(defun archive-zoo-extract (archive name)
1998 (archive-extract-by-stdout archive name archive-zoo-extract)) 2020 (archive-extract-by-stdout archive name archive-zoo-extract))
@@ -2004,17 +2026,16 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
2004 ;; File is used internally for `archive-rar-exe-summarize'. 2026 ;; File is used internally for `archive-rar-exe-summarize'.
2005 (unless file (setq file buffer-file-name)) 2027 (unless file (setq file buffer-file-name))
2006 (let* ((copy (file-local-copy file)) 2028 (let* ((copy (file-local-copy file))
2007 (maxname 10)
2008 (maxsize 5)
2009 (files ())) 2029 (files ()))
2010 (with-temp-buffer 2030 (with-temp-buffer
2011 (call-process "lsar" nil t nil "-l" (or file copy)) 2031 (unwind-protect
2012 (if copy (delete-file copy)) 2032 (call-process "lsar" nil t nil "-l" (or file copy))
2033 (if copy (delete-file copy)))
2013 (goto-char (point-min)) 2034 (goto-char (point-min))
2014 (re-search-forward "^\\(\s+=+\s*\\)+\n") 2035 (re-search-forward "^\\(\s+=+\s*\\)+\n")
2015 (while (looking-at (concat "^\s+[0-9.]+\s+D?-+\s+" ; Flags 2036 (while (looking-at (concat "^\s+[0-9.]+\s+D?-+\s+" ; Flags
2016 "\\([0-9-]+\\)\s+" ; Size 2037 "\\([0-9-]+\\)\s+" ; Size
2017 "\\([-0-9.%]+\\)\s+" ; Ratio 2038 "\\([-0-9.]+\\)%?\s+" ; Ratio
2018 "\\([0-9a-zA-Z]+\\)\s+" ; Mode 2039 "\\([0-9a-zA-Z]+\\)\s+" ; Mode
2019 "\\([0-9-]+\\)\s+" ; Date 2040 "\\([0-9-]+\\)\s+" ; Date
2020 "\\([0-9:]+\\)\s+" ; Time 2041 "\\([0-9:]+\\)\s+" ; Time
@@ -2023,36 +2044,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
2023 (goto-char (match-end 0)) 2044 (goto-char (match-end 0))
2024 (let ((name (match-string 6)) 2045 (let ((name (match-string 6))
2025 (size (match-string 1))) 2046 (size (match-string 1)))
2026 (if (> (length name) maxname) (setq maxname (length name))) 2047 (push (archive--file-desc name name nil
2027 (if (> (length size) maxsize) (setq maxsize (length size))) 2048 ;; Size
2028 (push (vector name name nil nil 2049 (string-to-number size)
2029 ;; Size, Ratio. 2050 ;; Date&Time.
2030 size (match-string 2) 2051 (concat (match-string 4) " " (match-string 5))
2031 ;; Date, Time. 2052 :ratio (match-string 2))
2032 (match-string 4) (match-string 5))
2033 files)))) 2053 files))))
2034 (setq files (nreverse files)) 2054 (archive--summarize-descs (nreverse files))))
2035 (goto-char (point-min))
2036 (let* ((format (format " %%s %%s %%%ds %%5s %%s" maxsize))
2037 (sep (format format "----------" "-----" (make-string maxsize ?-)
2038 "-----" ""))
2039 (column (length sep)))
2040 (insert (format format " Date " "Time " "Size" "Ratio" "Filename") "\n")
2041 (insert sep (make-string maxname ?-) "\n")
2042 (archive-summarize-files (mapcar (lambda (desc)
2043 (let ((text
2044 (format format
2045 (aref desc 6)
2046 (aref desc 7)
2047 (aref desc 4)
2048 (aref desc 5)
2049 (aref desc 1))))
2050 (vector text
2051 column
2052 (length text))))
2053 files))
2054 (insert sep (make-string maxname ?-) "\n")
2055 (apply #'vector files))))
2056 2055
2057(defun archive-rar-extract (archive name) 2056(defun archive-rar-extract (archive name)
2058 ;; unrar-free seems to have no way to extract to stdout or even to a file. 2057 ;; unrar-free seems to have no way to extract to stdout or even to a file.
@@ -2099,9 +2098,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
2099;;; Section: 7z Archives 2098;;; Section: 7z Archives
2100 2099
2101(defun archive-7z-summarize () 2100(defun archive-7z-summarize ()
2102 (let ((maxname 10) 2101 (let ((file buffer-file-name)
2103 (maxsize 5)
2104 (file buffer-file-name)
2105 (files ())) 2102 (files ()))
2106 (with-temp-buffer 2103 (with-temp-buffer
2107 (call-process archive-7z-program nil t nil "l" "-slt" file) 2104 (call-process archive-7z-program nil t nil "l" "-slt" file)
@@ -2118,29 +2115,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
2118 (time (save-excursion 2115 (time (save-excursion
2119 (and (re-search-forward "^Modified = \\(.*\\)\n") 2116 (and (re-search-forward "^Modified = \\(.*\\)\n")
2120 (match-string 1))))) 2117 (match-string 1)))))
2121 (if (> (length name) maxname) (setq maxname (length name))) 2118 (push (archive--file-desc name name nil (string-to-number size) time)
2122 (if (> (length size) maxsize) (setq maxsize (length size)))
2123 (push (vector name name nil nil time nil nil size)
2124 files)))) 2119 files))))
2125 (setq files (nreverse files)) 2120 (archive--summarize-descs (nreverse files))))
2126 (goto-char (point-min))
2127 (let* ((format (format " %%%ds %%s %%s" maxsize))
2128 (sep (format format (make-string maxsize ?-) "-------------------" ""))
2129 (column (length sep)))
2130 (insert (format format "Size " "Date Time " " Filename") "\n")
2131 (insert sep (make-string maxname ?-) "\n")
2132 (archive-summarize-files (mapcar (lambda (desc)
2133 (let ((text
2134 (format format
2135 (aref desc 7)
2136 (aref desc 4)
2137 (aref desc 1))))
2138 (vector text
2139 column
2140 (length text))))
2141 files))
2142 (insert sep (make-string maxname ?-) "\n")
2143 (apply #'vector files))))
2144 2121
2145(defun archive-7z-extract (archive name) 2122(defun archive-7z-extract (archive name)
2146 ;; 7z doesn't provide a `quiet' option to suppress non-essential 2123 ;; 7z doesn't provide a `quiet' option to suppress non-essential
@@ -2167,79 +2144,43 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
2167(defconst archive-ar-file-header-re 2144(defconst archive-ar-file-header-re
2168 "\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n") 2145 "\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n")
2169 2146
2147(defun archive-ar--name (name)
2148 "Return the external name represented by the entry NAME.
2149NAME is expected to be the 16-bytes part of an ar record."
2150 (cond ((equal name "// ")
2151 (propertize ".<ExtNamesTable>." 'face 'italic))
2152 ((equal name "/ ")
2153 (propertize ".<LookupTable>." 'face 'italic))
2154 ((string-match "/? *\\'" name)
2155 ;; FIXME: Decode? Add support for longer names?
2156 (substring name 0 (match-beginning 0)))))
2157
2170(defun archive-ar-summarize () 2158(defun archive-ar-summarize ()
2171 ;; File is used internally for `archive-rar-exe-summarize'. 2159 ;; File is used internally for `archive-rar-exe-summarize'.
2172 (let* ((maxname 10) 2160 (let* ((files ()))
2173 (maxtime 16)
2174 (maxuser 5)
2175 (maxgroup 5)
2176 (maxmode 8)
2177 (maxsize 5)
2178 (files ()))
2179 (goto-char (point-min)) 2161 (goto-char (point-min))
2180 (search-forward "!<arch>\n") 2162 (search-forward "!<arch>\n")
2181 (while (looking-at archive-ar-file-header-re) 2163 (while (looking-at archive-ar-file-header-re)
2182 (let ((name (match-string 1)) 2164 (let* ((name (match-string 1))
2183 extname 2165 extname
2184 (time (string-to-number (match-string 2))) 2166 (time (string-to-number (match-string 2)))
2185 (user (match-string 3)) 2167 (user (match-string 3))
2186 (group (match-string 4)) 2168 (group (match-string 4))
2187 (mode (string-to-number (match-string 5) 8)) 2169 (mode (string-to-number (match-string 5) 8))
2188 (size (string-to-number (match-string 6)))) 2170 (sizestr (match-string 6))
2171 (size (string-to-number sizestr)))
2189 ;; Move to the beginning of the data. 2172 ;; Move to the beginning of the data.
2190 (goto-char (match-end 0)) 2173 (goto-char (match-end 0))
2191 (setq time (format-time-string "%Y-%m-%d %H:%M" time)) 2174 (setq time (format-time-string "%Y-%m-%d %H:%M" time))
2192 (setq extname 2175 (setq extname (archive-ar--name name))
2193 (cond ((equal name "// ")
2194 (propertize ".<ExtNamesTable>." 'face 'italic))
2195 ((equal name "/ ")
2196 (propertize ".<LookupTable>." 'face 'italic))
2197 ((string-match "/? *\\'" name)
2198 (substring name 0 (match-beginning 0)))))
2199 (setq user (substring user 0 (string-match " +\\'" user))) 2176 (setq user (substring user 0 (string-match " +\\'" user)))
2200 (setq group (substring group 0 (string-match " +\\'" group))) 2177 (setq group (substring group 0 (string-match " +\\'" group)))
2201 (setq mode (tar-grind-file-mode mode))
2202 ;; Move to the end of the data. 2178 ;; Move to the end of the data.
2203 (forward-char size) (if (eq ?\n (char-after)) (forward-char 1)) 2179 (forward-char size) (if (eq ?\n (char-after)) (forward-char 1))
2204 (setq size (number-to-string size)) 2180 (push (archive--file-desc extname extname mode size time
2205 (if (> (length name) maxname) (setq maxname (length name))) 2181 :uid user :gid group)
2206 (if (> (length time) maxtime) (setq maxtime (length time)))
2207 (if (> (length user) maxuser) (setq maxuser (length user)))
2208 (if (> (length group) maxgroup) (setq maxgroup (length group)))
2209 (if (> (length mode) maxmode) (setq maxmode (length mode)))
2210 (if (> (length size) maxsize) (setq maxsize (length size)))
2211 (push (vector name extname nil mode
2212 time user group size)
2213 files))) 2182 files)))
2214 (setq files (nreverse files)) 2183 (archive--summarize-descs (nreverse files))))
2215 (goto-char (point-min))
2216 (let* ((format (format "%%%ds %%%ds/%%-%ds %%%ds %%%ds %%s"
2217 maxmode maxuser maxgroup maxsize maxtime))
2218 (sep (format format (make-string maxmode ?-)
2219 (make-string maxuser ?-)
2220 (make-string maxgroup ?-)
2221 (make-string maxsize ?-)
2222 (make-string maxtime ?-) ""))
2223 (column (length sep)))
2224 (insert (format format " Mode " "User" "Group" " Size "
2225 " Date " "Filename")
2226 "\n")
2227 (insert sep (make-string maxname ?-) "\n")
2228 (archive-summarize-files (mapcar (lambda (desc)
2229 (let ((text
2230 (format format
2231 (aref desc 3)
2232 (aref desc 5)
2233 (aref desc 6)
2234 (aref desc 7)
2235 (aref desc 4)
2236 (aref desc 1))))
2237 (vector text
2238 column
2239 (length text))))
2240 files))
2241 (insert sep (make-string maxname ?-) "\n")
2242 (apply #'vector files))))
2243 2184
2244(defun archive-ar-extract (archive name) 2185(defun archive-ar-extract (archive name)
2245 (let ((destbuf (current-buffer)) 2186 (let ((destbuf (current-buffer))
@@ -2256,10 +2197,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
2256 (let ((this (match-string 1))) 2197 (let ((this (match-string 1)))
2257 (setq size (string-to-number (match-string 6))) 2198 (setq size (string-to-number (match-string 6)))
2258 (goto-char (match-end 0)) 2199 (goto-char (match-end 0))
2259 (if (equal name this) 2200 (if (equal name (archive-ar--name this))
2260 (setq from (point)) 2201 (setq from (point))
2261 ;; Move to the end of the data. 2202 ;; Move to the end of the data.
2262 (forward-char size) (if (eq ?\n (char-after)) (forward-char 1))))) 2203 (forward-char size)
2204 (if (eq ?\n (char-after)) (forward-char 1)))))
2263 (when from 2205 (when from
2264 (set-buffer-multibyte nil) 2206 (set-buffer-multibyte nil)
2265 (with-current-buffer destbuf 2207 (with-current-buffer destbuf
@@ -2269,6 +2211,13 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
2269 ;; Inform the caller that the call succeeded. 2211 ;; Inform the caller that the call succeeded.
2270 t)))))) 2212 t))))))
2271 2213
2214(defun archive-ar-write-file-member (archive descr)
2215 (archive-*-write-file-member
2216 archive
2217 descr
2218 '("ar" "r")))
2219
2220
2272;; ------------------------------------------------------------------------- 2221;; -------------------------------------------------------------------------
2273;; This line was a mistake; it is kept now for compatibility. 2222;; This line was a mistake; it is kept now for compatibility.
2274;; rms 15 Oct 98 2223;; rms 15 Oct 98
diff --git a/lisp/faces.el b/lisp/faces.el
index 9a49ea81042..e707f6f4b6e 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1560,7 +1560,7 @@ is given, in which case return its value instead."
1560 ;; return it to the caller. Since there will most definitely be something to 1560 ;; return it to the caller. Since there will most definitely be something to
1561 ;; return in this case, there's no need to know/check if a match was found. 1561 ;; return in this case, there's no need to know/check if a match was found.
1562 (if defaults 1562 (if defaults
1563 (append result defaults) 1563 (append defaults result)
1564 (if match-found 1564 (if match-found
1565 result 1565 result
1566 no-match-retval)))) 1566 no-match-retval))))
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index bccef6890f8..aa3f7d399e9 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -11685,7 +11685,16 @@ comment at the start of cc-engine.el for more info."
11685 (not (c-in-literal)) 11685 (not (c-in-literal))
11686 )))) 11686 ))))
11687 nil) 11687 nil)
11688 (t t)))))) 11688 (t t)))))
11689 ((and
11690 (c-major-mode-is 'c++-mode)
11691 (eq (char-after) ?\[)
11692 ;; Be careful of "operator []"
11693 (not (save-excursion
11694 (c-backward-token-2 1 nil lim)
11695 (looking-at c-opt-op-identifier-prefix))))
11696 (setq braceassignp t)
11697 nil))
11689 (when (eq braceassignp 'dontknow) 11698 (when (eq braceassignp 'dontknow)
11690 (cond ((and 11699 (cond ((and
11691 (not (eq (char-after) ?,)) 11700 (not (eq (char-after) ?,))
@@ -12057,7 +12066,7 @@ comment at the start of cc-engine.el for more info."
12057 (c-backward-token-2 1 nil lim) 12066 (c-backward-token-2 1 nil lim)
12058 (and 12067 (and
12059 (not (and (c-on-identifier) 12068 (not (and (c-on-identifier)
12060 (looking-at c-symbol-chars))) 12069 (looking-at c-symbol-char-key)))
12061 (not (looking-at c-opt-op-identifier-prefix))))))) 12070 (not (looking-at c-opt-op-identifier-prefix)))))))
12062 (cons 'inlambda bracket-pos)) 12071 (cons 'inlambda bracket-pos))
12063 ((and c-recognize-paren-inexpr-blocks 12072 ((and c-recognize-paren-inexpr-blocks
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 7fb36873918..07506834f18 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -1850,7 +1850,8 @@ static char *magick[] = {
1850 "\\|def\\(i\\(ne?\\)?\\)?\\|doc\\(u\\(m\\(e\\(nt?\\)?\\)?\\)?\\)?\\|" 1850 "\\|def\\(i\\(ne?\\)?\\)?\\|doc\\(u\\(m\\(e\\(nt?\\)?\\)?\\)?\\)?\\|"
1851 gdb-python-guile-commands-regexp 1851 gdb-python-guile-commands-regexp
1852 "\\|while-stepping\\|stepp\\(i\\(ng?\\)?\\)?\\|ws\\|actions" 1852 "\\|while-stepping\\|stepp\\(i\\(ng?\\)?\\)?\\|ws\\|actions"
1853 "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)?$") 1853 "\\|expl\\(o\\(r\\e?\\)?\\)?"
1854 "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)*$")
1854 "Regexp matching GDB commands that enter a recursive reading loop. 1855 "Regexp matching GDB commands that enter a recursive reading loop.
1855As long as GDB is in the recursive reading loop, it does not expect 1856As long as GDB is in the recursive reading loop, it does not expect
1856commands to be prefixed by \"-interpreter-exec console\".") 1857commands to be prefixed by \"-interpreter-exec console\".")
@@ -2508,7 +2509,13 @@ file names include non-ASCII characters."
2508 2509
2509 gdb-filter-output) 2510 gdb-filter-output)
2510 2511
2511(defun gdb-gdb (_output-field)) 2512(defun gdb-gdb (_output-field)
2513 ;; This is needed because the "explore" command is not ended by the
2514 ;; likes of "end" or "quit", but instead by a RET at the approriate
2515 ;; place, and we know we have exited "explore" when we get the
2516 ;; "(gdb)" prompt.
2517 (and (> gdb-control-level 0)
2518 (setq gdb-control-level (1- gdb-control-level))))
2512 2519
2513(defun gdb-shell (output-field) 2520(defun gdb-shell (output-field)
2514 (setq gdb-filter-output 2521 (setq gdb-filter-output
diff --git a/src/Makefile.in b/src/Makefile.in
index 8d7fdb8a607..429f7035443 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -381,11 +381,14 @@ endif
381# Flags that might be in WARN_CFLAGS but are not valid for Objective C. 381# Flags that might be in WARN_CFLAGS but are not valid for Objective C.
382NON_OBJC_CFLAGS = -Wignored-attributes -Wignored-qualifiers -Wopenmp-simd 382NON_OBJC_CFLAGS = -Wignored-attributes -Wignored-qualifiers -Wopenmp-simd
383 383
384# Cajole GCC into inlining key ops even if it wouldn't normally.
385KEY_OPS_CFLAGS = $(if $(filter -Og,$(CFLAGS)),-DDEFINE_KEY_OPS_AS_MACROS)
386
384# -Demacs makes some files produce the correct version for use in Emacs. 387# -Demacs makes some files produce the correct version for use in Emacs.
385# MYCPPFLAGS is for by-hand Emacs-specific overrides, e.g., 388# MYCPPFLAGS is for by-hand Emacs-specific overrides, e.g.,
386# "make MYCPPFLAGS='-DDBUS_DEBUG'". 389# "make MYCPPFLAGS='-DDBUS_DEBUG'".
387EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ 390EMACS_CFLAGS = -Demacs $(KEY_OPS_CFLAGS) $(MYCPPFLAGS) \
388 -I$(lib) -I$(top_srcdir)/lib \ 391 -I. -I$(srcdir) -I$(lib) -I$(top_srcdir)/lib \
389 $(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \ 392 $(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \
390 $(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \ 393 $(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
391 $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \ 394 $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \
diff --git a/src/character.c b/src/character.c
index d71cb3f145c..a566cacb023 100644
--- a/src/character.c
+++ b/src/character.c
@@ -849,24 +849,22 @@ Concatenate all the argument characters and make the result a string.
849usage: (string &rest CHARACTERS) */) 849usage: (string &rest CHARACTERS) */)
850 (ptrdiff_t n, Lisp_Object *args) 850 (ptrdiff_t n, Lisp_Object *args)
851{ 851{
852 ptrdiff_t i; 852 ptrdiff_t nbytes = 0;
853 int c; 853 for (ptrdiff_t i = 0; i < n; i++)
854 unsigned char *buf, *p;
855 Lisp_Object str;
856 USE_SAFE_ALLOCA;
857
858 SAFE_NALLOCA (buf, MAX_MULTIBYTE_LENGTH, n);
859 p = buf;
860
861 for (i = 0; i < n; i++)
862 { 854 {
863 CHECK_CHARACTER (args[i]); 855 CHECK_CHARACTER (args[i]);
864 c = XFIXNUM (args[i]); 856 nbytes += CHAR_BYTES (XFIXNUM (args[i]));
857 }
858 if (nbytes == n)
859 return Funibyte_string (n, args);
860 Lisp_Object str = make_uninit_multibyte_string (n, nbytes);
861 unsigned char *p = SDATA (str);
862 for (ptrdiff_t i = 0; i < n; i++)
863 {
864 eassume (CHARACTERP (args[i]));
865 int c = XFIXNUM (args[i]);
865 p += CHAR_STRING (c, p); 866 p += CHAR_STRING (c, p);
866 } 867 }
867
868 str = make_string_from_bytes ((char *) buf, n, p - buf);
869 SAFE_FREE ();
870 return str; 868 return str;
871} 869}
872 870
@@ -875,20 +873,13 @@ DEFUN ("unibyte-string", Funibyte_string, Sunibyte_string, 0, MANY, 0,
875usage: (unibyte-string &rest BYTES) */) 873usage: (unibyte-string &rest BYTES) */)
876 (ptrdiff_t n, Lisp_Object *args) 874 (ptrdiff_t n, Lisp_Object *args)
877{ 875{
878 ptrdiff_t i; 876 Lisp_Object str = make_uninit_string (n);
879 Lisp_Object str; 877 unsigned char *p = SDATA (str);
880 USE_SAFE_ALLOCA; 878 for (ptrdiff_t i = 0; i < n; i++)
881 unsigned char *buf = SAFE_ALLOCA (n);
882 unsigned char *p = buf;
883
884 for (i = 0; i < n; i++)
885 { 879 {
886 CHECK_RANGED_INTEGER (args[i], 0, 255); 880 CHECK_RANGED_INTEGER (args[i], 0, 255);
887 *p++ = XFIXNUM (args[i]); 881 *p++ = XFIXNUM (args[i]);
888 } 882 }
889
890 str = make_string_from_bytes ((char *) buf, n, p - buf);
891 SAFE_FREE ();
892 return str; 883 return str;
893} 884}
894 885
diff --git a/src/lisp.h b/src/lisp.h
index 2f719b1f03e..1a5215df394 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -411,15 +411,19 @@ typedef EMACS_INT Lisp_Word;
411# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) 411# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
412#endif 412#endif
413 413
414/* When compiling via gcc -O0, define the key operations as macros, as 414/* When DEFINE_KEY_OPS_AS_MACROS, define key operations as macros to
415 Emacs is too slow otherwise. To disable this optimization, compile 415 cajole the compiler into inlining them; otherwise define them as
416 with -DINLINING=false. */ 416 inline functions as this is cleaner and can be more efficient.
417#if (defined __NO_INLINE__ \ 417 The default is true if the compiler is GCC-like and if function
418 && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ 418 inlining is disabled because the compiler is not optimizing or is
419 && ! (defined INLINING && ! INLINING)) 419 optimizing for size. Otherwise the default is false. */
420# define DEFINE_KEY_OPS_AS_MACROS true 420#ifndef DEFINE_KEY_OPS_AS_MACROS
421#else 421# if (defined __NO_INLINE__ \
422# define DEFINE_KEY_OPS_AS_MACROS false 422 && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__)
423# define DEFINE_KEY_OPS_AS_MACROS true
424# else
425# define DEFINE_KEY_OPS_AS_MACROS false
426# endif
423#endif 427#endif
424 428
425#if DEFINE_KEY_OPS_AS_MACROS 429#if DEFINE_KEY_OPS_AS_MACROS
generated by cgit v1.2.1 (git 2.18.0) at 2026-04-23 04:02:54 +0000