[Emacs-diffs] /srv/bzr/emacs/trunk r110236: * lisp/emacs-lisp/pcase.el (pcase--mark-used): New.

[Stefan Monnier]

------------------------------------------------------------
revno: 110236
fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=12512
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Fri 2012-09-28 08:18:38 -0400
message:
  * lisp/emacs-lisp/pcase.el (pcase--mark-used): New.
  (pcase--u1): Use it.
  * lisp/custom.el (load-theme): Set buffer-file-name so the load is recorded
  in load-history with the right file name.
modified:
  lisp/ChangeLog
  lisp/custom.el
  lisp/emacs-lisp/pcase.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-09-28 10:05:46 +0000
+++ b/lisp/ChangeLog    2012-09-28 12:18:38 +0000
@@ -1,3 +1,11 @@
+2012-09-28  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/pcase.el (pcase--mark-used): New.
+       (pcase--u1): Use it (bug#12512).
+
+       * custom.el (load-theme): Set buffer-file-name so the load is recorded
+       in load-history with the right file name.
+
 2012-09-28  Tassilo Horn  <address@hidden>
 
        * doc-view.el (doc-view-current-cache-doc-pdf): New function.

=== modified file 'lisp/custom.el'
--- a/lisp/custom.el    2012-09-18 05:14:42 +0000
+++ b/lisp/custom.el    2012-09-28 12:18:38 +0000
@@ -1193,7 +1193,8 @@
                            (expand-file-name "themes/" data-directory)))
                (member hash custom-safe-themes)
                (custom-theme-load-confirm hash))
-       (let ((custom--inhibit-theme-enable t))
+       (let ((custom--inhibit-theme-enable t)
+              (buffer-file-name fn))    ;For load-history.
          (eval-buffer))
        ;; Optimization: if the theme changes the `default' face, put that
        ;; entry first.  This avoids some `frame-set-background-mode' rigmarole

=== modified file 'lisp/emacs-lisp/pcase.el'
--- a/lisp/emacs-lisp/pcase.el  2012-09-04 17:40:25 +0000
+++ b/lisp/emacs-lisp/pcase.el  2012-09-28 12:18:38 +0000
@@ -517,6 +517,10 @@
 (defun pcase--self-quoting-p (upat)
   (or (keywordp upat) (numberp upat) (stringp upat)))
 
+(defsubst pcase--mark-used (sym)
+  ;; Exceptionally, `sym' may be a constant expression rather than a symbol.
+  (if (symbolp sym) (put sym 'pcase-used t)))
+
 ;; It's very tempting to use `pcase' below, tho obviously, it'd create
 ;; bootstrapping problems.
 (defun pcase--u1 (matches code vars rest)
@@ -581,7 +585,7 @@
        ((memq upat '(t _)) (pcase--u1 matches code vars rest))
        ((eq upat 'pcase--dontcare) :pcase--dontcare)
        ((memq (car-safe upat) '(guard pred))
-        (if (eq (car upat) 'pred) (put sym 'pcase-used t))
+        (if (eq (car upat) 'pred) (pcase--mark-used sym))
         (let* ((splitrest
                 (pcase--split-rest
                  sym (lambda (pat) (pcase--split-pred upat pat)) rest))
@@ -614,10 +618,10 @@
                      (pcase--u1 matches code vars then-rest)
                      (pcase--u else-rest))))
        ((pcase--self-quoting-p upat)
-        (put sym 'pcase-used t)
+        (pcase--mark-used sym)
         (pcase--q1 sym upat matches code vars rest))
        ((symbolp upat)
-        (put sym 'pcase-used t)
+        (pcase--mark-used sym)
         (if (not (assq upat vars))
             (pcase--u1 matches code (cons (cons upat sym) vars) rest)
           ;; Non-linear pattern.  Turn it into an `eq' test.
@@ -640,7 +644,7 @@
           (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches)
                      code vars rest)))
        ((eq (car-safe upat) '\`)
-        (put sym 'pcase-used t)
+        (pcase--mark-used sym)
         (pcase--q1 sym (cadr upat) matches code vars rest))
        ((eq (car-safe upat) 'or)
         (let ((all (> (length (cdr upat)) 1))
@@ -662,7 +666,7 @@
                        sym (lambda (pat) (pcase--split-member elems pat)) 
rest))
                      (then-rest (car splitrest))
                      (else-rest (cdr splitrest)))
-                (put sym 'pcase-used t)
+                (pcase--mark-used sym)
                 (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems)
                            (pcase--u1 matches code vars then-rest)
                            (pcase--u else-rest)))