mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-22 07:09:54 +00:00
Don’t attempt to modify constant conses
From a patch privately suggested by Mattias Engdegård on 2020-05-11 in a followup to Bug#40671. * admin/charsets/cp51932.awk: * admin/charsets/eucjp-ms.awk: Generate code that does not modify constant conses. * doc/misc/emacs-mime.texi (Encoding Customization): * lisp/emacs-lisp/byte-opt.el (byte-compile-side-effect-free-ops): * lisp/frameset.el (frameset-persistent-filter-alist): * lisp/gnus/gnus-sum.el (gnus-article-mode-line-format-alist): Use append instead of nconc. * lisp/language/japanese.el (japanese-ucs-cp932-to-jis-map) (jisx0213-to-unicode): Use mapcar instead of mapc. * lisp/language/lao-util.el (lao-transcription-consonant-alist) (lao-transcription-vowel-alist): * lisp/language/tibetan.el (tibetan-subjoined-transcription-alist): Use copy-sequence. * test/src/fns-tests.el (fns-tests-nreverse): (fns-tests-sort, fns-tests-collate-sort) (fns-tests-string-version-lessp, fns-tests-mapcan): Use copy-sequence, vector, and list.
This commit is contained in:
parent
a6ebca21b3
commit
c7bc28bf03
@ -43,13 +43,14 @@ BEGIN {
|
||||
|
||||
END {
|
||||
print ")))";
|
||||
print " (mapc #'(lambda (x)";
|
||||
print " (setcar x (decode-char 'japanese-jisx0208 (car x))))";
|
||||
print " map)";
|
||||
print " (setq map (mapcar (lambda (x)";
|
||||
print " (cons (decode-char 'japanese-jisx0208 (car x))";
|
||||
print " (cdr x)))";
|
||||
print " map))";
|
||||
print " (define-translation-table 'cp51932-decode map)";
|
||||
print " (mapc #'(lambda (x)";
|
||||
print " (let ((tmp (car x)))";
|
||||
print " (setcar x (cdr x)) (setcdr x tmp)))";
|
||||
print " (mapc (lambda (x)";
|
||||
print " (let ((tmp (car x)))";
|
||||
print " (setcar x (cdr x)) (setcdr x tmp)))";
|
||||
print " map)";
|
||||
print " (define-translation-table 'cp51932-encode map))";
|
||||
print "";
|
||||
|
@ -93,15 +93,17 @@ function write_entry (unicode) {
|
||||
|
||||
END {
|
||||
print ")))";
|
||||
print " (mapc #'(lambda (x)";
|
||||
print " (setq map";
|
||||
print " (mapcar";
|
||||
print " (lambda (x)";
|
||||
print " (let ((code (logand (car x) #x7F7F)))";
|
||||
print " (if (integerp (cdr x))";
|
||||
print " (setcar x (decode-char 'japanese-jisx0208 code))";
|
||||
print " (setcar x (decode-char 'japanese-jisx0212 code))";
|
||||
print " (setcdr x (cadr x)))))";
|
||||
print " map)";
|
||||
print " (cons (decode-char 'japanese-jisx0208 code) (cdr x))";
|
||||
print " (cons (decode-char 'japanese-jisx0212 code)"
|
||||
print " (cadr x)))))";
|
||||
print " map))";
|
||||
print " (define-translation-table 'eucjp-ms-decode map)";
|
||||
print " (mapc #'(lambda (x)";
|
||||
print " (mapc (lambda (x)";
|
||||
print " (let ((tmp (car x)))";
|
||||
print " (setcar x (cdr x)) (setcdr x tmp)))";
|
||||
print " map)";
|
||||
|
@ -917,7 +917,7 @@ Here's an example:
|
||||
@lisp
|
||||
(add-to-list 'gnus-newsgroup-variables 'mm-coding-system-priorities)
|
||||
(setq gnus-parameters
|
||||
(nconc
|
||||
(append
|
||||
;; Some charsets are just examples!
|
||||
'(("^cn\\." ;; Chinese
|
||||
(mm-coding-system-priorities
|
||||
|
@ -1509,7 +1509,7 @@
|
||||
byte-current-buffer byte-stack-ref))
|
||||
|
||||
(defconst byte-compile-side-effect-free-ops
|
||||
(nconc
|
||||
(append
|
||||
'(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
|
||||
byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
|
||||
byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
|
||||
|
@ -396,17 +396,17 @@ Properties can be set with
|
||||
;; or, if you're only changing a few items,
|
||||
;;
|
||||
;; (defvar my-filter-alist
|
||||
;; (nconc '((my-param1 . :never)
|
||||
;; (my-param2 . my-filtering-function))
|
||||
;; frameset-filter-alist)
|
||||
;; (append '((my-param1 . :never)
|
||||
;; (my-param2 . my-filtering-function))
|
||||
;; frameset-filter-alist)
|
||||
;; "My brief customized parameter filter alist.")
|
||||
;;
|
||||
;; and pass it to the FILTER arg of the save/restore functions,
|
||||
;; ALWAYS taking care of not modifying the original lists; if you're
|
||||
;; going to do any modifying of my-filter-alist, please use
|
||||
;;
|
||||
;; (nconc '((my-param1 . :never) ...)
|
||||
;; (copy-sequence frameset-filter-alist))
|
||||
;; (append '((my-param1 . :never) ...)
|
||||
;; (copy-sequence frameset-filter-alist))
|
||||
;;
|
||||
;; One thing you shouldn't forget is that they are alists, so searching
|
||||
;; in them is sequential. If you just want to change the default of
|
||||
@ -445,7 +445,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar frameset-persistent-filter-alist
|
||||
(nconc
|
||||
(append
|
||||
'((background-color . frameset-filter-sanitize-color)
|
||||
(buffer-list . :never)
|
||||
(buffer-predicate . :never)
|
||||
|
@ -1501,9 +1501,9 @@ the type of the variable (string, integer, character, etc).")
|
||||
|
||||
;; This is here rather than in gnus-art for compilation reasons.
|
||||
(defvar gnus-article-mode-line-format-alist
|
||||
(nconc '((?w (gnus-article-wash-status) ?s)
|
||||
(?m (gnus-article-mime-part-status) ?s))
|
||||
gnus-summary-mode-line-format-alist))
|
||||
(append '((?w (gnus-article-wash-status) ?s)
|
||||
(?m (gnus-article-mime-part-status) ?s))
|
||||
gnus-summary-mode-line-format-alist))
|
||||
|
||||
(defvar gnus-last-search-regexp nil
|
||||
"Default regexp for article search command.")
|
||||
|
@ -82,9 +82,7 @@
|
||||
(#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE
|
||||
)))
|
||||
(define-translation-table 'japanese-ucs-jis-to-cp932-map map)
|
||||
(mapc #'(lambda (x) (let ((tmp (car x)))
|
||||
(setcar x (cdr x)) (setcdr x tmp)))
|
||||
map)
|
||||
(setq map (mapcar (lambda (x) (cons (cdr x) (car x))) map))
|
||||
(define-translation-table 'japanese-ucs-cp932-to-jis-map map))
|
||||
|
||||
;; U+2014 (EM DASH) vs U+2015 (HORIZONTAL BAR)
|
||||
@ -241,8 +239,10 @@ eucJP-ms is defined in <http://www.opengroup.or.jp/jvc/cde/appendix.html>."
|
||||
(#x2b65 . [#x02E9 #x02E5])
|
||||
(#x2b66 . [#x02E5 #x02E9])))
|
||||
table)
|
||||
(dolist (elt map)
|
||||
(setcar elt (decode-char 'japanese-jisx0213-1 (car elt))))
|
||||
(setq map
|
||||
(mapcar (lambda (x) (cons (decode-char 'japanese-jisx0213-1 (car x))
|
||||
(cdr x)))
|
||||
map))
|
||||
(setq table (make-translation-table-from-alist map))
|
||||
(define-translation-table 'jisx0213-to-unicode table)
|
||||
(define-translation-table 'unicode-to-jisx0213
|
||||
|
@ -183,7 +183,9 @@
|
||||
;; Semi-vowel-sign-lo and lower vowels are put under the letter.
|
||||
|
||||
(defconst lao-transcription-consonant-alist
|
||||
(sort '(;; single consonants
|
||||
(sort
|
||||
(copy-sequence
|
||||
'(;; single consonants
|
||||
("k" . "ກ")
|
||||
("kh" . "ຂ")
|
||||
("qh" . "ຄ")
|
||||
@ -223,14 +225,16 @@
|
||||
("hy" . ["ຫຍ"])
|
||||
("hn" . ["ຫນ"])
|
||||
("hm" . ["ຫມ"])
|
||||
)
|
||||
(function (lambda (x y) (> (length (car x)) (length (car y)))))))
|
||||
))
|
||||
(lambda (x y) (> (length (car x)) (length (car y))))))
|
||||
|
||||
(defconst lao-transcription-semi-vowel-alist
|
||||
'(("r" . "ຼ")))
|
||||
|
||||
(defconst lao-transcription-vowel-alist
|
||||
(sort '(("a" . "ະ")
|
||||
(sort
|
||||
(copy-sequence
|
||||
'(("a" . "ະ")
|
||||
("ar" . "າ")
|
||||
("i" . "ິ")
|
||||
("ii" . "ີ")
|
||||
@ -257,8 +261,8 @@
|
||||
("ai" . "ໄ")
|
||||
("ei" . "ໃ")
|
||||
("ao" . ["ເົາ"])
|
||||
("aM" . "ຳ"))
|
||||
(function (lambda (x y) (> (length (car x)) (length (car y)))))))
|
||||
("aM" . "ຳ")))
|
||||
(lambda (x y) (> (length (car x)) (length (car y))))))
|
||||
|
||||
;; Maa-sakod is put at the tail.
|
||||
(defconst lao-transcription-maa-sakod-alist
|
||||
|
@ -326,7 +326,9 @@
|
||||
|
||||
|
||||
(defconst tibetan-subjoined-transcription-alist
|
||||
(sort '(("+k" . "ྐ")
|
||||
(sort
|
||||
(copy-sequence
|
||||
'(("+k" . "ྐ")
|
||||
("+kh" . "ྑ")
|
||||
("+g" . "ྒ")
|
||||
("+gh" . "ྒྷ")
|
||||
@ -371,8 +373,8 @@
|
||||
("+W" . "ྺ") ;; fixed form subscribed WA
|
||||
("+Y" . "ྻ") ;; fixed form subscribed YA
|
||||
("+R" . "ྼ") ;; fixed form subscribed RA
|
||||
)
|
||||
(lambda (x y) (> (length (car x)) (length (car y))))))
|
||||
))
|
||||
(lambda (x y) (> (length (car x)) (length (car y))))))
|
||||
|
||||
;;;
|
||||
;;; alist for Tibetan base consonant <-> subjoined consonant conversion.
|
||||
|
@ -49,21 +49,21 @@
|
||||
(should-error (nreverse))
|
||||
(should-error (nreverse 1))
|
||||
(should-error (nreverse (make-char-table 'foo)))
|
||||
(should (equal (nreverse "xyzzy") "yzzyx"))
|
||||
(let ((A []))
|
||||
(should (equal (nreverse (copy-sequence "xyzzy")) "yzzyx"))
|
||||
(let ((A (vector)))
|
||||
(nreverse A)
|
||||
(should (equal A [])))
|
||||
(let ((A [0]))
|
||||
(let ((A (vector 0)))
|
||||
(nreverse A)
|
||||
(should (equal A [0])))
|
||||
(let ((A [1 2 3 4]))
|
||||
(let ((A (vector 1 2 3 4)))
|
||||
(nreverse A)
|
||||
(should (equal A [4 3 2 1])))
|
||||
(let ((A [1 2 3 4]))
|
||||
(let ((A (vector 1 2 3 4)))
|
||||
(nreverse A)
|
||||
(nreverse A)
|
||||
(should (equal A [1 2 3 4])))
|
||||
(let* ((A [1 2 3 4])
|
||||
(let* ((A (vector 1 2 3 4))
|
||||
(B (nreverse (nreverse A))))
|
||||
(should (equal A B))))
|
||||
|
||||
@ -146,13 +146,13 @@
|
||||
;; Invalid UTF-8 sequences shall be indicated. How to create such strings?
|
||||
|
||||
(ert-deftest fns-tests-sort ()
|
||||
(should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
|
||||
(should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
|
||||
'(-1 2 3 4 5 5 7 8 9)))
|
||||
(should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
|
||||
(should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
|
||||
'(9 8 7 5 5 4 3 2 -1)))
|
||||
(should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (< x y)))
|
||||
(should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
|
||||
[-1 2 3 4 5 5 7 8 9]))
|
||||
(should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (> x y)))
|
||||
(should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
|
||||
[9 8 7 5 5 4 3 2 -1]))
|
||||
(should (equal
|
||||
(sort
|
||||
@ -172,7 +172,7 @@
|
||||
;; Punctuation and whitespace characters are relevant for POSIX.
|
||||
(should
|
||||
(equal
|
||||
(sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
|
||||
(sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
|
||||
(lambda (a b) (string-collate-lessp a b "POSIX")))
|
||||
'("1 1" "1 2" "1.1" "1.2" "11" "12")))
|
||||
;; Punctuation and whitespace characters are not taken into account
|
||||
@ -180,7 +180,7 @@
|
||||
(when (eq system-type 'windows-nt)
|
||||
(should
|
||||
(equal
|
||||
(sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
|
||||
(sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
|
||||
(lambda (a b)
|
||||
(let ((w32-collate-ignore-punctuation t))
|
||||
(string-collate-lessp
|
||||
@ -190,7 +190,7 @@
|
||||
;; Diacritics are different letters for POSIX, they sort lexicographical.
|
||||
(should
|
||||
(equal
|
||||
(sort '("Ævar" "Agustín" "Adrian" "Eli")
|
||||
(sort (list "Ævar" "Agustín" "Adrian" "Eli")
|
||||
(lambda (a b) (string-collate-lessp a b "POSIX")))
|
||||
'("Adrian" "Agustín" "Eli" "Ævar")))
|
||||
;; Diacritics are sorted between similar letters for other locales,
|
||||
@ -198,7 +198,7 @@
|
||||
(when (eq system-type 'windows-nt)
|
||||
(should
|
||||
(equal
|
||||
(sort '("Ævar" "Agustín" "Adrian" "Eli")
|
||||
(sort (list "Ævar" "Agustín" "Adrian" "Eli")
|
||||
(lambda (a b)
|
||||
(let ((w32-collate-ignore-punctuation t))
|
||||
(string-collate-lessp
|
||||
@ -212,7 +212,7 @@
|
||||
(should (not (string-version-lessp "foo20000.png" "foo12.png")))
|
||||
(should (string-version-lessp "foo.png" "foo2.png"))
|
||||
(should (not (string-version-lessp "foo2.png" "foo.png")))
|
||||
(should (equal (sort '("foo12.png" "foo2.png" "foo1.png")
|
||||
(should (equal (sort (list "foo12.png" "foo2.png" "foo1.png")
|
||||
'string-version-lessp)
|
||||
'("foo1.png" "foo2.png" "foo12.png")))
|
||||
(should (string-version-lessp "foo2" "foo1234"))
|
||||
@ -432,9 +432,9 @@
|
||||
(should-error (mapcan))
|
||||
(should-error (mapcan #'identity))
|
||||
(should-error (mapcan #'identity (make-char-table 'foo)))
|
||||
(should (equal (mapcan #'list '(1 2 3)) '(1 2 3)))
|
||||
(should (equal (mapcan #'list (list 1 2 3)) '(1 2 3)))
|
||||
;; `mapcan' is destructive
|
||||
(let ((data '((foo) (bar))))
|
||||
(let ((data (list (list 'foo) (list 'bar))))
|
||||
(should (equal (mapcan #'identity data) '(foo bar)))
|
||||
(should (equal data '((foo bar) (bar))))))
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user