aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2012-08-13 15:10:35 -0400
committerStefan Monnier2012-08-13 15:10:35 -0400
commitaa7c6dbeba48522d892cbf011c40a9fef0c369f7 (patch)
tree0f984a2054ada80ca4922a9bc47021a27f264ef6
parent89660017d14b5c2ca7d621636604f4acab63138c (diff)
downloademacs-aa7c6dbeba48522d892cbf011c40a9fef0c369f7.tar.gz
emacs-aa7c6dbeba48522d892cbf011c40a9fef0c369f7.zip
* lisp/color.el (color-xyz-to-lab, color-lab-to-xyz, color-cie-de2000):
Prefer pcase-let over destructuring-bind. * lisp/vc/diff-mode.el (diff-remove-trailing-whitespace): Same. Also, remove whitespace as we go, rather than after accumulating the various places.
-rw-r--r--lisp/ChangeLog6
-rw-r--r--lisp/color.el191
-rw-r--r--lisp/vc/diff-mode.el49
3 files changed, 123 insertions, 123 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ba335bdadb1..2cbf94c0ee7 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,11 @@
12012-08-13 Stefan Monnier <monnier@iro.umontreal.ca> 12012-08-13 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * color.el (color-xyz-to-lab, color-lab-to-xyz, color-cie-de2000):
4 Prefer pcase-let over destructuring-bind.
5 * vc/diff-mode.el (diff-remove-trailing-whitespace): Same.
6 Also, remove whitespace as we go, rather than after accumulating the
7 various places.
8
3 * subr.el (internal--before-with-selected-window) 9 * subr.el (internal--before-with-selected-window)
4 (internal--after-with-selected-window): Fix typo seleted->selected. 10 (internal--after-with-selected-window): Fix typo seleted->selected.
5 (with-selected-window): Adjust callers. 11 (with-selected-window): Adjust callers.
diff --git a/lisp/color.el b/lisp/color.el
index 6ccf9a79494..94a98615d94 100644
--- a/lisp/color.el
+++ b/lisp/color.el
@@ -1,4 +1,4 @@
1;;; color.el --- Color manipulation library -*- coding: utf-8; -*- 1;;; color.el --- Color manipulation library -*- coding: utf-8; lexical-binding:t -*-
2 2
3;; Copyright (C) 2010-2012 Free Software Foundation, Inc. 3;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
4 4
@@ -85,7 +85,7 @@ resulting list."
85 (g-step (/ (- (nth 1 stop) g) (1+ step-number))) 85 (g-step (/ (- (nth 1 stop) g) (1+ step-number)))
86 (b-step (/ (- (nth 2 stop) b) (1+ step-number))) 86 (b-step (/ (- (nth 2 stop) b) (1+ step-number)))
87 result) 87 result)
88 (dotimes (n step-number) 88 (dotimes (_ step-number)
89 (push (list (setq r (+ r r-step)) 89 (push (list (setq r (+ r r-step))
90 (setq g (+ g g-step)) 90 (setq g (+ g g-step))
91 (setq b (+ b b-step))) 91 (setq b (+ b b-step)))
@@ -226,44 +226,44 @@ RED, BLUE and GREEN must be between 0 and 1, inclusive."
226 "Convert CIE XYZ to CIE L*a*b*. 226 "Convert CIE XYZ to CIE L*a*b*.
227WHITE-POINT specifies the (X Y Z) white point for the 227WHITE-POINT specifies the (X Y Z) white point for the
228conversion. If omitted or nil, use `color-d65-xyz'." 228conversion. If omitted or nil, use `color-d65-xyz'."
229 (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz) 229 (pcase-let* ((`(,Xr ,Yr ,Zr) (or white-point color-d65-xyz))
230 (let* ((xr (/ X Xr)) 230 (xr (/ X Xr))
231 (yr (/ Y Yr)) 231 (yr (/ Y Yr))
232 (zr (/ Z Zr)) 232 (zr (/ Z Zr))
233 (fx (if (> xr color-cie-ε) 233 (fx (if (> xr color-cie-ε)
234 (expt xr (/ 1 3.0)) 234 (expt xr (/ 1 3.0))
235 (/ (+ (* color-cie-κ xr) 16) 116.0))) 235 (/ (+ (* color-cie-κ xr) 16) 116.0)))
236 (fy (if (> yr color-cie-ε) 236 (fy (if (> yr color-cie-ε)
237 (expt yr (/ 1 3.0)) 237 (expt yr (/ 1 3.0))
238 (/ (+ (* color-cie-κ yr) 16) 116.0))) 238 (/ (+ (* color-cie-κ yr) 16) 116.0)))
239 (fz (if (> zr color-cie-ε) 239 (fz (if (> zr color-cie-ε)
240 (expt zr (/ 1 3.0)) 240 (expt zr (/ 1 3.0))
241 (/ (+ (* color-cie-κ zr) 16) 116.0)))) 241 (/ (+ (* color-cie-κ zr) 16) 116.0))))
242 (list 242 (list
243 (- (* 116 fy) 16) ; L 243 (- (* 116 fy) 16) ; L
244 (* 500 (- fx fy)) ; a 244 (* 500 (- fx fy)) ; a
245 (* 200 (- fy fz)))))) ; b 245 (* 200 (- fy fz))))) ; b
246 246
247(defun color-lab-to-xyz (L a b &optional white-point) 247(defun color-lab-to-xyz (L a b &optional white-point)
248 "Convert CIE L*a*b* to CIE XYZ. 248 "Convert CIE L*a*b* to CIE XYZ.
249WHITE-POINT specifies the (X Y Z) white point for the 249WHITE-POINT specifies the (X Y Z) white point for the
250conversion. If omitted or nil, use `color-d65-xyz'." 250conversion. If omitted or nil, use `color-d65-xyz'."
251 (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz) 251 (pcase-let* ((`(,Xr ,Yr ,Zr) (or white-point color-d65-xyz))
252 (let* ((fy (/ (+ L 16) 116.0)) 252 (fy (/ (+ L 16) 116.0))
253 (fz (- fy (/ b 200.0))) 253 (fz (- fy (/ b 200.0)))
254 (fx (+ (/ a 500.0) fy)) 254 (fx (+ (/ a 500.0) fy))
255 (xr (if (> (expt fx 3.0) color-cie-ε) 255 (xr (if (> (expt fx 3.0) color-cie-ε)
256 (expt fx 3.0) 256 (expt fx 3.0)
257 (/ (- (* fx 116) 16) color-cie-κ))) 257 (/ (- (* fx 116) 16) color-cie-κ)))
258 (yr (if (> L (* color-cie-κ color-cie-ε)) 258 (yr (if (> L (* color-cie-κ color-cie-ε))
259 (expt (/ (+ L 16) 116.0) 3.0) 259 (expt (/ (+ L 16) 116.0) 3.0)
260 (/ L color-cie-κ))) 260 (/ L color-cie-κ)))
261 (zr (if (> (expt fz 3) color-cie-ε) 261 (zr (if (> (expt fz 3) color-cie-ε)
262 (expt fz 3.0) 262 (expt fz 3.0)
263 (/ (- (* 116 fz) 16) color-cie-κ)))) 263 (/ (- (* 116 fz) 16) color-cie-κ))))
264 (list (* xr Xr) ; X 264 (list (* xr Xr) ; X
265 (* yr Yr) ; Y 265 (* yr Yr) ; Y
266 (* zr Zr))))) ; Z 266 (* zr Zr)))) ; Z
267 267
268(defun color-srgb-to-lab (red green blue) 268(defun color-srgb-to-lab (red green blue)
269 "Convert RGB to CIE L*a*b*." 269 "Convert RGB to CIE L*a*b*."
@@ -277,67 +277,72 @@ conversion. If omitted or nil, use `color-d65-xyz'."
277 "Return the CIEDE2000 color distance between COLOR1 and COLOR2. 277 "Return the CIEDE2000 color distance between COLOR1 and COLOR2.
278Both COLOR1 and COLOR2 should be in CIE L*a*b* format, as 278Both COLOR1 and COLOR2 should be in CIE L*a*b* format, as
279returned by `color-srgb-to-lab' or `color-xyz-to-lab'." 279returned by `color-srgb-to-lab' or `color-xyz-to-lab'."
280 (destructuring-bind (L₁ a₁ b₁) color1 280 (pcase-let*
281 (destructuring-bind (L₂ a₂ b₂) color2 281 ((`(,L₁ ,a₁ ,b₁) color1)
282 (let* ((kL (or kL 1)) 282 (`(,L₂ ,a₂ ,b₂) color2)
283 (kC (or kC 1)) 283 (kL (or kL 1))
284 (kH (or kH 1)) 284 (kC (or kC 1))
285 (C₁ (sqrt (+ (expt a₁ 2.0) (expt b₁ 2.0)))) 285 (kH (or kH 1))
286 (C₂ (sqrt (+ (expt a₂ 2.0) (expt b₂ 2.0)))) 286 (C₁ (sqrt (+ (expt a₁ 2.0) (expt b₁ 2.0))))
287 (C̄ (/ (+ C₁ C₂) 2.0)) 287 (C₂ (sqrt (+ (expt a₂ 2.0) (expt b₂ 2.0))))
288 (G (* 0.5 (- 1 (sqrt (/ (expt C̄ 7.0) (+ (expt C̄ 7.0) (expt 25 7.0))))))) 288 (C̄ (/ (+ C₁ C₂) 2.0))
289 (a′₁ (* (+ 1 G) a₁)) 289 (G (* 0.5 (- 1 (sqrt (/ (expt C̄ 7.0)
290 (a′₂ (* (+ 1 G) a₂)) 290 (+ (expt C̄ 7.0) (expt 25 7.0)))))))
291 (C′₁ (sqrt (+ (expt a′₁ 2.0) (expt b₁ 2.0)))) 291 (a′₁ (* (+ 1 G) a₁))
292 (C′₂ (sqrt (+ (expt a′₂ 2.0) (expt b₂ 2.0)))) 292 (a′₂ (* (+ 1 G) a₂))
293 (h′₁ (if (and (= b₁ 0) (= a′₁ 0)) 293 (C′₁ (sqrt (+ (expt a′₁ 2.0) (expt b₁ 2.0))))
294 0 294 (C′₂ (sqrt (+ (expt a′₂ 2.0) (expt b₂ 2.0))))
295 (let ((v (atan b₁ a′₁))) 295 (h′₁ (if (and (= b₁ 0) (= a′₁ 0))
296 (if (< v 0) 296 0
297 (+ v (* 2 float-pi)) 297 (let ((v (atan b₁ a′₁)))
298 v)))) 298 (if (< v 0)
299 (h′₂ (if (and (= b₂ 0) (= a′₂ 0)) 299 (+ v (* 2 float-pi))
300 0 300 v))))
301 (let ((v (atan b₂ a′₂))) 301 (h′₂ (if (and (= b₂ 0) (= a′₂ 0))
302 (if (< v 0) 302 0
303 (+ v (* 2 float-pi)) 303 (let ((v (atan b₂ a′₂)))
304 v)))) 304 (if (< v 0)
305 (ΔL′ (- L₂ L₁)) 305 (+ v (* 2 float-pi))
306 (ΔC′ (- C′₂ C′₁)) 306 v))))
307 (Δh′ (cond ((= (* C′₁ C′₂) 0) 307 (ΔL′ (- L₂ L₁))
308 0) 308 (ΔC′ (- C′₂ C′₁))
309 ((<= (abs (- h′₂ h′₁)) float-pi) 309 (Δh′ (cond ((= (* C′₁ C′₂) 0)
310 (- h′₂ h′₁)) 310 0)
311 ((> (- h′₂ h′₁) float-pi) 311 ((<= (abs (- h′₂ h′₁)) float-pi)
312 (- (- h′₂ h′₁) (* 2 float-pi))) 312 (- h′₂ h′₁))
313 ((< (- h′₂ h′₁) (- float-pi)) 313 ((> (- h′₂ h′₁) float-pi)
314 (+ (- h′₂ h′₁) (* 2 float-pi))))) 314 (- (- h′₂ h′₁) (* 2 float-pi)))
315 (ΔH′ (* 2 (sqrt (* C′₁ C′₂)) (sin (/ Δh′ 2.0)))) 315 ((< (- h′₂ h′₁) (- float-pi))
316 (L̄′ (/ (+ L₁ L₂) 2.0)) 316 (+ (- h′₂ h′₁) (* 2 float-pi)))))
317 (C̄′ (/ (+ C′₁ C′₂) 2.0)) 317 (ΔH′ (* 2 (sqrt (* C′₁ C′₂)) (sin (/ Δh′ 2.0))))
318 (h̄′ (cond ((= (* C′₁ C′₂) 0) 318 (L̄′ (/ (+ L₁ L₂) 2.0))
319 (+ h′₁ h′₂)) 319 (C̄′ (/ (+ C′₁ C′₂) 2.0))
320 ((<= (abs (- h′₁ h′₂)) float-pi) 320 (h̄′ (cond ((= (* C′₁ C′₂) 0)
321 (/ (+ h′₁ h′₂) 2.0)) 321 (+ h′₁ h′₂))
322 ((< (+ h′₁ h′₂) (* 2 float-pi)) 322 ((<= (abs (- h′₁ h′₂)) float-pi)
323 (/ (+ h′₁ h′₂ (* 2 float-pi)) 2.0)) 323 (/ (+ h′₁ h′₂) 2.0))
324 ((>= (+ h′₁ h′₂) (* 2 float-pi)) 324 ((< (+ h′₁ h′₂) (* 2 float-pi))
325 (/ (+ h′₁ h′₂ (* -2 float-pi)) 2.0)))) 325 (/ (+ h′₁ h′₂ (* 2 float-pi)) 2.0))
326 (T (+ 1 326 ((>= (+ h′₁ h′₂) (* 2 float-pi))
327 (- (* 0.17 (cos (- h̄′ (degrees-to-radians 30))))) 327 (/ (+ h′₁ h′₂ (* -2 float-pi)) 2.0))))
328 (* 0.24 (cos (* h̄′ 2))) 328 (T (+ 1
329 (* 0.32 (cos (+ (* h̄′ 3) (degrees-to-radians 6)))) 329 (- (* 0.17 (cos (- h̄′ (degrees-to-radians 30)))))
330 (- (* 0.20 (cos (- (* h̄′ 4) (degrees-to-radians 63))))))) 330 (* 0.24 (cos (* h̄′ 2)))
331 (Δθ (* (degrees-to-radians 30) (exp (- (expt (/ (- h̄′ (degrees-to-radians 275)) (degrees-to-radians 25)) 2.0))))) 331 (* 0.32 (cos (+ (* h̄′ 3) (degrees-to-radians 6))))
332 (Rc (* 2 (sqrt (/ (expt C̄′ 7.0) (+ (expt C̄′ 7.0) (expt 25.0 7.0)))))) 332 (- (* 0.20 (cos (- (* h̄′ 4) (degrees-to-radians 63)))))))
333 (Sl (+ 1 (/ (* 0.015 (expt (- L̄′ 50) 2.0)) (sqrt (+ 20 (expt (- L̄′ 50) 2.0)))))) 333 (Δθ (* (degrees-to-radians 30)
334 (Sc (+ 1 (* C̄′ 0.045))) 334 (exp (- (expt (/ (- h̄′ (degrees-to-radians 275))
335 (Sh (+ 1 (* 0.015 C̄′ T))) 335 (degrees-to-radians 25)) 2.0)))))
336 (Rt (- (* (sin (* Δθ 2)) Rc)))) 336 (Rc (* 2 (sqrt (/ (expt C̄′ 7.0) (+ (expt C̄′ 7.0) (expt 25.0 7.0))))))
337 (Sl (+ 1 (/ (* 0.015 (expt (- L̄′ 50) 2.0))
338 (sqrt (+ 20 (expt (- L̄′ 50) 2.0))))))
339 (Sc (+ 1 (* C̄′ 0.045)))
340 (Sh (+ 1 (* 0.015 C̄′ T)))
341 (Rt (- (* (sin (* Δθ 2)) Rc))))
337 (sqrt (+ (expt (/ ΔL′ (* Sl kL)) 2.0) 342 (sqrt (+ (expt (/ ΔL′ (* Sl kL)) 2.0)
338 (expt (/ ΔC′ (* Sc kC)) 2.0) 343 (expt (/ ΔC′ (* Sc kC)) 2.0)
339 (expt (/ ΔH′ (* Sh kH)) 2.0) 344 (expt (/ ΔH′ (* Sh kH)) 2.0)
340 (* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH))))))))) 345 (* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH)))))))
341 346
342(defun color-clamp (value) 347(defun color-clamp (value)
343 "Make sure VALUE is a number between 0.0 and 1.0 inclusive." 348 "Make sure VALUE is a number between 0.0 and 1.0 inclusive."
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index d3d9878c5ad..3fa7788002e 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -2024,37 +2024,26 @@ with the name of the altered buffers, which are unsaved. If a
2024file referenced on the diff has no buffer and needs to be fixed, 2024file referenced on the diff has no buffer and needs to be fixed,
2025a buffer visiting that file is created." 2025a buffer visiting that file is created."
2026 (interactive) 2026 (interactive)
2027 (goto-char (point-min)) 2027 ;; We assume that the diff header has no trailing whitespace.
2028 (let 2028 (let ((modified-buffers nil))
2029 ;; We assume that the diff header has no trailing whitespace. 2029 (save-excursion
2030 ((modified-buffers nil) 2030 (goto-char (point-min))
2031 (white-positions nil)) 2031 (while (re-search-forward "^[+!>].*[ \t]+$" (point-max) t)
2032 (while (re-search-forward "^[+!>].*[ \t]+$" (point-max) t) 2032 (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,_switched)
2033 (save-excursion 2033 (diff-find-source-location t t)))
2034 (cl-destructuring-bind (buf line-offset pos src _dst &optional _switched) 2034 (when line-offset
2035 (diff-find-source-location t t) 2035 (with-current-buffer buf
2036 (when line-offset 2036 (save-excursion
2037 (set-buffer buf) 2037 (goto-char (+ (car pos) (cdr src)))
2038 (save-excursion 2038 (beginning-of-line)
2039 (goto-char (+ (car pos) (cdr src))) 2039 (when (re-search-forward "\\([ \t]+\\)$" (line-end-position) t)
2040 (beginning-of-line) 2040 (unless (memq buf modified-buffers)
2041 (when (re-search-forward "\\([ \t]+\\)$" (line-end-position) t) 2041 (push buf modified-buffers))
2042 (when (not (member buf modified-buffers)) 2042 (replace-match ""))))))))
2043 (push buf modified-buffers))
2044 (goto-char (match-end 0))
2045 (push (point-marker) white-positions)
2046 (goto-char (match-beginning 0))
2047 (push (point-marker) white-positions)
2048 (push buf white-positions)))))))
2049 (while white-positions
2050 (save-excursion
2051 (set-buffer (pop white-positions))
2052 (delete-region (pop white-positions) (pop white-positions))))
2053 (if modified-buffers 2043 (if modified-buffers
2054 (let ((msg "Deleted new trailing whitespace from:")) 2044 (message "Deleted new trailing whitespace from: %s"
2055 (dolist (f modified-buffers) 2045 (mapconcat (lambda (buf) (concat "`" (buffer-name buf) "'"))
2056 (setq msg (concat msg " `" (buffer-name f) "'"))) 2046 modified-buffers " "))
2057 (message "%s" msg))
2058 (message "No trailing whitespace fixes needed.")))) 2047 (message "No trailing whitespace fixes needed."))))
2059 2048
2060;; provide the package 2049;; provide the package