commit 05d365d3105371ec956f31f109a2de14c5cf67df (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sat Apr 4 09:59:16 2020 +0300 Fix face spec handling for 'default' "terminal class" * lisp/faces.el (face-spec-choose): Reverse order of 'defaults' and 'result' when generating attribute list, so that the spec for 'default' "terminal class" is indeed overridden by the actual class's spec, per the documentation. (Bug#40336) diff --git a/lisp/faces.el b/lisp/faces.el index 9a49ea8104..e707f6f4b6 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1560,7 +1560,7 @@ is given, in which case return its value instead." ;; return it to the caller. Since there will most definitely be something to ;; return in this case, there's no need to know/check if a match was found. (if defaults - (append result defaults) + (append defaults result) (if match-found result no-match-retval)))) commit fd38c9c0afe2c5bbf04f565eec05daa52a16472b Author: Stefan Monnier Date: Fri Apr 3 18:11:52 2020 -0400 * lisp/arc-mode.el: Remove unused struct fields (archive--file-desc): Remove `case-fiddled`. Change all subtypes's constructors as their callers accordingly. (archive--file-desc-case-fiddled): New function. (archive-int-to-mode): Accept a nil input. Make all callers take advantage of it. (archive-arc-rename-entry): Use `make-string`. (archive-zip--file-desc): Change `pos+len` field into `pos` field. (archive-zip-chmod-entry): Simplify accordingly. (archive-zip-summarize): Don't bother with `lheader` which was not used. (archive-zoo--file-desc): Delete struct; use archive--file-desc instead. (archive-7z--file-desc): Remove `user` and `group` fields. Adjust constructor and its caller. (archive-ar-summarize): Use `archive-int-to-mode`. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 4609123dec..0a7816c225 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -497,8 +497,23 @@ Its value is an `archive--file-desc'.") (cl-defstruct (archive--file-desc (:constructor nil) (:constructor archive--file-desc - (ext-file-name int-file-name case-fiddled mode))) - ext-file-name int-file-name case-fiddled mode) + ;; ext-file-name and int-file-name are usually `eq' + ;; except when int-file-name is the downcased + ;; ext-file-name. + (ext-file-name int-file-name mode))) + ext-file-name int-file-name mode) + +;; Features in formats: +;; +;; ARC: size, date, time (date and time strings internally generated) +;; LZH: size, date, time, mode, uid, gid (mode, date, time generated, ugid:int) +;; ZIP: size, date, time, mode (mode, date, time generated) +;; ZOO: size, date, time (date and time strings internally generated) +;; AR : size, date, time, mode, user, group (internally generated) +;; RAR: size, date, time, ratio (all as strings, using `lsar') +;; 7Z : size, date, time (all as strings, using `7z' or `7za') +;; +;; LZH has alternate display (with UID/GID i.s.o MODE/DATE/TIME (defvar archive-files nil "Vector of `archive--file-desc' objects.") @@ -537,23 +552,25 @@ in which case a second argument, length LEN, should be supplied." (defun archive-int-to-mode (mode) "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------." ;; FIXME: merge with tar-grind-file-mode. - (string - (if (zerop (logand 8192 mode)) - (if (zerop (logand 16384 mode)) ?- ?d) - ?c) ; completeness - (if (zerop (logand 256 mode)) ?- ?r) - (if (zerop (logand 128 mode)) ?- ?w) - (if (zerop (logand 64 mode)) - (if (zerop (logand 2048 mode)) ?- ?S) - (if (zerop (logand 2048 mode)) ?x ?s)) - (if (zerop (logand 32 mode)) ?- ?r) - (if (zerop (logand 16 mode)) ?- ?w) - (if (zerop (logand 8 mode)) - (if (zerop (logand 1024 mode)) ?- ?S) - (if (zerop (logand 1024 mode)) ?x ?s)) - (if (zerop (logand 4 mode)) ?- ?r) - (if (zerop (logand 2 mode)) ?- ?w) - (if (zerop (logand 1 mode)) ?- ?x))) + (if (null mode) + "??????????" + (string + (if (zerop (logand 8192 mode)) + (if (zerop (logand 16384 mode)) ?- ?d) + ?c) ; completeness + (if (zerop (logand 256 mode)) ?- ?r) + (if (zerop (logand 128 mode)) ?- ?w) + (if (zerop (logand 64 mode)) + (if (zerop (logand 2048 mode)) ?- ?S) + (if (zerop (logand 2048 mode)) ?x ?s)) + (if (zerop (logand 32 mode)) ?- ?r) + (if (zerop (logand 16 mode)) ?- ?w) + (if (zerop (logand 8 mode)) + (if (zerop (logand 1024 mode)) ?- ?S) + (if (zerop (logand 1024 mode)) ?x ?s)) + (if (zerop (logand 4 mode)) ?- ?r) + (if (zerop (logand 2 mode)) ?- ?w) + (if (zerop (logand 1 mode)) ?- ?x)))) (defun archive-calc-mode (oldmode newmode) "From the integer OLDMODE and the string NEWMODE calculate a new file mode. @@ -1443,8 +1460,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (:include archive--file-desc) (:constructor nil) (:constructor archive-arc--file-desc - (ext-file-name int-file-name case-fiddled mode - pos))) + (ext-file-name int-file-name mode pos))) pos) (defun archive-arc-summarize () @@ -1479,7 +1495,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (length text)) visual) files (cons (archive-arc--file-desc - efnname ifnname fiddle nil (1- p)) + efnname ifnname nil (1- p)) files) p (+ p 29 csize)))) (goto-char (point-min)) @@ -1502,8 +1518,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (error "File names in arc files must not contain a directory component")) (if (> (length newname) 12) (error "File names in arc files are limited to 12 characters")) - (let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0" - (length newname)))) + (let ((name (concat newname (make-string (- 13 (length newname)) ?\0))) (inhibit-read-only t)) (save-restriction (save-excursion @@ -1519,8 +1534,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (:include archive--file-desc) (:constructor nil) (:constructor archive-lzh--file-desc - (ext-file-name int-file-name case-fiddled mode - pos))) + (ext-file-name int-file-name mode pos))) pos) (defun archive-lzh-summarize (&optional start) @@ -1616,7 +1630,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (setq ifnname (if fiddle (downcase efnname) efnname)) (setq prname (if dir (concat dir ifnname) ifnname)) (setq width (if prname (string-width prname) 0)) - (setq modestr (if mode (archive-int-to-mode mode) "??????????")) + (setq modestr (archive-int-to-mode mode)) (setq moddate (if (= hdrlvl 2) (archive-unixdate time1 time2) ;level 2 header in UNIX format (archive-dosdate time2))) ;level 0 and 1 header in DOS format @@ -1643,7 +1657,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (length text)) visual) files (cons (archive-lzh--file-desc - prname ifnname fiddle mode (1- p)) + prname ifnname mode (1- p)) files)) (cond ((= hdrlvl 1) (setq p (+ p hsize 2 csize))) @@ -1774,9 +1788,8 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (:include archive--file-desc) (:constructor nil) (:constructor archive-zip--file-desc - (ext-file-name int-file-name case-fiddled mode - pos+len))) - pos+len) + (ext-file-name int-file-name mode pos))) + pos) (defun archive-zip-summarize () (goto-char (- (point-max) (- 22 18))) @@ -1811,7 +1824,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (fnlen (archive-l-e (+ p 28) 2)) (exlen (archive-l-e (+ p 30) 2)) (fclen (archive-l-e (+ p 32) 2)) - (lheader (archive-l-e (+ p 42) 4)) + ;; (lheader (archive-l-e (+ p 42) 4)) (efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen)))) (decode-coding-string str archive-file-name-coding-system))) @@ -1826,9 +1839,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (logand 1 (get-byte (+ p 38)))) ?\222 0))) (t nil))) - (modestr (if mode (archive-int-to-mode mode) "??????????")) + (modestr (archive-int-to-mode mode)) (fiddle (and archive-zip-case-fiddle - (not (not (memq creator '(0 2 4 5 9)))) + (memq creator '(0 2 4 5 9)) (string= (upcase efnname) efnname))) (ifnname (if fiddle (downcase efnname) efnname)) (width (string-width ifnname)) @@ -1847,8 +1860,8 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." visual) files (cons (if isdir nil - (archive-zip--file-desc efnname ifnname fiddle mode - (list (1- p) lheader))) + (archive-zip--file-desc efnname ifnname mode + (1- p))) files) p (+ p 46 fnlen exlen fclen)))) (goto-char (point-min)) @@ -1889,6 +1902,10 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." name) archive-zip-extract)))) +(defun archive--file-desc-case-fiddled (fd) + (not (eq (archive--file-desc-int-file-name fd) + (archive--file-desc-ext-file-name fd)))) + (defun archive-zip-write-file-member (archive descr) (archive-*-write-file-member archive @@ -1902,7 +1919,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (widen) (dolist (fil files) (let* ((p (+ archive-proper-file-start - (car (archive-zip--file-desc-pos+len fil)))) + (archive-zip--file-desc-pos fil))) (creator (get-byte (+ p 5))) (oldmode (archive--file-desc-mode fil)) (newval (archive-calc-mode oldmode newmode)) @@ -1922,14 +1939,6 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; Section: Zoo Archives -(cl-defstruct (archive-zoo--file-desc - (:include archive--file-desc) - (:constructor nil) - (:constructor archive-zoo--file-desc - (ext-file-name int-file-name case-fiddled mode - pos))) - pos) - (defun archive-zoo-summarize () (let ((p (1+ (archive-l-e 25 4))) (maxlen 8) @@ -1977,9 +1986,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (length text)) visual) ;; FIXME: Keep size/date(/mode?) in the desc! - files (cons (archive-zoo--file-desc - ;; FIXME: The `pos' field seems unused! - efnname ifnname fiddle nil (1- p)) + files (cons (archive--file-desc efnname ifnname nil) files) p next))) (goto-char (point-min)) @@ -2007,8 +2014,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (:include archive--file-desc) (:constructor nil) (:constructor archive-rar--file-desc - (ext-file-name int-file-name case-fiddled mode - size ratio date time))) + (ext-file-name int-file-name mode size ratio date time))) size ratio date time) (defun archive-rar-summarize (&optional file) @@ -2036,7 +2042,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (size (match-string 1))) (if (> (length name) maxname) (setq maxname (length name))) (if (> (length size) maxsize) (setq maxsize (length size))) - (push (archive-rar--file-desc name name nil nil + (push (archive-rar--file-desc name name nil ;; Size, Ratio. size (match-string 2) ;; Date, Time. @@ -2115,9 +2121,8 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (:include archive--file-desc) (:constructor nil) (:constructor archive-7z--file-desc - (ext-file-name int-file-name case-fiddled mode - time user group size))) - time user group size) + (ext-file-name int-file-name mode time size))) + time size) (defun archive-7z-summarize () (let ((maxname 10) @@ -2141,7 +2146,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (match-string 1))))) (if (> (length name) maxname) (setq maxname (length name))) (if (> (length size) maxsize) (setq maxsize (length size))) - (push (archive-7z--file-desc name name nil nil time nil nil size) + (push (archive-7z--file-desc name name nil time size) files)))) (setq files (nreverse files)) (goto-char (point-min)) @@ -2187,8 +2192,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (:include archive--file-desc) (:constructor nil) (:constructor archive-ar--file-desc - (ext-file-name int-file-name case-fiddled mode - time user group size))) + (ext-file-name int-file-name mode time user group size))) time user group size) (autoload 'tar-grind-file-mode "tar-mode") @@ -2232,7 +2236,7 @@ NAME is expected to be the 16-bytes part of an ar record." (setq extname (archive-ar--name name)) (setq user (substring user 0 (string-match " +\\'" user))) (setq group (substring group 0 (string-match " +\\'" group))) - (setq mode (tar-grind-file-mode mode)) + (setq mode (archive-int-to-mode mode)) ;; Move to the end of the data. (forward-char size) (if (eq ?\n (char-after)) (forward-char 1)) (setq size (number-to-string size)) @@ -2242,7 +2246,7 @@ NAME is expected to be the 16-bytes part of an ar record." (if (> (length group) maxgroup) (setq maxgroup (length group))) (if (> (length mode) maxmode) (setq maxmode (length mode))) (if (> (length size) maxsize) (setq maxsize (length size))) - (push (archive-ar--file-desc extname extname nil mode + (push (archive-ar--file-desc extname extname mode time user group size) files))) (setq files (nreverse files)) commit c640be60d918d5a7be4d9d5e717cf159f878d38c Author: Stefan Monnier Date: Fri Apr 3 16:45:54 2020 -0400 * lisp/arc-mode.el: Use cl-structs rather than vectors (archive--file-desc, archive--file-summary, archive-arc--file-desc) (archive-lzh--file-desc, archive-zip--file-desc) (archive-zoo--file-desc, archive-rar--file-desc) (archive-7z--file-desc, archive-ar--file-desc): New structs. (archive-get-descr, archive-mode, archive-summarize-files) (archive-maybe-copy, archive-extract, archive-*-write-file-member) (archive-expunge, archive-arc-summarize, archive-arc-rename-entry) (archive-lzh-summarize, archive-lzh-rename-entry, archive-lzh-ogm) (archive-zip-summarize, archive-zip-write-file-member) (archive-zip-chmod-entry, archive-zoo-summarize) (archive-rar-summarize, archive-7z-summarize, archive-ar-summarize) (archive-ar-write-file-member): Use struct constructors and accessors instead of `vector` and `aref`. (archive-calc-mode): Remove `error` arg which was always non-nil; adjust all callers. Rewrite using `string-to-number` and `file-modes-symbolic-to-number`. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 21b9627e40..4609123dec 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -366,7 +366,7 @@ file. Archive and member name will be added." (defvar archive-file-list-end nil "Position just after last contents line.") (defvar archive-proper-file-start nil "Position of real archive's start.") (defvar archive-read-only nil "Non-nil if the archive is read-only on disk.") -(defvar archive-local-name nil "Name of local copy of remote archive.") +(defvar-local archive-local-name nil "Name of local copy of remote archive.") (defvar archive-mode-map (let ((map (make-keymap))) (set-keymap-parent map special-mode-map) @@ -485,18 +485,23 @@ file. Archive and member name will be added." (defvar archive-superior-buffer nil "In archive members, points to archive.") (put 'archive-superior-buffer 'permanent-local t) -(defvar archive-subfile-mode nil "Non-nil in archive member buffers.") -(make-variable-buffer-local 'archive-subfile-mode) +(defvar-local archive-subfile-mode nil + "Non-nil in archive member buffers. +Its value is an `archive--file-desc'.") (put 'archive-subfile-mode 'permanent-local t) (defvar archive-file-name-coding-system nil) (make-variable-buffer-local 'archive-file-name-coding-system) (put 'archive-file-name-coding-system 'permanent-local t) +(cl-defstruct (archive--file-desc + (:constructor nil) + (:constructor archive--file-desc + (ext-file-name int-file-name case-fiddled mode))) + ext-file-name int-file-name case-fiddled mode) + (defvar archive-files nil - "Vector of file descriptors. -Each descriptor is a vector of the form - [EXT-FILE-NAME INT-FILE-NAME CASE-FIDDLED MODE ...]") + "Vector of `archive--file-desc' objects.") (make-variable-buffer-local 'archive-files) ;; ------------------------------------------------------------------------- @@ -550,52 +555,16 @@ in which case a second argument, length LEN, should be supplied." (if (zerop (logand 2 mode)) ?- ?w) (if (zerop (logand 1 mode)) ?- ?x))) -(defun archive-calc-mode (oldmode newmode &optional error) +(defun archive-calc-mode (oldmode newmode) "From the integer OLDMODE and the string NEWMODE calculate a new file mode. NEWMODE may be an octal number including a leading zero in which case it will become the new mode.\n NEWMODE may also be a relative specification like \"og-rwx\" in which case -OLDMODE will be modified accordingly just like chmod(2) would have done.\n -If optional third argument ERROR is non-nil an error will be signaled if -the mode is invalid. If ERROR is nil then nil will be returned." - (cond ((string-match "^0[0-7]*$" newmode) - (let ((result 0) - (len (length newmode)) - (i 1)) - (while (< i len) - (setq result (+ (ash result 3) (aref newmode i) (- ?0)) - i (1+ i))) - (logior (logand oldmode 65024) result))) - ((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode) - (let ((who 0) - (result oldmode) - (op (aref newmode (match-beginning 2))) - (bits 0) - (i (match-beginning 3))) - (while (< i (match-end 3)) - (let ((rwx (aref newmode i))) - (setq bits (logior bits (cond ((= rwx ?r) 292) - ((= rwx ?w) 146) - ((= rwx ?x) 73) - ((= rwx ?s) 3072) - ((= rwx ?t) 512))) - i (1+ i)))) - (while (< who (match-end 1)) - (let* ((whoc (aref newmode who)) - (whomask (cond ((= whoc ?a) 4095) - ((= whoc ?u) 1472) - ((= whoc ?g) 2104) - ((= whoc ?o) 7)))) - (if (= op ?=) - (setq result (logand result (lognot whomask)))) - (if (= op ?-) - (setq result (logand result (lognot (logand whomask bits)))) - (setq result (logior result (logand whomask bits))))) - (setq who (1+ who))) - result)) - (t - (if error - (error "Invalid mode specification: %s" newmode))))) +OLDMODE will be modified accordingly just like chmod(2) would have done." + ;; FIXME: Use `file-modes-symbolic-to-number'! + (if (string-match "\\`0[0-7]*\\'" newmode) + (logior (logand oldmode #o177000) (string-to-number newmode 8)) + (file-modes-symbolic-to-number newmode oldmode))) (defun archive-dosdate (date) "Stringify dos packed DATE record." @@ -644,7 +613,7 @@ Does not signal an error if optional argument NOERROR is non-nil." (if (and (>= (point) archive-file-list-start) (< no (length archive-files))) (let ((item (aref archive-files no))) - (if (vectorp item) + (if (archive--file-desc-p item) item (if (not noerror) (error "Entry is not a regular member of the archive")))) @@ -696,10 +665,8 @@ archive. (or (not (file-writable-p (buffer-file-name))) (and archive-subfile-mode (string-match file-name-invalid-regexp - (aref archive-subfile-mode 0))))) - - ;; Should we use a local copy when accessing from outside Emacs? - (make-local-variable 'archive-local-name) + (archive--file-desc-ext-file-name + archive-subfile-mode))))) ;; An archive can contain another archive whose name is invalid ;; on local filesystem. Treat such archives as remote. @@ -806,27 +773,35 @@ when parsing the archive." (goto-char archive-file-list-start) (archive-next-line no))) +(cl-defstruct (archive--file-summary + (:constructor nil) + (:constructor archive--file-summary (text name-start name-end))) + text name-start name-end) + (defun archive-summarize-files (files) "Insert a description of a list of files annotated with proper mouse face." (setq archive-file-list-start (point-marker)) - (setq archive-file-name-indent (if files (aref (car files) 1) 0)) + ;; Here we assume that they all start at the same column. + (setq archive-file-name-indent + ;; FIXME: We assume chars=columns (no double-wide chars and such). + (if files (archive--file-summary-name-start (car files)) 0)) ;; We don't want to do an insert for each element since that takes too ;; long when the archive -- which has to be moved in memory -- is large. (insert - (apply - #'concat - (mapcar - (lambda (fil) - ;; Using `concat' here copies the text also, so we can add - ;; properties without problems. - (let ((text (concat (aref fil 0) "\n"))) - (add-text-properties - (aref fil 1) (aref fil 2) - '(mouse-face highlight - help-echo "mouse-2: extract this file into a buffer") - text) - text)) - files))) + (mapconcat + (lambda (fil) + ;; Using `concat' here copies the text also, so we can add + ;; properties without problems. + (let ((text (concat (archive--file-summary-text fil) "\n"))) + (add-text-properties + (archive--file-summary-name-start fil) + (archive--file-summary-name-end fil) + '(mouse-face highlight + help-echo "mouse-2: extract this file into a buffer") + text) + text)) + files + "")) (setq archive-file-list-end (point-marker))) (defun archive-alternate-display () @@ -880,7 +855,8 @@ using `make-temp-file', and the generated name is returned." ;; "foo.zip:bar.zip", which is invalid on DOS/Windows. ;; So use the actual name if available. (archive-name - (or (and archive-subfile-mode (aref archive-subfile-mode 0)) + (or (and archive-subfile-mode (archive--file-desc-ext-file-name + archive-subfile-mode)) archive))) (setq archive-local-name (archive-unique-fname archive-name archive-tmpdir)) @@ -989,8 +965,8 @@ using `make-temp-file', and the generated name is returned." (if event (posn-set-point (event-end event))) (let* ((view-p (eq other-window-p 'view)) (descr (archive-get-descr)) - (ename (aref descr 0)) - (iname (aref descr 1)) + (ename (archive--file-desc-ext-file-name descr)) + (iname (archive--file-desc-int-file-name descr)) (archive-buffer (current-buffer)) (arcdir default-directory) (archive (buffer-file-name)) @@ -1234,7 +1210,7 @@ using `make-temp-file', and the generated name is returned." t) (defun archive-*-write-file-member (archive descr command) - (let* ((ename (aref descr 0)) + (let* ((ename (archive--file-desc-ext-file-name descr)) (tmpfile (expand-file-name ename archive-tmpdir)) (top (directory-file-name (file-name-as-directory archive-tmpdir))) (default-directory (file-name-as-directory top))) @@ -1251,9 +1227,10 @@ using `make-temp-file', and the generated name is returned." ;; further processing clobbers it (we restore it in ;; archive-write-file-member, above). (setq archive-member-coding-system last-coding-system-used) - (if (aref descr 3) + (if (archive--file-desc-mode descr) ;; Set the file modes, but make sure we can read it. - (set-file-modes tmpfile (logior ?\400 (aref descr 3)))) + (set-file-modes tmpfile + (logior ?\400 (archive--file-desc-mode descr)))) (setq ename (encode-coding-string ename archive-file-name-coding-system)) (let* ((coding-system-for-write 'no-conversion) @@ -1357,7 +1334,7 @@ Use \\[archive-unmark-all-files] to remove all marks." "Change the protection bits associated with all marked or this member. The new protection bits can either be specified as an octal number or as a relative change like \"g+rw\" as for chmod(2)." - (interactive "sNew mode (octal or relative): ") + (interactive "sNew mode (octal or symbolic): ") (if archive-read-only (error "Archive is read-only")) (let ((func (archive-name "chmod-entry"))) (if (fboundp func) @@ -1396,7 +1373,9 @@ as a relative change like \"g+rw\" as for chmod(2)." (goto-char archive-file-list-start) (while (< (point) archive-file-list-end) (if (= (following-char) ?D) - (setq files (cons (aref (archive-get-descr) 0) files))) + (setq files (cons (archive--file-desc-ext-file-name + (archive-get-descr)) + files))) (forward-line 1))) (setq files (nreverse files)) (and files @@ -1460,6 +1439,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; Section: Arc Archives +(cl-defstruct (archive-arc--file-desc + (:include archive--file-desc) + (:constructor nil) + (:constructor archive-arc--file-desc + (ext-file-name int-file-name case-fiddled mode + pos))) + pos) + (defun archive-arc-summarize () (let ((p 1) (totalsize 0) @@ -1486,11 +1473,13 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ifnname))) (setq maxlen (max maxlen fnlen) totalsize (+ totalsize ucsize) - visual (cons (vector text - (- (length text) (length ifnname)) - (length text)) + visual (cons (archive--file-summary + text + (- (length text) (length ifnname)) + (length text)) visual) - files (cons (vector efnname ifnname fiddle nil (1- p)) + files (cons (archive-arc--file-desc + efnname ifnname fiddle nil (1- p)) files) p (+ p 29 csize)))) (goto-char (point-min)) @@ -1519,12 +1508,21 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (save-restriction (save-excursion (widen) - (goto-char (+ archive-proper-file-start (aref descr 4) 2)) + (goto-char (+ archive-proper-file-start 2 + (archive-arc--file-desc-pos descr))) (delete-char 13) (arc-insert-unibyte name))))) ;; ------------------------------------------------------------------------- ;;; Section: Lzh Archives +(cl-defstruct (archive-lzh--file-desc + (:include archive--file-desc) + (:constructor nil) + (:constructor archive-lzh--file-desc + (ext-file-name int-file-name case-fiddled mode + pos))) + pos) + (defun archive-lzh-summarize (&optional start) (let ((p (or start 1)) ;; 1 for .lzh, something further on for .exe (totalsize 0) @@ -1639,11 +1637,13 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." prname))) (setq maxlen (max maxlen width) totalsize (+ totalsize ucsize) - visual (cons (vector text - (- (length text) (length prname)) - (length text)) + visual (cons (archive--file-summary + text + (- (length text) (length prname)) + (length text)) visual) - files (cons (vector prname ifnname fiddle mode (1- p)) + files (cons (archive-lzh--file-desc + prname ifnname fiddle mode (1- p)) files)) (cond ((= hdrlvl 1) (setq p (+ p hsize 2 csize))) @@ -1689,7 +1689,8 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (save-restriction (save-excursion (widen) - (let* ((p (+ archive-proper-file-start (aref descr 4))) + (let* ((p (+ archive-proper-file-start + (archive-lzh--file-desc-pos descr))) (oldhsize (get-byte p)) (oldfnlen (get-byte (+ p 21))) (newfnlen (length newname)) @@ -1709,7 +1710,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (save-restriction (widen) (dolist (fil files) - (let* ((p (+ archive-proper-file-start (aref fil 4))) + (let* ((p (+ archive-proper-file-start (archive-lzh--file-desc-pos fil))) (hsize (get-byte p)) (fnlen (get-byte (+ p 21))) (p2 (+ p 22 fnlen)) @@ -1726,7 +1727,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (delete-char 1) (arc-insert-unibyte (archive-lzh-resum (1+ p) hsize))) (message "Member %s does not have %s field" - (aref fil 1) errtxt))))))) + (archive--file-desc-int-file-name fil) errtxt))))))) (defun archive-lzh-chown-entry (newuid files) (archive-lzh-ogm newuid files "an uid" 10)) @@ -1736,8 +1737,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (defun archive-lzh-chmod-entry (newmode files) (archive-lzh-ogm - ;; This should work even though newmode will be dynamically accessed. - (lambda (old) (archive-calc-mode old newmode t)) + (lambda (old) (archive-calc-mode old newmode)) files "a unix-style mode" 8)) ;; ------------------------------------------------------------------------- @@ -1770,6 +1770,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; Section: Zip Archives +(cl-defstruct (archive-zip--file-desc + (:include archive--file-desc) + (:constructor nil) + (:constructor archive-zip--file-desc + (ext-file-name int-file-name case-fiddled mode + pos+len))) + pos+len) + (defun archive-zip-summarize () (goto-char (- (point-max) (- 22 18))) (search-backward-regexp "[P]K\005\006") @@ -1832,14 +1840,15 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ifnname))) (setq maxlen (max maxlen width) totalsize (+ totalsize ucsize) - visual (cons (vector text - (- (length text) (length ifnname)) - (length text)) + visual (cons (archive--file-summary + text + (- (length text) (length ifnname)) + (length text)) visual) files (cons (if isdir nil - (vector efnname ifnname fiddle mode - (list (1- p) lheader))) + (archive-zip--file-desc efnname ifnname fiddle mode + (list (1- p) lheader))) files) p (+ p 46 fnlen exlen fclen)))) (goto-char (point-min)) @@ -1884,17 +1893,19 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (archive-*-write-file-member archive descr - (if (aref descr 2) archive-zip-update-case archive-zip-update))) + (if (archive--file-desc-case-fiddled descr) + archive-zip-update-case archive-zip-update))) (defun archive-zip-chmod-entry (newmode files) (save-restriction (save-excursion (widen) (dolist (fil files) - (let* ((p (+ archive-proper-file-start (car (aref fil 4)))) + (let* ((p (+ archive-proper-file-start + (car (archive-zip--file-desc-pos+len fil)))) (creator (get-byte (+ p 5))) - (oldmode (aref fil 3)) - (newval (archive-calc-mode oldmode newmode t)) + (oldmode (archive--file-desc-mode fil)) + (newval (archive-calc-mode oldmode newmode)) (inhibit-read-only t)) (cond ((memq creator '(2 3)) ; Unix (goto-char (+ p 40)) @@ -1911,6 +1922,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; Section: Zoo Archives +(cl-defstruct (archive-zoo--file-desc + (:include archive--file-desc) + (:constructor nil) + (:constructor archive-zoo--file-desc + (ext-file-name int-file-name case-fiddled mode + pos))) + pos) + (defun archive-zoo-summarize () (let ((p (1+ (archive-l-e 25 4))) (maxlen 8) @@ -1952,11 +1971,15 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ifnname))) (setq maxlen (max maxlen width) totalsize (+ totalsize ucsize) - visual (cons (vector text - (- (length text) (length ifnname)) - (length text)) + visual (cons (archive--file-summary + text + (- (length text) (length ifnname)) + (length text)) visual) - files (cons (vector efnname ifnname fiddle nil (1- p)) + ;; FIXME: Keep size/date(/mode?) in the desc! + files (cons (archive-zoo--file-desc + ;; FIXME: The `pos' field seems unused! + efnname ifnname fiddle nil (1- p)) files) p next))) (goto-char (point-min)) @@ -1980,6 +2003,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; Section: Rar Archives +(cl-defstruct (archive-rar--file-desc + (:include archive--file-desc) + (:constructor nil) + (:constructor archive-rar--file-desc + (ext-file-name int-file-name case-fiddled mode + size ratio date time))) + size ratio date time) + (defun archive-rar-summarize (&optional file) ;; File is used internally for `archive-rar-exe-summarize'. (unless file (setq file buffer-file-name)) @@ -2005,11 +2036,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (size (match-string 1))) (if (> (length name) maxname) (setq maxname (length name))) (if (> (length size) maxsize) (setq maxsize (length size))) - (push (vector name name nil nil - ;; Size, Ratio. - size (match-string 2) - ;; Date, Time. - (match-string 4) (match-string 5)) + (push (archive-rar--file-desc name name nil nil + ;; Size, Ratio. + size (match-string 2) + ;; Date, Time. + (match-string 4) (match-string 5)) files)))) (setq files (nreverse files)) (goto-char (point-min)) @@ -2019,18 +2050,20 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (column (length sep))) (insert (format format " Date " "Time " "Size" "Ratio" "Filename") "\n") (insert sep (make-string maxname ?-) "\n") - (archive-summarize-files (mapcar (lambda (desc) - (let ((text - (format format - (aref desc 6) - (aref desc 7) - (aref desc 4) - (aref desc 5) - (aref desc 1)))) - (vector text - column - (length text)))) - files)) + (archive-summarize-files + (mapcar (lambda (desc) + (let ((text + (format format + (archive-rar--file-desc-date desc) + (archive-rar--file-desc-time desc) + (archive-rar--file-desc-size desc) + (archive-rar--file-desc-ratio desc) + (archive--file-desc-int-file-name desc)))) + (archive--file-summary + text + column + (length text)))) + files)) (insert sep (make-string maxname ?-) "\n") (apply #'vector files)))) @@ -2078,6 +2111,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; Section: 7z Archives +(cl-defstruct (archive-7z--file-desc + (:include archive--file-desc) + (:constructor nil) + (:constructor archive-7z--file-desc + (ext-file-name int-file-name case-fiddled mode + time user group size))) + time user group size) + (defun archive-7z-summarize () (let ((maxname 10) (maxsize 5) @@ -2100,7 +2141,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (match-string 1))))) (if (> (length name) maxname) (setq maxname (length name))) (if (> (length size) maxsize) (setq maxsize (length size))) - (push (vector name name nil nil time nil nil size) + (push (archive-7z--file-desc name name nil nil time nil nil size) files)))) (setq files (nreverse files)) (goto-char (point-min)) @@ -2109,16 +2150,16 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (column (length sep))) (insert (format format "Size " "Date Time " " Filename") "\n") (insert sep (make-string maxname ?-) "\n") - (archive-summarize-files (mapcar (lambda (desc) - (let ((text - (format format - (aref desc 7) - (aref desc 4) - (aref desc 1)))) - (vector text - column - (length text)))) - files)) + (archive-summarize-files + (mapcar (lambda (desc) + (let ((text + (format format + (archive-7z--file-desc-size desc) + (archive-7z--file-desc-time desc) + (archive--file-desc-int-file-name desc)))) + (archive--file-summary + text column (length text)))) + files)) (insert sep (make-string maxname ?-) "\n") (apply #'vector files)))) @@ -2142,6 +2183,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; not the GNU nor the BSD extensions. As it turns out, this is sufficient ;; for .deb packages. +(cl-defstruct (archive-ar--file-desc + (:include archive--file-desc) + (:constructor nil) + (:constructor archive-ar--file-desc + (ext-file-name int-file-name case-fiddled mode + time user group size))) + time user group size) + (autoload 'tar-grind-file-mode "tar-mode") (defconst archive-ar-file-header-re @@ -2193,8 +2242,8 @@ NAME is expected to be the 16-bytes part of an ar record." (if (> (length group) maxgroup) (setq maxgroup (length group))) (if (> (length mode) maxmode) (setq maxmode (length mode))) (if (> (length size) maxsize) (setq maxsize (length size))) - (push (vector extname extname nil mode - time user group size) + (push (archive-ar--file-desc extname extname nil mode + time user group size) files))) (setq files (nreverse files)) (goto-char (point-min)) @@ -2210,19 +2259,18 @@ NAME is expected to be the 16-bytes part of an ar record." " Date " "Filename") "\n") (insert sep (make-string maxname ?-) "\n") - (archive-summarize-files (mapcar (lambda (desc) - (let ((text - (format format - (aref desc 3) - (aref desc 5) - (aref desc 6) - (aref desc 7) - (aref desc 4) - (aref desc 1)))) - (vector text - column - (length text)))) - files)) + (archive-summarize-files + (mapcar (lambda (desc) + (let ((text + (format format + (archive--file-desc-mode desc) + (archive-ar--file-desc-user desc) + (archive-ar--file-desc-group desc) + (archive-ar--file-desc-size desc) + (archive-ar--file-desc-time desc) + (archive--file-desc-int-file-name desc)))) + (archive--file-summary text column (length text)))) + files)) (insert sep (make-string maxname ?-) "\n") (apply #'vector files)))) @@ -2259,7 +2307,8 @@ NAME is expected to be the 16-bytes part of an ar record." archive (let ((d (copy-sequence descr))) ;; FIXME: Crude conversion from string modes to a number. - (cl-callf (lambda (s) (if (string-match "x" s) ?\555 ?\444)) (aref d 3)) + (cl-callf (lambda (s) (if (string-match "x" s) ?\555 ?\444)) + (archive--file-desc-mode d)) d) '("ar" "r"))) commit 9b995320c853a45d785896fb25f788f9248658f4 Author: Alan Mackenzie Date: Fri Apr 3 20:37:31 2020 +0000 C++ Mode: recognize brace blocks without the hitherto required = sign * lisp/progmodes/cc-engine.el (c-looking-at-or-maybe-in-bracelist): Add code to recognize a literal brace expression following an array declaration for C++. (c-looking-at-inexpr-block): Replace c-symbol-chars with c-symbol-char-key, fixing a coding error. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index bccef6890f..aa3f7d399e 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." (not (c-in-literal)) )))) nil) - (t t)))))) + (t t))))) + ((and + (c-major-mode-is 'c++-mode) + (eq (char-after) ?\[) + ;; Be careful of "operator []" + (not (save-excursion + (c-backward-token-2 1 nil lim) + (looking-at c-opt-op-identifier-prefix)))) + (setq braceassignp t) + nil)) (when (eq braceassignp 'dontknow) (cond ((and (not (eq (char-after) ?,)) @@ -12057,7 +12066,7 @@ comment at the start of cc-engine.el for more info." (c-backward-token-2 1 nil lim) (and (not (and (c-on-identifier) - (looking-at c-symbol-chars))) + (looking-at c-symbol-char-key))) (not (looking-at c-opt-op-identifier-prefix))))))) (cons 'inlambda bracket-pos)) ((and c-recognize-paren-inexpr-blocks commit b318e58d28cc2f88a1d64b604cad9467e3bddfa0 Author: Stefan Monnier Date: Fri Apr 3 13:55:50 2020 -0400 * lisp/arc-mode.el (archive-ar-write-file-member): New function (archive-ar--name): New funtion, extracted from `archive-ar-summarize`. (archive-ar-extract): Use it. (archive-ar-summarize): Use it. Put the extname in the slot 0 of the desc vectors. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 796e2284af..21b9627e40 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -56,7 +56,7 @@ ;; -------------------------------------------------- ;; View listing Intern Intern Intern Intern Y Y Y ;; Extract member Y Y Y Y Y Y Y -;; Save changed member Y Y Y Y N Y N +;; Save changed member Y Y Y Y N Y Y ;; Add new member N N N N N N N ;; Delete member Y Y Y Y N Y N ;; Rename member Y Y N N N N N @@ -101,6 +101,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + ;; ------------------------------------------------------------------------- ;;; Section: Configuration. @@ -2145,6 +2147,17 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (defconst archive-ar-file-header-re "\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n") +(defun archive-ar--name (name) + "Return the external name represented by the entry NAME. +NAME is expected to be the 16-bytes part of an ar record." + (cond ((equal name "// ") + (propertize ".." 'face 'italic)) + ((equal name "/ ") + (propertize ".." 'face 'italic)) + ((string-match "/? *\\'" name) + ;; FIXME: Decode? Add support for longer names? + (substring name 0 (match-beginning 0))))) + (defun archive-ar-summarize () ;; File is used internally for `archive-rar-exe-summarize'. (let* ((maxname 10) @@ -2167,13 +2180,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; Move to the beginning of the data. (goto-char (match-end 0)) (setq time (format-time-string "%Y-%m-%d %H:%M" time)) - (setq extname - (cond ((equal name "// ") - (propertize ".." 'face 'italic)) - ((equal name "/ ") - (propertize ".." 'face 'italic)) - ((string-match "/? *\\'" name) - (substring name 0 (match-beginning 0))))) + (setq extname (archive-ar--name name)) (setq user (substring user 0 (string-match " +\\'" user))) (setq group (substring group 0 (string-match " +\\'" group))) (setq mode (tar-grind-file-mode mode)) @@ -2186,7 +2193,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (if (> (length group) maxgroup) (setq maxgroup (length group))) (if (> (length mode) maxmode) (setq maxmode (length mode))) (if (> (length size) maxsize) (setq maxsize (length size))) - (push (vector name extname nil mode + (push (vector extname extname nil mode time user group size) files))) (setq files (nreverse files)) @@ -2234,7 +2241,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (let ((this (match-string 1))) (setq size (string-to-number (match-string 6))) (goto-char (match-end 0)) - (if (equal name this) + (if (equal name (archive-ar--name this)) (setq from (point)) ;; Move to the end of the data. (forward-char size) (if (eq ?\n (char-after)) (forward-char 1))))) @@ -2247,6 +2254,16 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; Inform the caller that the call succeeded. t)))))) +(defun archive-ar-write-file-member (archive descr) + (archive-*-write-file-member + archive + (let ((d (copy-sequence descr))) + ;; FIXME: Crude conversion from string modes to a number. + (cl-callf (lambda (s) (if (string-match "x" s) ?\555 ?\444)) (aref d 3)) + d) + '("ar" "r"))) + + ;; ------------------------------------------------------------------------- ;; This line was a mistake; it is kept now for compatibility. ;; rms 15 Oct 98 commit 702a97ffb2cae9b739c6739cb6fb7dd18332c3e0 Author: Stefan Monnier Date: Fri Apr 3 13:34:18 2020 -0400 * lisp/arc-mode.el: Remove redundant `:group`s (archive-arc, archive-lzh, archive-zip, archive-zoo): Move them to their corresponding defcustom. (archive-7z): New group, that used to be missing. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index f2dcb72eec..796e2284af 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -108,22 +108,6 @@ "Simple editing of archives." :group 'data) -(defgroup archive-arc nil - "ARC-specific options to archive." - :group 'archive) - -(defgroup archive-lzh nil - "LZH-specific options to archive." - :group 'archive) - -(defgroup archive-zip nil - "ZIP-specific options to archive." - :group 'archive) - -(defgroup archive-zoo nil - "ZOO-specific options to archive." - :group 'archive) - (defcustom archive-tmpdir ;; make-temp-name is safe here because we use this name ;; to create a directory. @@ -131,35 +115,35 @@ (expand-file-name (if (eq system-type 'ms-dos) "ar" "archive.tmp") temporary-file-directory)) "Directory for temporary files made by `arc-mode.el'." - :type 'directory - :group 'archive) + :type 'directory) (defcustom archive-remote-regexp "^/[^/:]*[^/:.]:" "Regexp recognizing archive files names that are not local. A non-local file is one whose file name is not proper outside Emacs. A local copy of the archive will be used when updating." - :type 'regexp - :group 'archive) + :type 'regexp) (define-obsolete-variable-alias 'archive-extract-hooks 'archive-extract-hook "24.3") (defcustom archive-extract-hook nil "Hook run when an archive member has been extracted." - :type 'hook - :group 'archive) + :type 'hook) (defcustom archive-visit-single-files nil "If non-nil, opening an archive with a single file visits that file. If nil, visiting such an archive displays the archive summary." :version "25.1" :type '(choice (const :tag "Visit the single file" t) - (const :tag "Show the archive summary" nil)) - :group 'archive) + (const :tag "Show the archive summary" nil))) ;; ------------------------------ ;; Arc archive configuration ;; We always go via a local file since there seems to be no reliable way ;; to extract to stdout without junk getting added. +(defgroup archive-arc nil + "ARC-specific options to archive." + :group 'archive) + (defcustom archive-arc-extract '("arc" "x") "Program and its options to run in order to extract an arc file member. @@ -168,8 +152,7 @@ name will be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-arc) + (string :format "%v")))) (defcustom archive-arc-expunge '("arc" "d") @@ -178,8 +161,7 @@ Archive and member names will be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-arc) + (string :format "%v")))) (defcustom archive-arc-write-file-member '("arc" "u") @@ -188,11 +170,14 @@ Archive and member name will be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-arc) + (string :format "%v")))) ;; ------------------------------ ;; Lzh archive configuration +(defgroup archive-lzh nil + "LZH-specific options to archive." + :group 'archive) + (defcustom archive-lzh-extract '("lha" "pq") "Program and its options to run in order to extract an lzh file member. @@ -201,8 +186,7 @@ be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-lzh) + (string :format "%v")))) (defcustom archive-lzh-expunge '("lha" "d") @@ -211,8 +195,7 @@ Archive and member names will be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-lzh) + (string :format "%v")))) (defcustom archive-lzh-write-file-member '("lha" "a") @@ -221,8 +204,7 @@ Archive and member name will be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-lzh) + (string :format "%v")))) ;; ------------------------------ ;; Zip archive configuration @@ -231,6 +213,10 @@ Archive and member name will be added." (when 7z (file-name-nondirectory 7z)))) +(defgroup archive-zip nil + "ZIP-specific options to archive." + :group 'archive) + (defcustom archive-zip-extract (cond ((executable-find "unzip") '("unzip" "-qq" "-c")) (archive-7z-program `(,archive-7z-program "x" "-so")) @@ -242,8 +228,7 @@ be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-zip) + (string :format "%v")))) ;; For several reasons the latter behavior is not desirable in general. ;; (1) It uses more disk space. (2) Error checking is worse or non- @@ -260,8 +245,7 @@ Archive and member names will be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-zip) + (string :format "%v")))) (defcustom archive-zip-update (cond ((executable-find "zip") '("zip" "-q")) @@ -274,8 +258,7 @@ file. Archive and member name will be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-zip) + (string :format "%v")))) (defcustom archive-zip-update-case (cond ((executable-find "zip") '("zip" "-q" "-k")) @@ -288,8 +271,7 @@ Archive and member name will be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-zip) + (string :format "%v")))) (declare-function msdos-long-file-names "msdos.c") (defcustom archive-zip-case-fiddle (and (eq system-type 'ms-dos) @@ -300,11 +282,14 @@ that uses caseless file names. In addition, this flag forces members added/updated in the zip archive to be truncated to DOS 8+3 file-name restrictions." :type 'boolean - :version "27.1" - :group 'archive-zip) + :version "27.1") ;; ------------------------------ ;; Zoo archive configuration +(defgroup archive-zoo nil + "ZOO-specific options to archive." + :group 'archive) + (defcustom archive-zoo-extract '("zoo" "xpq") "Program and its options to run in order to extract a zoo file member. @@ -313,8 +298,7 @@ be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-zoo) + (string :format "%v")))) (defcustom archive-zoo-expunge '("zoo" "DqPP") @@ -323,8 +307,7 @@ Archive and member names will be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-zoo) + (string :format "%v")))) (defcustom archive-zoo-write-file-member '("zoo" "a") @@ -333,11 +316,14 @@ Archive and member name will be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-zoo) + (string :format "%v")))) ;; ------------------------------ ;; 7z archive configuration +(defgroup archive-7z nil + "7Z-specific options to archive." + :group 'archive) + (defcustom archive-7z-extract `(,(or archive-7z-program "7z") "x" "-so") "Program and its options to run in order to extract a 7z file member. @@ -347,8 +333,7 @@ be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-7z) + (string :format "%v")))) (defcustom archive-7z-expunge `(,(or archive-7z-program "7z") "d") @@ -358,8 +343,7 @@ Archive and member names will be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-7z) + (string :format "%v")))) (defcustom archive-7z-update `(,(or archive-7z-program "7z") "u") @@ -370,8 +354,7 @@ file. Archive and member name will be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t - (string :format "%v"))) - :group 'archive-7z) + (string :format "%v")))) ;; ------------------------------------------------------------------------- ;;; Section: Variables commit 9b6d252a1806c4b73e43eaaecde3d7cdc38c4b1d Author: Stefan Monnier Date: Fri Apr 3 13:28:31 2020 -0400 * lisp/arc-mode.el: Use lexical-binding (arc-insert-unibyte): Simplify. (archive--mode-revert): Rename from `archive-mode-revert` and adjust for use as an :around advice. (archive-mode): Use setq-local. Use `add-function` to hook into `revert-buffer-function`. (archive-summarize): Don't use `set` on a hook. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 677483e49f..f2dcb72eec 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1,4 +1,4 @@ -;;; arc-mode.el --- simple editing of archives +;;; arc-mode.el --- simple editing of archives -*- lexical-binding: t; -*- ;; Copyright (C) 1995, 1997-1998, 2001-2020 Free Software Foundation, ;; Inc. @@ -52,17 +52,17 @@ ;; ARCHIVE TYPES: Currently only the archives below are handled, but the ;; structure for handling just about anything is in place. ;; -;; Arc Lzh Zip Zoo Rar 7z -;; -------------------------------------------- -;; View listing Intern Intern Intern Intern Y Y -;; Extract member Y Y Y Y Y Y -;; Save changed member Y Y Y Y N Y -;; Add new member N N N N N N -;; Delete member Y Y Y Y N Y -;; Rename member Y Y N N N N -;; Chmod - Y Y - N N -;; Chown - Y - - N N -;; Chgrp - Y - - N N +;; Arc Lzh Zip Zoo Rar 7z Ar +;; -------------------------------------------------- +;; View listing Intern Intern Intern Intern Y Y Y +;; Extract member Y Y Y Y Y Y Y +;; Save changed member Y Y Y Y N Y N +;; Add new member N N N N N N N +;; Delete member Y Y Y Y N Y N +;; Rename member Y Y N N N N N +;; Chmod - Y Y - N N N +;; Chown - Y - - N N N +;; Chgrp - Y - - N N N ;; ;; Special thanks to Bill Brodie for very useful tips ;; on the first released version of this package. @@ -520,9 +520,9 @@ Each descriptor is a vector of the form (defun arc-insert-unibyte (&rest args) "Like insert but don't make unibyte string and eight-bit char multibyte." (dolist (elt args) - (if (integerp elt) - (insert (if (< elt 128) elt (decode-char 'eight-bit elt))) - (insert elt)))) + (insert (if (and (integerp elt) (>= elt 128)) + (decode-char 'eight-bit elt) + elt)))) (defsubst archive-name (suffix) (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix))) @@ -622,7 +622,8 @@ the mode is invalid. If ERROR is nil then nil will be returned." (format "%2d-%s-%d" day (aref ["Jan" "Feb" "Mar" "Apr" "May" "Jun" - "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] (1- month)) + "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] + (1- month)) year)))) (defun archive-dostime (time) @@ -684,38 +685,33 @@ archive. ;; mode on and off. You can corrupt things that way. (if (zerop (buffer-size)) ;; At present we cannot create archives from scratch - (funcall (or (default-value 'major-mode) 'fundamental-mode)) + (funcall (or (default-value 'major-mode) #'fundamental-mode)) (if (and (not force) archive-files) nil (kill-all-local-variables) (let* ((type (archive-find-type)) (typename (capitalize (symbol-name type)))) - (make-local-variable 'archive-subtype) - (setq archive-subtype type) + (setq-local archive-subtype type) ;; Buffer contains treated image of file before the file contents - (make-local-variable 'revert-buffer-function) - (setq revert-buffer-function 'archive-mode-revert) - (auto-save-mode 0) + (add-function :around (local 'revert-buffer-function) + #'archive--mode-revert) - (add-hook 'write-contents-functions 'archive-write-file nil t) + (add-hook 'write-contents-functions #'archive-write-file nil t) - (make-local-variable 'require-final-newline) - (setq require-final-newline nil) - (make-local-variable 'local-enable-local-variables) - (setq local-enable-local-variables nil) + (setq-local truncate-lines t) + (setq-local require-final-newline nil) + (setq-local local-enable-local-variables nil) ;; Prevent loss of data when saving the file. - (make-local-variable 'file-precious-flag) - (setq file-precious-flag t) + (setq-local file-precious-flag t) - (make-local-variable 'archive-read-only) ;; Archives which are inside other archives and whose ;; names are invalid for this OS, can't be written. - (setq archive-read-only - (or (not (file-writable-p (buffer-file-name))) - (and archive-subfile-mode - (string-match file-name-invalid-regexp - (aref archive-subfile-mode 0))))) + (setq-local archive-read-only + (or (not (file-writable-p (buffer-file-name))) + (and archive-subfile-mode + (string-match file-name-invalid-regexp + (aref archive-subfile-mode 0))))) ;; Should we use a local copy when accessing from outside Emacs? (make-local-variable 'archive-local-name) @@ -728,7 +724,7 @@ archive. (string-match file-name-invalid-regexp (buffer-file-name))))) - (setq major-mode 'archive-mode) + (setq major-mode #'archive-mode) (setq mode-name (concat typename "-Archive")) ;; Run archive-foo-mode-hook and archive-mode-hook (run-mode-hooks (archive-name "mode-hook") 'archive-mode-hook) @@ -803,7 +799,7 @@ when parsing the archive." (let ((create-lockfiles nil) ; avoid changing dir mtime by lock_file (inhibit-read-only t)) (setq archive-proper-file-start (copy-marker (point-min) t)) - (set (make-local-variable 'change-major-mode-hook) 'archive-desummarize) + (add-hook 'change-major-mode-hook #'archive-desummarize nil t) (or shut-up (message "Parsing archive file...")) (buffer-disable-undo (current-buffer)) @@ -968,7 +964,7 @@ using `make-temp-file', and the generated name is returned." (delete-file tmpfile))))) (defun archive-file-name-handler (op &rest args) - (or (eq op 'file-exists-p) + (or (eq op #'file-exists-p) (let ((file-name-handler-alist nil)) (apply op args)))) @@ -1461,12 +1457,11 @@ as a relative change like \"g+rw\" as for chmod(2)." (error "Renaming is not supported for this archive type")))) ;; Revert the buffer and recompute the dired-like listing. -(defun archive-mode-revert (&optional _no-auto-save _no-confirm) +(defun archive--mode-revert (orig-fun &rest args) (let ((no (archive-get-lineno))) (setq archive-files nil) - (let ((revert-buffer-function nil) - (coding-system-for-read 'no-conversion)) - (revert-buffer t t)) + (let ((coding-system-for-read 'no-conversion)) + (apply orig-fun t t (cddr args))) (archive-mode) (goto-char archive-file-list-start) (archive-next-line no))) commit 00f7744c1b0f3e6aa59634a28ab671b2203e3900 Author: Robert Pluim Date: Fri Apr 3 14:56:08 2020 +0200 Check for IPv6 servers in dns.el * lisp/net/dns.el (dns-set-servers): Set dns-servers to nil when we don't find any DNS servers with nslookup. Add support for IPv6 servers. (Bug#40248). (dns-make-network-process): Check for datagram process support before creating a datagram process. (dns-query): Return nil if dns-servers is nil. diff --git a/lisp/net/dns.el b/lisp/net/dns.el index 78d4827162..177df4e332 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -315,8 +315,8 @@ If TCP-P, the first two bytes of the package with be the length field." (defun dns-set-servers () "Set `dns-servers' to a list of DNS servers or nil if none are found. Parses \"/etc/resolv.conf\" or calls \"nslookup\"." + (setq dns-servers nil) (or (when (file-exists-p "/etc/resolv.conf") - (setq dns-servers nil) (with-temp-buffer (insert-file-contents "/etc/resolv.conf") (goto-char (point-min)) @@ -327,9 +327,9 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." (with-temp-buffer (call-process "nslookup" nil t nil "localhost") (goto-char (point-min)) - (re-search-forward - "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) - (setq dns-servers (list (match-string 1)))))) + (when (re-search-forward + "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\|[[:xdigit:]:]*\\)" nil t) + (setq dns-servers (list (match-string 1))))))) (when (fboundp 'network-interface-list) (setq dns-servers-valid-for-interfaces (network-interface-list)))) @@ -357,7 +357,9 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." `(let ((server ,server) (coding-system-for-read 'binary) (coding-system-for-write 'binary)) - (if (fboundp 'make-network-process) + (if (and + (fboundp 'make-network-process) + (featurep 'make-network-process '(:type datagram))) (make-network-process :name "dns" :coding 'binary @@ -365,9 +367,9 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." :host server :service "domain" :type 'datagram) - ;; Older versions of Emacs doesn't have - ;; `make-network-process', so we fall back on opening a TCP - ;; connection to the DNS server. + ;; Older versions of Emacs do not have `make-network-process', + ;; and on MS-Windows datagram sockets are not supported, so we + ;; fall back on opening a TCP connection to the DNS server. (open-network-stream "dns" (current-buffer) server "domain")))) (defvar dns-cache (make-vector 4096 0)) @@ -400,7 +402,9 @@ If REVERSEP, look up an IP address." type 'PTR)) (if (not dns-servers) - (message "No DNS server configuration found") + (progn + (message "No DNS server configuration found") + nil) (with-temp-buffer (set-buffer-multibyte nil) (let ((process (condition-case () commit d08e81ce5a19a0394c2efbdfeb4ebb246d609635 Author: Robert Pluim Date: Thu Apr 2 17:52:01 2020 +0200 Make make-{network,serial}-process handle :coding nil consistently The handling of :coding nil was different between make-{network,serial}-process and make-{pipe}process. Now they all handle :coding nil as if :coding had not been specified. * process.c (Fmake_serial_process) (set_network_socket_coding_system): Use plist-get to check if :coding has been specified instead of plist-member, to ensure that ":coding nil" does not override coding-system-for-{read,write}. * network-stream-tests.el (check-network-process-coding-system-bind) (check-network-process-coding-system-no-override) (check-network-process-coding-system-override): New tests. * etc/NEWS: Describe change in make-network-process and make-serial-process :coding behavior. diff --git a/etc/NEWS b/etc/NEWS index 91729e4aae..fa33364054 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -317,6 +317,16 @@ optional argument specifying whether to follow symbolic links. ** 'parse-time-string' can now parse ISO 8601 format strings, such as "2020-01-15T16:12:21-08:00". +--- +** 'make-network-process', 'make-serial-process' :coding behavior change. +Previously, passing ":coding nil" to either of these functions would +override any non-nil binding for 'coding-system-for-read' and +'coding-system-for-write'. For consistency with 'make-process' and +'make-pipe-process', passing ":coding nil" is now ignored. No code in +Emacs depended on the previous behavior; if you really want the +process' coding-system to be nil, use 'set-process-coding-system' +after the process has been created, or pass in ":coding '(nil nil)". + * Changes in Emacs 28.1 on Non-Free Operating Systems diff --git a/src/process.c b/src/process.c index 07881d6c5d..e6d18fbaad 100644 --- a/src/process.c +++ b/src/process.c @@ -3188,14 +3188,12 @@ usage: (make-serial-process &rest ARGS) */) BUF_ZV_BYTE (XBUFFER (buffer))); } - tem = Fplist_member (contact, QCcoding); - if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem)))) - tem = Qnil; + tem = Fplist_get (contact, QCcoding); val = Qnil; if (!NILP (tem)) { - val = XCAR (XCDR (tem)); + val = tem; if (CONSP (val)) val = XCAR (val); } @@ -3209,7 +3207,7 @@ usage: (make-serial-process &rest ARGS) */) val = Qnil; if (!NILP (tem)) { - val = XCAR (XCDR (tem)); + val = tem; if (CONSP (val)) val = XCDR (val); } @@ -3244,16 +3242,14 @@ set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host, Lisp_Object coding_systems = Qt; Lisp_Object val; - tem = Fplist_member (contact, QCcoding); - if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem)))) - tem = Qnil; /* No error message (too late!). */ + tem = Fplist_get (contact, QCcoding); /* Setup coding systems for communicating with the network stream. */ /* Qt denotes we have not yet called Ffind_operation_coding_system. */ if (!NILP (tem)) { - val = XCAR (XCDR (tem)); + val = tem; if (CONSP (val)) val = XCAR (val); } @@ -3287,7 +3283,7 @@ set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host, if (!NILP (tem)) { - val = XCAR (XCDR (tem)); + val = tem; if (CONSP (val)) val = XCDR (val); } diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index 28686547a4..7a982548ae 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el @@ -724,4 +724,56 @@ 44777 (vector :nowait t)))) +(ert-deftest check-network-process-coding-system-bind () + "Check that binding coding-system-for-{read,write} works." + (let* ((coding-system-for-read 'binary) + (coding-system-for-write 'utf-8-unix) + (server + (make-network-process + :name "server" + :server t + :noquery t + :family 'ipv4 + :service t + :host 'local)) + (coding (process-coding-system server))) + (should (eq (car coding) 'binary)) + (should (eq (cdr coding) 'utf-8-unix)) + (delete-process server))) + +(ert-deftest check-network-process-coding-system-no-override () + "Check that coding-system-for-{read,write} is not overridden by :coding nil." + (let* ((coding-system-for-read 'binary) + (coding-system-for-write 'utf-8-unix) + (server + (make-network-process + :name "server" + :server t + :noquery t + :family 'ipv4 + :service t + :coding nil + :host 'local)) + (coding (process-coding-system server))) + (should (eq (car coding) 'binary)) + (should (eq (cdr coding) 'utf-8-unix)) + (delete-process server))) + +(ert-deftest check-network-process-coding-system-override () + "Check that :coding non-nil overrides coding-system-for-{read,write}." + (let* ((coding-system-for-read 'binary) + (coding-system-for-write 'utf-8-unix) + (server + (make-network-process + :name "server" + :server t + :noquery t + :family 'ipv4 + :service t + :coding 'georgian-academy + :host 'local)) + (coding (process-coding-system server))) + (should (eq (car coding) 'georgian-academy)) + (should (eq (cdr coding) 'georgian-academy)) + (delete-process server))) ;;; network-stream-tests.el ends here commit 463f635171683ae3b6907f156305f12fc58ca68e Author: Ernest N. Mamikonyan Date: Fri Mar 13 10:37:17 2020 -0400 Update texinfo.el following changes in 'tex-start-options-string' * lisp/textmodes/texinfo.el (texinfo-texi2dvi-options): New defcustom. (texinfo-tex-buffer): Take 'tex-start-options' from 'texinfo-texi2dvi-options'. (Bug#40001) * etc/NEWS: Mention the new option. Copyright-paperwork-exempt: yes diff --git a/etc/NEWS b/etc/NEWS index 7588b418a4..91729e4aae 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -241,6 +241,12 @@ case-insensitive matching of messages when the old behaviour is required, but the recommended solution is to use a correctly matching regexp instead. +** Texinfo + +--- +*** New customizable option 'texinfo-texi2dvi-options'. +This is used when invoking 'texi2dvi' from 'texinfo-tex-buffer'. + * New Modes and Packages in Emacs 28.1 diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 438cb7798a..66378cb346 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -958,6 +958,12 @@ to jump to the corresponding spot in the Texinfo source file." :type 'string :group 'texinfo) +(defcustom texinfo-texi2dvi-options "" + "Command line options for `texinfo-texi2dvi-command'." + :type 'string + :group 'texinfo + :version "28.1") + (defcustom texinfo-tex-command "tex" "Command used by `texinfo-tex-region' to run TeX on a region." :type 'string @@ -1002,9 +1008,10 @@ The value of `texinfo-tex-trailer' is appended to the temporary file after the r (interactive) (require 'tex-mode) (let ((tex-command texinfo-texi2dvi-command) - ;; Disable tex-start-options-string. texi2dvi would not - ;; understand anything specified here. - (tex-start-options-string "")) + (tex-start-options texinfo-texi2dvi-options) + ;; Disable tex-start-commands. texi2dvi would not understand + ;; anything specified here. + (tex-start-commands "")) (tex-buffer))) (defun texinfo-texindex () commit 2c4509179110459f42119ce328d72fea65689288 Author: Štěpán Němec Date: Sat Mar 28 22:16:28 2020 +0100 load-library, locate-library: Use read-library-name * lisp/emacs-lisp/find-func.el (read-library-name): Add autoload cookie. * lisp/files.el (load-library) * lisp/subr.el (locate-library): Use 'read-library-name' when called interactively. (bug#6652 bug#6679) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 167ead3ce0..e35db56550 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -279,6 +279,7 @@ Interactively, prompt for LIBRARY using the one at or near point." (switch-to-buffer (find-file-noselect (find-library-name library))) (run-hooks 'find-function-after-hook))) +;;;###autoload (defun read-library-name () "Read and return a library name, defaulting to the one near point. diff --git a/lisp/files.el b/lisp/files.el index 55a0958f54..beafdaca99 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1103,12 +1103,7 @@ well as `load-file-rep-suffixes'). See Info node `(emacs)Lisp Libraries' for more details. See `load-file' for a different interface to `load'." - (interactive - (let (completion-ignored-extensions) - (list (completing-read "Load library: " - (apply-partially 'locate-file-completion-table - load-path - (get-load-suffixes)))))) + (interactive (list (read-library-name))) (load library)) (defun file-remote-p (file &optional identification connected) diff --git a/lisp/subr.el b/lisp/subr.el index 70f33ee5bd..70a74fba66 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2301,12 +2301,7 @@ is used instead of `load-path'. When called from a program, the file name is normally returned as a string. When run interactively, the argument INTERACTIVE-CALL is t, and the file name is displayed in the echo area." - (interactive (list (completing-read "Locate library: " - (apply-partially - 'locate-file-completion-table - load-path (get-load-suffixes))) - nil nil - t)) + (interactive (list (read-library-name) nil nil t)) (let ((file (locate-file library (or path load-path) (append (unless nosuffix (get-load-suffixes)) commit 1ded4a8b932eb377f5882e7b99ab7365dce43445 Author: Asher Gordon Date: Sat Mar 28 14:32:25 2020 -0400 Fix movement commands in gomoku * lisp/play/gomoku.el (gomoku-mode-map): Bind cursor motion keys to gomoku-specific commands. (gomoku-point-x, gomoku-move-right, gomoku-move-left): New commands. (gomoku--intangible, gomoku-move-ne, gomoku-move-se) (gomoku-move-nw, gomoku-move-sw): Call gomoku-move-left and gomoku-move-right instead of forward-char and backward-char. (Bug#40169) * etc/NEWS: Call out the changes. diff --git a/etc/NEWS b/etc/NEWS index 7e578f89db..7588b418a4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -93,6 +93,11 @@ line numbers that were previously jumped to. ** When 'suggest-key-bindings' is non-nil, the completion list of 'M-x' shows equivalent key bindings for all commands that have them. +--- +** Movement commands in 'gomoku-mode' are fixed. +'gomoku-move-sw' and 'gomoku-move-ne' now work correctly, and +horizontal movements now stop at the edge of the board. + * Changes in Specialized Modes and Packages in Emacs 28.1 diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el index 6e0061d461..403398672b 100644 --- a/lisp/play/gomoku.el +++ b/lisp/play/gomoku.el @@ -110,8 +110,8 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces." (define-key map "u" 'gomoku-move-ne) ; u (define-key map "b" 'gomoku-move-sw) ; b (define-key map "n" 'gomoku-move-se) ; n - (define-key map "h" 'backward-char) ; h - (define-key map "l" 'forward-char) ; l + (define-key map "h" 'gomoku-move-left) ; h + (define-key map "l" 'gomoku-move-right) ; l (define-key map "j" 'gomoku-move-down) ; j (define-key map "k" 'gomoku-move-up) ; k @@ -119,11 +119,13 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces." (define-key map [kp-9] 'gomoku-move-ne) (define-key map [kp-1] 'gomoku-move-sw) (define-key map [kp-3] 'gomoku-move-se) - (define-key map [kp-4] 'backward-char) - (define-key map [kp-6] 'forward-char) + (define-key map [kp-4] 'gomoku-move-left) + (define-key map [kp-6] 'gomoku-move-right) (define-key map [kp-2] 'gomoku-move-down) (define-key map [kp-8] 'gomoku-move-up) + (define-key map "\C-b" 'gomoku-move-left) ; C-b + (define-key map "\C-f" 'gomoku-move-right) ; C-f (define-key map "\C-n" 'gomoku-move-down) ; C-n (define-key map "\C-p" 'gomoku-move-up) ; C-p @@ -146,6 +148,10 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces." (define-key map [mouse-2] 'gomoku-mouse-play) (define-key map [drag-mouse-2] 'gomoku-mouse-play) + (define-key map [remap backward-char] 'gomoku-move-left) + (define-key map [remap left-char] 'gomoku-move-left) + (define-key map [remap forward-char] 'gomoku-move-right) + (define-key map [remap right-char] 'gomoku-move-right) (define-key map [remap previous-line] 'gomoku-move-up) (define-key map [remap next-line] 'gomoku-move-down) (define-key map [remap move-beginning-of-line] 'gomoku-beginning-of-line) @@ -954,6 +960,11 @@ If the game is finished, this command requests for another game." ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line ! gomoku-square-height))) +(defun gomoku-point-x () + "Return the board column where point is." + (1+ (/ (- (current-column) gomoku-x-offset) + gomoku-square-width))) + (defun gomoku-point-y () "Return the board row where point is." (1+ (/ (- (count-lines (point-min) (point)) @@ -1143,13 +1154,28 @@ If the game is finished, this command requests for another game." (skip-chars-forward gomoku--intangible-chars) (when (eobp) (skip-chars-backward gomoku--intangible-chars) - (forward-char -1))) + (gomoku-move-left))) (skip-chars-backward gomoku--intangible-chars) (if (bobp) (skip-chars-forward gomoku--intangible-chars) - (forward-char -1)))) + (gomoku-move-left)))) (setq gomoku--last-pos (point))) +;; forward-char and backward-char don't always move the right number +;; of characters. Also, these functions check if you're on the edge of +;; the screen. +(defun gomoku-move-right () + "Move point right one column on the Gomoku board." + (interactive) + (when (< (gomoku-point-x) gomoku-board-width) + (forward-char gomoku-square-width))) + +(defun gomoku-move-left () + "Move point left one column on the Gomoku board." + (interactive) + (when (> (gomoku-point-x) 1) + (backward-char gomoku-square-width))) + ;; previous-line and next-line don't work right with intangible newlines (defun gomoku-move-down () "Move point down one row on the Gomoku board." @@ -1171,25 +1197,25 @@ If the game is finished, this command requests for another game." "Move point North East on the Gomoku board." (interactive) (gomoku-move-up) - (forward-char)) + (gomoku-move-right)) (defun gomoku-move-se () "Move point South East on the Gomoku board." (interactive) (gomoku-move-down) - (forward-char)) + (gomoku-move-right)) (defun gomoku-move-nw () "Move point North West on the Gomoku board." (interactive) (gomoku-move-up) - (backward-char)) + (gomoku-move-left)) (defun gomoku-move-sw () "Move point South West on the Gomoku board." (interactive) (gomoku-move-down) - (backward-char)) + (gomoku-move-left)) (defun gomoku-beginning-of-line () "Move point to first square on the Gomoku board row." commit d8dae04e5ae5cc4897c8d1af8548a0c1576137b6 Author: Eli Zaretskii Date: Fri Apr 3 14:21:07 2020 +0300 Improve last change * lisp/calendar/time-date.el (date-days-in-month): Improve the error message text and make sure MONTH is a number. (Bug#40217) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 9b58a4884b..eeb09926a6 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -355,8 +355,8 @@ is output until the first non-zero unit is encountered." (defun date-days-in-month (year month) "The number of days in MONTH in YEAR." - (unless (<= 1 month 12) - (error "Month %s invalid" month)) + (unless (and (numberp month) (<= 1 month 12)) + (error "Month %s is invalid" month)) (if (= month 2) (if (date-leap-year-p year) 29 diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el index 9c90300cfe..3eecc67eb5 100644 --- a/test/lisp/calendar/time-date-tests.el +++ b/test/lisp/calendar/time-date-tests.el @@ -32,7 +32,8 @@ (should (= (date-days-in-month 2004 2) 29)) (should (= (date-days-in-month 2004 3) 31)) (should-not (= (date-days-in-month 1900 3) 28)) - (should-error (date-days-in-month 2020 15))) + (should-error (date-days-in-month 2020 15)) + (should-error (date-days-in-month 2020 'foo))) (ert-deftest test-ordinal () (should (equal (date-ordinal-to-time 2008 271) commit f134dfa041b30a8c28484a13c2fa08f2fee27ff5 Author: Alex Branham Date: Tue Mar 24 19:34:14 2020 -0400 Error out if 'date-days-in-month' is given an invalid month * lisp/calendar/time-date.el (date-days-in-month): Add test for month validity; signal an error if it isn't. (Bug#40217) * test/lisp/calendar/time-date-tests.el (test-days-in-month): Add a test for the new error. diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index e2402de801..9b58a4884b 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -355,6 +355,8 @@ is output until the first non-zero unit is encountered." (defun date-days-in-month (year month) "The number of days in MONTH in YEAR." + (unless (<= 1 month 12) + (error "Month %s invalid" month)) (if (= month 2) (if (date-leap-year-p year) 29 diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el index 4c8f18a7a9..9c90300cfe 100644 --- a/test/lisp/calendar/time-date-tests.el +++ b/test/lisp/calendar/time-date-tests.el @@ -31,7 +31,8 @@ (ert-deftest test-days-in-month () (should (= (date-days-in-month 2004 2) 29)) (should (= (date-days-in-month 2004 3) 31)) - (should-not (= (date-days-in-month 1900 3) 28))) + (should-not (= (date-days-in-month 1900 3) 28)) + (should-error (date-days-in-month 2020 15))) (ert-deftest test-ordinal () (should (equal (date-ordinal-to-time 2008 271)