From: Andreas Schwab <schwab@linux-m68k.org>
Date: Tue, 7 Aug 2012 16:12:20 +0000 (+0200)
Subject: * calc/calc-prog.el (math-do-defmath): Use backquote forms.  Fix
X-Git-Tag: emacs-24.2.90~793
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=651eaf36f227ac6067263fe1fb9a7c56984a9b6d;p=emacs.git

* calc/calc-prog.el (math-do-defmath): Use backquote forms.  Fix
handling of interactive spec when the body uses return.
(math-do-arg-check, math-define-function-body): Use backquote forms.
* calc/calc-ext.el (math-defcache): Likewise.
* calc/calc-rewr.el (math-rwfail, math-rweval): Likewise.
* allout.el (allout-new-exposure): Likewise.
* calc/calcalg2.el (math-tracing-integral): Likewise.
* info.el (Info-last-menu-item): Likewise.
* emulation/vip.el (vip-loop): Likewise.
* textmodes/artist.el (artist-funcall): Likewise.
* menu-bar.el (menu-bar-make-mm-toggle, menu-bar-make-toggle):
Construct menu-item directly.

* cedet/ede/base.el (ede-with-projectfile): Use backquote forms.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0d23ed5f3f7..4ef05337ccb 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,18 @@
 2012-08-07  Andreas Schwab  <schwab@linux-m68k.org>
 
+	* calc/calc-prog.el (math-do-defmath): Use backquote forms.  Fix
+	handling of interactive spec when the body uses return.
+	(math-do-arg-check, math-define-function-body): Use backquote forms.
+	* calc/calc-ext.el (math-defcache): Likewise.
+	* calc/calc-rewr.el (math-rwfail, math-rweval): Likewise.
+	* allout.el (allout-new-exposure): Likewise.
+	* calc/calcalg2.el (math-tracing-integral): Likewise.
+	* info.el (Info-last-menu-item): Likewise.
+	* emulation/vip.el (vip-loop): Likewise.
+	* textmodes/artist.el (artist-funcall): Likewise.
+	* menu-bar.el (menu-bar-make-mm-toggle, menu-bar-make-toggle):
+	Construct menu-item directly.
+
 	* progmodes/autoconf.el (font-lock-syntactic-keywords): Don't
 	declare.
 
diff --git a/lisp/allout.el b/lisp/allout.el
index 7077af55e60..9034d009797 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -5312,11 +5312,11 @@ Examples:
         Expose children and grandchildren of first topic at current
 	level, and expose children of subsequent topics at current
 	level *except* for the last, which should be opened completely."
-  (list 'save-excursion
-	'(if (not (or (allout-goto-prefix-doublechecked)
-		      (allout-next-heading)))
-	     (error "allout-new-exposure: Can't find any outline topics"))
-	(list 'allout-expose-topic (list 'quote spec))))
+  `(save-excursion
+     (if (not (or (allout-goto-prefix-doublechecked)
+		  (allout-next-heading)))
+	 (error "allout-new-exposure: Can't find any outline topics"))
+     (allout-expose-topic ',spec)))
 
 ;;;_ #7 Systematic outline presentation -- copying, printing, flattening
 
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 338330a793b..7089070df59 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -1997,51 +1997,36 @@ calc-kill calc-kill-region calc-yank))))
 	(cache-val (intern (concat (symbol-name name) "-cache")))
 	(last-prec (intern (concat (symbol-name name) "-last-prec")))
 	(last-val (intern (concat (symbol-name name) "-last"))))
-    (list 'progn
-;	  (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100))
-	  (list 'defvar cache-prec
-                `(cond
-                  ((consp ,init) (math-numdigs (nth 1 ,init)))
-                  (,init
-                   (nth 1 (math-numdigs (eval ,init))))
-                  (t
-                   -100)))
-	  (list 'defvar cache-val
-                `(cond
-                  ((consp ,init) ,init)
-                  (,init (eval ,init))
-                  (t ,init)))
-	  (list 'defvar last-prec -100)
-	  (list 'defvar last-val nil)
-	  (list 'setq 'math-cache-list
-		(list 'cons
-		      (list 'quote cache-prec)
-		      (list 'cons
-			    (list 'quote last-prec)
-			    'math-cache-list)))
-	  (list 'defun
-		name ()
-		(list 'or
-		      (list '= last-prec 'calc-internal-prec)
-		      (list 'setq
-			    last-val
-			    (list 'math-normalize
-				  (list 'progn
-					(list 'or
-					      (list '>= cache-prec
-						    'calc-internal-prec)
-					      (list 'setq
-						    cache-val
-						    (list 'let
-							  '((calc-internal-prec
-							     (+ calc-internal-prec
-								4)))
-							  form)
-						    cache-prec
-						    '(+ calc-internal-prec 2)))
-					cache-val))
-			    last-prec 'calc-internal-prec))
-		last-val))))
+    `(progn
+;      (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100))
+       (defvar ,cache-prec (cond
+			    ((consp ,init) (math-numdigs (nth 1 ,init)))
+			    (,init
+			     (nth 1 (math-numdigs (eval ,init))))
+			    (t
+			     -100)))
+       (defvar ,cache-val (cond ((consp ,init) ,init)
+				(,init (eval ,init))
+				(t ,init)))
+       (defvar ,last-prec -100)
+       (defvar ,last-val nil)
+       (setq math-cache-list
+	     (cons ',cache-prec
+		   (cons ',last-prec
+			 math-cache-list)))
+       (defun ,name ()
+	 (or (= ,last-prec calc-internal-prec)
+	     (setq ,last-val
+		   (math-normalize
+		    (progn (or (>= ,cache-prec calc-internal-prec)
+			       (setq ,cache-val
+				     (let ((calc-internal-prec
+					    (+ calc-internal-prec 4)))
+				       ,form)
+				     ,cache-prec (+ calc-internal-prec 2)))
+			   ,cache-val))
+		   ,last-prec calc-internal-prec))
+	 ,last-val))))
 (put 'math-defcache 'lisp-indent-hook 2)
 
 ;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239).   [F] [Public]
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index f702033c0fb..411f55a24e6 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -1792,89 +1792,63 @@ Redefine the corresponding command."
 (defun math-do-defmath (func args body)
   (require 'calc-macs)
   (let* ((fname (intern (concat "calcFunc-" (symbol-name func))))
-	 (doc (if (stringp (car body)) (list (car body))))
+	 (doc (if (stringp (car body))
+		  (prog1 (list (car body))
+		    (setq body (cdr body)))))
 	 (clargs (mapcar 'math-clean-arg args))
-	 (body (math-define-function-body
-		(if (stringp (car body)) (cdr body) body)
-		clargs)))
-    (list 'progn
-	  (if (and (consp (car body))
-		   (eq (car (car body)) 'interactive))
-	      (let ((inter (car body)))
-		(setq body (cdr body))
-		(if (or (> (length inter) 2)
-			(integerp (nth 1 inter)))
-		    (let ((hasprefix nil) (hasmulti nil))
-		      (if (stringp (nth 1 inter))
-			  (progn
-			    (cond ((equal (nth 1 inter) "p")
-				   (setq hasprefix t))
-				  ((equal (nth 1 inter) "m")
-				   (setq hasmulti t))
-				  (t (error
-				      "Can't handle interactive code string \"%s\""
-				      (nth 1 inter))))
-			    (setq inter (cdr inter))))
-		      (if (not (integerp (nth 1 inter)))
-			  (error
-			   "Expected an integer in interactive specification"))
-		      (append (list 'defun
-				    (intern (concat "calc-"
-						    (symbol-name func)))
-				    (if (or hasprefix hasmulti)
-					'(&optional n)
-				      ()))
-			      doc
-			      (if (or hasprefix hasmulti)
-				  '((interactive "P"))
-				'((interactive)))
-			      (list
-			       (append
-				'(calc-slow-wrapper)
-				(and hasmulti
-				     (list
-				      (list 'setq
-					    'n
-					    (list 'if
-						  'n
-						  (list 'prefix-numeric-value
-							'n)
-						  (nth 1 inter)))))
-				(list
-				 (list 'calc-enter-result
-				       (if hasmulti 'n (nth 1 inter))
-				       (nth 2 inter)
-				       (if hasprefix
-					   (list 'append
-						 (list 'quote (list fname))
-						 (list 'calc-top-list-n
-						       (nth 1 inter))
-						 (list 'and
-						       'n
-						       (list
-							'list
-							(list
-							 'math-normalize
-							 (list
-							  'prefix-numeric-value
-							  'n)))))
-					 (list 'cons
-					       (list 'quote fname)
-					       (list 'calc-top-list-n
-						     (if hasmulti
-							 'n
-						       (nth 1 inter)))))))))))
-		  (append (list 'defun
-				(intern (concat "calc-" (symbol-name func)))
-				args)
-			  doc
-			  (list
-			   inter
-			   (cons 'calc-wrapper body))))))
-	  (append (list 'defun fname clargs)
-		  doc
-		  (math-do-arg-list-check args nil nil)
-		  body))))
+	 (inter (if (and (consp (car body))
+			 (eq (car (car body)) 'interactive))
+		    (prog1 (car body)
+		      (setq body (cdr body))))))
+    (setq body (math-define-function-body body clargs))
+    `(progn
+       ,(if inter
+	    (if (or (> (length inter) 2)
+		    (integerp (nth 1 inter)))
+		(let ((hasprefix nil) (hasmulti nil))
+		  (when (stringp (nth 1 inter))
+		    (cond ((equal (nth 1 inter) "p")
+			   (setq hasprefix t))
+			  ((equal (nth 1 inter) "m")
+			   (setq hasmulti t))
+			  (t (error
+			      "Can't handle interactive code string \"%s\""
+			      (nth 1 inter))))
+		    (setq inter (cdr inter)))
+		  (unless (integerp (nth 1 inter))
+		    (error "Expected an integer in interactive specification"))
+		  `(defun ,(intern (concat "calc-" (symbol-name func)))
+		     ,(if (or hasprefix hasmulti) '(&optional n) ())
+		     ,@doc
+		     (interactive ,@(if (or hasprefix hasmulti) '("P")))
+		     (calc-slow-wrapper
+		      ,@(if hasmulti
+			    `((setq n (if n
+					  (prefix-numeric-value n)
+					,(nth 1 inter)))))
+		      (calc-enter-result
+		       ,(if hasmulti 'n (nth 1 inter))
+		       ,(nth 2 inter)
+		       ,(if hasprefix
+			    `(append '(,fname)
+				     (calc-top-list-n ,(nth 1 inter))
+				     (and n
+					  (list
+					   (math-normalize
+					    (prefix-numeric-value n)))))
+			  `(cons ',fname
+				 (calc-top-list-n
+				  ,(if hasmulti
+				       'n
+				     (nth 1 inter)))))))))
+	      `(defun ,(intern (concat "calc-" (symbol-name func))) ,clargs
+		 ,@doc
+		 ,inter
+		 (calc-wrapper ,@body))))
+       (defun ,fname ,clargs
+	 ,@doc
+	 ,@(math-do-arg-list-check args nil nil)
+	 ,@body))))
 
 (defun math-clean-arg (arg)
   (if (consp arg)
@@ -1887,56 +1861,42 @@ Redefine the corresponding command."
 	(list (cons 'and
 		    (cons var
 			  (if (cdr chk)
-			      (setq chk (list (cons 'progn chk)))
+			      `((progn ,@chk))
 			    chk)))))
-    (and (consp arg)
-	 (let* ((rest (math-do-arg-check (nth 1 arg) var is-opt is-rest))
-		(qual (car arg))
-		(qqual (list 'quote qual))
-		(qual-name (symbol-name qual))
-		(chk (intern (concat "math-check-" qual-name))))
-	   (if (fboundp chk)
-	       (append rest
-		       (list
+    (when (consp arg)
+      (let* ((rest (math-do-arg-check (nth 1 arg) var is-opt is-rest))
+	     (qual (car arg))
+	     (qual-name (symbol-name qual))
+	     (chk (intern (concat "math-check-" qual-name))))
+	(if (fboundp chk)
+	    (append rest
+		    (if is-rest
+			`((setq ,var (mapcar ',chk ,var)))
+		      `((setq ,var (,chk ,var)))))
+	  (if (fboundp (setq chk (intern (concat "math-" qual-name))))
+	      (append rest
+		      (if is-rest
+			  `((mapcar #'(lambda (x)
+					(or (,chk x)
+					    (math-reject-arg x ',qual)))
+				    ,var))
+			`((or (,chk ,var)
+			      (math-reject-arg ,var ',qual)))))
+	    (if (and (string-match "\\`not-\\(.*\\)\\'" qual-name)
+		     (fboundp (setq chk (intern
+					 (concat "math-"
+						 (math-match-substring
+						  qual-name 1))))))
+		(append rest
 			(if is-rest
-			    (list 'setq var
-				  (list 'mapcar (list 'quote chk) var))
-			  (list 'setq var (list chk var)))))
-	     (if (fboundp (setq chk (intern (concat "math-" qual-name))))
-		 (append rest
-			 (list
-			  (if is-rest
-			      (list 'mapcar
-				    (list 'function
-					  (list 'lambda '(x)
-						(list 'or
-						      (list chk 'x)
-						      (list 'math-reject-arg
-							    'x qqual))))
-				    var)
-			    (list 'or
-				  (list chk var)
-				  (list 'math-reject-arg var qqual)))))
-	       (if (and (string-match "\\`not-\\(.*\\)\\'" qual-name)
-			(fboundp (setq chk (intern
-					    (concat "math-"
-						    (math-match-substring
-						     qual-name 1))))))
-		   (append rest
-			   (list
-			    (if is-rest
-				(list 'mapcar
-				      (list 'function
-					    (list 'lambda '(x)
-						  (list 'and
-							(list chk 'x)
-							(list 'math-reject-arg
-							      'x qqual))))
-				      var)
-			      (list 'and
-				    (list chk var)
-				    (list 'math-reject-arg var qqual)))))
-		 (error "Unknown qualifier `%s'" qual-name))))))))
+			    `((mapcar #'(lambda (x)
+					  (and (,chk x)
+					       (math-reject-arg x ',qual)))
+				      ,var))
+			  `((and
+			     (,chk ,var)
+			     (math-reject-arg ,var ',qual)))))
+	      (error "Unknown qualifier `%s'" qual-name))))))))
 
 (defun math-do-arg-list-check (args is-opt is-rest)
   (cond ((null args) nil)
@@ -1980,7 +1940,7 @@ Redefine the corresponding command."
 (defun math-define-function-body (body env)
   (let ((body (math-define-body body env)))
     (if (math-body-refers-to body 'math-return)
-	(list (cons 'catch (cons '(quote math-return) body)))
+	`((catch 'math-return ,@body))
       body)))
 
 ;; The variable math-exp-env is local to math-define-body, but is
diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el
index 545b9338a0b..eed8a756e8e 100644
--- a/lisp/calc/calc-rewr.el
+++ b/lisp/calc/calc-rewr.el
@@ -1439,21 +1439,19 @@
 (put 'calcFunc-vxor  'math-rewrite-default '(vec))
 
 (defmacro math-rwfail (&optional back)
-  (list 'setq 'pc
-	(list 'and
-	      (if back
-		  '(setq btrack (cdr btrack))
-		'btrack)
-	      ''((backtrack)))))
+  `(setq pc (and ,(if back
+		      '(setq btrack (cdr btrack))
+		    'btrack)
+		 '((backtrack)))))
 
 ;; This monstrosity is necessary because the use of static vectors of
 ;; registers makes rewrite rules non-reentrant.  Yucko!
 (defmacro math-rweval (form)
-  (list 'let '((orig (car rules)))
-	'(setcar rules (quote (nil nil nil no-phase)))
-	(list 'unwind-protect
-	      form
-	      '(setcar rules orig))))
+  `(let ((orig (car rules)))
+     (setcar rules '(nil nil nil no-phase))
+     (unwind-protect
+	 ,form
+       (setcar rules orig))))
 
 (defvar math-rewrite-phase 1)
 
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index fdc70a69fbd..5fd5b35654c 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -667,21 +667,18 @@
 (defvar math-integral-limit)
 
 (defmacro math-tracing-integral (&rest parts)
-  (list 'and
-	'trace-buffer
-	(list 'with-current-buffer
-	      'trace-buffer
-	      '(goto-char (point-max))
-	      (list 'and
-		    '(bolp)
-		    '(insert (make-string (- math-integral-limit
-					     math-integ-level) 32)
-			     (format "%2d " math-integ-depth)
-			     (make-string math-integ-level 32)))
-	      ;;(list 'condition-case 'err
-		    (cons 'insert parts)
-		;;    '(error (insert (prin1-to-string err))))
-	      '(sit-for 0))))
+  `(and trace-buffer
+	(with-current-buffer trace-buffer
+	  (goto-char (point-max))
+	  (and (bolp)
+	       (insert (make-string (- math-integral-limit
+				       math-integ-level) 32)
+		       (format "%2d " math-integ-depth)
+		       (make-string math-integ-level 32)))
+	  ;;(condition-case err
+	  (insert ,@parts)
+	  ;;    (error (insert (prin1-to-string err))))
+	  (sit-for 0))))
 
 ;;; The following wrapper caches results and avoids infinite recursion.
 ;;; Each cache entry is: ( A B )          Integral of A is B;
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog
index b946e756ff8..925bde8a193 100644
--- a/lisp/cedet/ChangeLog
+++ b/lisp/cedet/ChangeLog
@@ -1,3 +1,7 @@
+2012-08-07  Andreas Schwab  <schwab@linux-m68k.org>
+
+	* ede/base.el (ede-with-projectfile): Use backquote forms.
+
 2012-07-29  Paul Eggert  <eggert@cs.ucla.edu>
 
 	inaccessable -> inaccessible spelling fix (Bug#10052)
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el
index 4365fdc2190..ce3d4a036f3 100644
--- a/lisp/cedet/ede/base.el
+++ b/lisp/cedet/ede/base.el
@@ -285,22 +285,18 @@ All specific project types must derive from this project."
 ;;
 (defmacro ede-with-projectfile (obj &rest forms)
   "For the project in which OBJ resides, execute FORMS."
-  (list 'save-window-excursion
-	(list 'let* (list
-		     (list 'pf
-			   (list 'if (list 'obj-of-class-p
-					   obj 'ede-target)
-				 ;; @todo -I think I can change
-				 ;; this to not need ede-load-project-file
-				 ;; but I'm not sure how to test well.
-				 (list 'ede-load-project-file
-				       (list 'oref obj 'path))
-				 obj))
-		     '(dbka (get-file-buffer (oref pf file))))
-	      '(if (not dbka) (find-file (oref pf file))
-		 (switch-to-buffer dbka))
-	      (cons 'progn forms)
-	      '(if (not dbka) (kill-buffer (current-buffer))))))
+  `(save-window-excursion
+     (let* ((pf (if (obj-of-class-p ,obj ede-target)
+		    ;; @todo -I think I can change
+		    ;; this to not need ede-load-project-file
+		    ;; but I'm not sure how to test well.
+		    (ede-load-project-file (oref ,obj path))
+		  ,obj))
+	    (dbka (get-file-buffer (oref pf file))))
+       (if (not dbka) (find-file (oref pf file))
+	 (switch-to-buffer dbka))
+       ,@forms
+       (if (not dbka) (kill-buffer (current-buffer))))))
 (put 'ede-with-projectfile 'lisp-indent-function 1)
 
 ;;; The EDE persistent cache.
diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el
index 29020a4bdf5..c313a97f726 100644
--- a/lisp/emulation/vip.el
+++ b/lisp/emulation/vip.el
@@ -307,10 +307,10 @@ If nil then it is bound to `delete-backward-char'."
 
 (defmacro vip-loop (count body)
   "(COUNT BODY) Execute BODY COUNT times."
-  (list 'let (list (list 'count count))
-	(list 'while (list '> 'count 0)
-	      body
-	      (list 'setq 'count (list '1- 'count)))))
+  `(let ((count ,count))
+     (while (> count 0)
+       ,body
+       (setq count (1- count)))))
 
 (defun vip-push-mark-silent (&optional location)
   "Set mark at LOCATION (point, by default) and push old mark on mark ring.
diff --git a/lisp/info.el b/lisp/info.el
index 163e0af161a..26ee67fc1fb 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -2854,7 +2854,7 @@ N is the digit argument used to invoke this command."
 		      (Info-extract-menu-node-name)))))
 
 (defmacro Info-no-error (&rest body)
-  (list 'condition-case nil (cons 'progn (append body '(t))) '(error nil)))
+  `(condition-case nil (progn ,@body t) (error nil)))
 
 (defun Info-next-preorder ()
   "Go to the next subnode or the next node, or go up a level."
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 75814fb7f67..010b4edfb05 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -637,11 +637,11 @@ FNAME is the minor mode's name (variable and function).
 DOC is the text to use for the menu entry.
 HELP is the text to use for the tooltip.
 PROPS are additional properties."
-  `(list 'menu-item ,doc ',fname
-	 ,@(mapcar (lambda (p) (list 'quote p)) props)
-	 :help ,help
-	 :button '(:toggle . (and (default-boundp ',fname)
-				  (default-value ',fname)))))
+  `'(menu-item ,doc ,fname
+	       ,@props
+	       :help ,help
+	       :button (:toggle . (and (default-boundp ',fname)
+				       (default-value ',fname)))))
 
 (defmacro menu-bar-make-toggle (name variable doc message help &rest body)
   `(progn
@@ -664,10 +664,10 @@ by \"Save Options\" in Custom buffers.")
        ;; a candidate for "Save Options", and we do not want to save options
        ;; the user have already set explicitly in his init file.
        (if interactively (customize-mark-as-set ',variable)))
-     (list 'menu-item ,doc ',name
-	   :help ,help
-	   :button '(:toggle . (and (default-boundp ',variable)
-				    (default-value ',variable))))))
+     '(menu-item ,doc ,name
+		 :help ,help
+		 :button (:toggle . (and (default-boundp ',variable)
+					 (default-value ',variable))))))
 
 ;; Function for setting/saving default font.
 
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 76d03dd164f..a545f313650 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -1790,7 +1790,7 @@ info-variant-part."
 ;;
 (defmacro artist-funcall (fn &rest args)
   "Call function FN with ARGS, if FN is not nil."
-  (list 'if fn (cons 'funcall (cons fn args))))
+  `(if ,fn (funcall ,fn ,@args)))
 
 (defun artist-uniq (l)
   "Remove consecutive duplicates in list L.  Comparison is done with `equal'."
@@ -2384,8 +2384,8 @@ in the coord."
 ;;
 (defmacro artist-put-pixel (point-list x y)
   "In POINT-LIST, store a ``pixel'' at coord X,Y."
-  (list 'setq point-list
-	(list 'append point-list (list 'list (list 'artist-new-coord x y)))))
+  `(setq ,point-list
+	 (append ,point-list (list (artist-new-coord ,x ,y)))))
 
 ;; Calculate list of points using eight point algorithm
 ;; return a list of coords