diff options
| author | Stefan Monnier | 2012-08-13 15:10:35 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2012-08-13 15:10:35 -0400 |
| commit | aa7c6dbeba48522d892cbf011c40a9fef0c369f7 (patch) | |
| tree | 0f984a2054ada80ca4922a9bc47021a27f264ef6 | |
| parent | 89660017d14b5c2ca7d621636604f4acab63138c (diff) | |
| download | emacs-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/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/color.el | 191 | ||||
| -rw-r--r-- | lisp/vc/diff-mode.el | 49 |
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 @@ | |||
| 1 | 2012-08-13 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2012-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*. |
| 227 | WHITE-POINT specifies the (X Y Z) white point for the | 227 | WHITE-POINT specifies the (X Y Z) white point for the |
| 228 | conversion. If omitted or nil, use `color-d65-xyz'." | 228 | conversion. 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. |
| 249 | WHITE-POINT specifies the (X Y Z) white point for the | 249 | WHITE-POINT specifies the (X Y Z) white point for the |
| 250 | conversion. If omitted or nil, use `color-d65-xyz'." | 250 | conversion. 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. |
| 278 | Both COLOR1 and COLOR2 should be in CIE L*a*b* format, as | 278 | Both COLOR1 and COLOR2 should be in CIE L*a*b* format, as |
| 279 | returned by `color-srgb-to-lab' or `color-xyz-to-lab'." | 279 | returned 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 | |||
| 2024 | file referenced on the diff has no buffer and needs to be fixed, | 2024 | file referenced on the diff has no buffer and needs to be fixed, |
| 2025 | a buffer visiting that file is created." | 2025 | a 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 |