Commit 7f457c06 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* 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.

Fixes: debbugs:12512
parent c00ebc98
2012-09-28 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <tsdh@gnu.org> 2012-09-28 Tassilo Horn <tsdh@gnu.org>
   
* doc-view.el (doc-view-current-cache-doc-pdf): New function. * doc-view.el (doc-view-current-cache-doc-pdf): New function.
......
...@@ -1193,7 +1193,8 @@ Return t if THEME was successfully loaded, nil otherwise." ...@@ -1193,7 +1193,8 @@ Return t if THEME was successfully loaded, nil otherwise."
(expand-file-name "themes/" data-directory))) (expand-file-name "themes/" data-directory)))
(member hash custom-safe-themes) (member hash custom-safe-themes)
(custom-theme-load-confirm hash)) (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)) (eval-buffer))
;; Optimization: if the theme changes the `default' face, put that ;; Optimization: if the theme changes the `default' face, put that
;; entry first. This avoids some `frame-set-background-mode' rigmarole ;; entry first. This avoids some `frame-set-background-mode' rigmarole
......
...@@ -517,6 +517,10 @@ MATCH is the pattern that needs to be matched, of the form: ...@@ -517,6 +517,10 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase--self-quoting-p (upat) (defun pcase--self-quoting-p (upat)
(or (keywordp upat) (numberp upat) (stringp 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 ;; It's very tempting to use `pcase' below, tho obviously, it'd create
;; bootstrapping problems. ;; bootstrapping problems.
(defun pcase--u1 (matches code vars rest) (defun pcase--u1 (matches code vars rest)
...@@ -581,7 +585,7 @@ Otherwise, it defers to REST which is a list of branches of the form ...@@ -581,7 +585,7 @@ Otherwise, it defers to REST which is a list of branches of the form
((memq upat '(t _)) (pcase--u1 matches code vars rest)) ((memq upat '(t _)) (pcase--u1 matches code vars rest))
((eq upat 'pcase--dontcare) :pcase--dontcare) ((eq upat 'pcase--dontcare) :pcase--dontcare)
((memq (car-safe upat) '(guard pred)) ((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 (let* ((splitrest
(pcase--split-rest (pcase--split-rest
sym (lambda (pat) (pcase--split-pred upat pat)) rest)) sym (lambda (pat) (pcase--split-pred upat pat)) rest))
...@@ -614,10 +618,10 @@ Otherwise, it defers to REST which is a list of branches of the form ...@@ -614,10 +618,10 @@ Otherwise, it defers to REST which is a list of branches of the form
(pcase--u1 matches code vars then-rest) (pcase--u1 matches code vars then-rest)
(pcase--u else-rest)))) (pcase--u else-rest))))
((pcase--self-quoting-p upat) ((pcase--self-quoting-p upat)
(put sym 'pcase-used t) (pcase--mark-used sym)
(pcase--q1 sym upat matches code vars rest)) (pcase--q1 sym upat matches code vars rest))
((symbolp upat) ((symbolp upat)
(put sym 'pcase-used t) (pcase--mark-used sym)
(if (not (assq upat vars)) (if (not (assq upat vars))
(pcase--u1 matches code (cons (cons upat sym) vars) rest) (pcase--u1 matches code (cons (cons upat sym) vars) rest)
;; Non-linear pattern. Turn it into an `eq' test. ;; Non-linear pattern. Turn it into an `eq' test.
...@@ -640,7 +644,7 @@ Otherwise, it defers to REST which is a list of branches of the form ...@@ -640,7 +644,7 @@ Otherwise, it defers to REST which is a list of branches of the form
(pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches) (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches)
code vars rest))) code vars rest)))
((eq (car-safe upat) '\`) ((eq (car-safe upat) '\`)
(put sym 'pcase-used t) (pcase--mark-used sym)
(pcase--q1 sym (cadr upat) matches code vars rest)) (pcase--q1 sym (cadr upat) matches code vars rest))
((eq (car-safe upat) 'or) ((eq (car-safe upat) 'or)
(let ((all (> (length (cdr upat)) 1)) (let ((all (> (length (cdr upat)) 1))
...@@ -662,7 +666,7 @@ Otherwise, it defers to REST which is a list of branches of the form ...@@ -662,7 +666,7 @@ Otherwise, it defers to REST which is a list of branches of the form
sym (lambda (pat) (pcase--split-member elems pat)) rest)) sym (lambda (pat) (pcase--split-member elems pat)) rest))
(then-rest (car splitrest)) (then-rest (car splitrest))
(else-rest (cdr splitrest))) (else-rest (cdr splitrest)))
(put sym 'pcase-used t) (pcase--mark-used sym)
(pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems) (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems)
(pcase--u1 matches code vars then-rest) (pcase--u1 matches code vars then-rest)
(pcase--u else-rest))) (pcase--u else-rest)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment