More CL cleanups and reduction of use of cl.el.

* woman.el, winner.el, vc/vc-rcs.el, vc/vc-hooks.el, vc/vc-hg.el:
* vc/vc-git.el, vc/vc-dir.el, vc/vc-bzr.el, vc/vc-annotate.el:
* textmodes/tex-mode.el, textmodes/sgml-mode.el, tar-mode.el:
* strokes.el, ses.el, server.el, progmodes/js.el, progmodes/gdb-mi.el:
* progmodes/flymake.el, progmodes/ebrowse.el, progmodes/compile.el:
* play/tetris.el, play/snake.el, play/pong.el, play/landmark.el:
* play/hanoi.el, play/decipher.el, play/5x5.el, nxml/nxml-mode.el:
* net/secrets.el, net/quickurl.el, midnight.el, mail/footnote.el:
* image-dired.el, ibuffer.el, ibuf-macs.el, ibuf-ext.el, hexl.el:
* eshell/eshell.el, eshell/esh-io.el, eshell/esh-ext.el:
* eshell/esh-cmd.el, eshell/em-ls.el, eshell/em-hist.el:
* eshell/em-cmpl.el, eshell/em-banner.el:
* url/url.el, url/url-queue.el, url/url-parse.el, url/url-http.el:
* url/url-future.el, url/url-dav.el, url/url-cookie.el:
* calendar/parse-time.el, test/eshell.el: Use cl-lib.
* wid-browse.el, wdired.el, vc/vc.el, vc/vc-mtn.el, vc/vc-cvs.el:
* vc/vc-arch.el, tree-widget.el, textmodes/texinfo.el:
* textmodes/refill.el, textmodes/css-mode.el, term/tvi970.el:
* term/ns-win.el, term.el, shell.el, ps-samp.el:
* progmodes/perl-mode.el, progmodes/pascal.el, progmodes/gud.el:
* progmodes/glasses.el, progmodes/etags.el, progmodes/cwarn.el:
* play/gamegrid.el, play/bubbles.el, novice.el, notifications.el:
* net/zeroconf.el, net/xesam.el, net/snmp-mode.el, net/mairix.el:
* net/ldap.el, net/eudc.el, net/browse-url.el, man.el:
* mail/mailheader.el, mail/feedmail.el:
* url/url-util.el, url/url-privacy.el, url/url-nfs.el, url/url-misc.el:
* url/url-methods.el, url/url-gw.el, url/url-file.el, url/url-expand.el:
Dont use CL.
* ibuf-ext.el (ibuffer-mark-old-buffers): Use float-time.
* eshell/esh-opt.el (eshell-eval-using-options): Quote code with
`lambda' rather than with `quote'.
(eshell-do-opt): Adjust accordingly.
(eshell-process-option): Simplify.
* eshell/esh-var.el:
* eshell/em-script.el: Require `esh-opt' for eshell-eval-using-options.
* emacs-pcase.el (pcase--dontcare-upats, pcase--let*)
(pcase--expand, pcase--u1): Rename pcase's internal `dontcare' pattern
to `pcase--dontcare'.
* emacs-cl.el (labels): Mark obsolete.
(cl--letf, letf): Move to cl-lib.
(cl--letf*, letf*): Remove.
* emacs-cl-lib.el (cl-nth-value): Use defalias.
* emacs-cl-macs.el (cl-dolist, cl-dotimes): Add indent rule.
(cl-progv): Rewrite.
(cl--letf, cl-letf): Move from cl.el.
(cl-letf*): New macro.
* emacs-cl-extra.el (cl--progv-before, cl--progv-after): Remove.

3 files changed, 127 insertions, 104 deletions

diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index df18abbc53..c6d1d22878 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -372,8 +372,7 @@
 (require 'mail-utils)		     ; pick up mail-strip-quoted-names
 
 (eval-when-compile
-  (require 'smtpmail)
-  (require 'cl))
+  (require 'smtpmail))
 
 (autoload 'mail-do-fcc "sendmail")
 
@@ -1951,9 +1950,6 @@ bail out with an appropriate answer to the global confirmation prompt."
   (feedmail-say-debug ">in-> feedmail-run-the-queue-global-prompts")
   (let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg)))
 
-;; letf fools the byte-compiler.
-(defvar file-name-buffer-file-type-alist)
-
 ;;;###autoload
 (defun feedmail-run-the-queue (&optional arg)
   "Visit each message in the feedmail queue directory and send it out.
@@ -2392,8 +2388,10 @@ mapped to mostly alphanumerics for safety."
 (defun feedmail-send-it-immediately ()
   "Handle immediate sending, including during a queue run."
   (feedmail-say-debug ">in-> feedmail-send-it-immediately")
-  (let ((feedmail-error-buffer (get-buffer-create " *FQM Outgoing Email Errors*"))
-	(feedmail-prepped-text-buffer (get-buffer-create " *FQM Outgoing Email Text*"))
+  (let ((feedmail-error-buffer
+         (get-buffer-create " *FQM Outgoing Email Errors*"))
+	(feedmail-prepped-text-buffer
+         (get-buffer-create " *FQM Outgoing Email Text*"))
 	(feedmail-raw-text-buffer (current-buffer))
 	(feedmail-address-list)
 	(eoh-marker)
@@ -2405,7 +2403,7 @@ mapped to mostly alphanumerics for safety."
 	(a-re-dtcb  "^\\(To\\|Cc\\|Bcc\\):")
 	(a-re-dtc   "^\\(To\\|Cc\\):")
 	(a-re-db    "^Bcc:")
-	;; to get a temporary changeable copy
+	;; To get a temporary changeable copy.
 	(mail-header-separator mail-header-separator)
 	)
     (unwind-protect
@@ -2413,10 +2411,10 @@ mapped to mostly alphanumerics for safety."
 	  (set-buffer feedmail-error-buffer) (erase-buffer)
 	  (set-buffer feedmail-prepped-text-buffer) (erase-buffer)
 
-	  ;; jam contents of user-supplied mail buffer into our scratch buffer
+	  ;; Jam contents of user-supplied mail buffer into our scratch buffer.
 	  (insert-buffer-substring feedmail-raw-text-buffer)
 
-	  ;; require one newline at the end.
+	  ;; Require one newline at the end.
 	  (goto-char (point-max))
 	  (or (= (preceding-char) ?\n) (insert ?\n))
 
@@ -2437,54 +2435,69 @@ mapped to mostly alphanumerics for safety."
 		  (and (fboundp 'expand-mail-aliases) mail-aliases))
 	      (expand-mail-aliases (point-min) eoh-marker))
 
-	  ;; make it pretty
+	  ;; Make it pretty.
 	  (if feedmail-fill-to-cc (feedmail-fill-to-cc-function eoh-marker))
-	  ;; ignore any blank lines in the header
+	  ;; Ignore any blank lines in the header.
 	  (goto-char (point-min))
-	  (while (and (re-search-forward "\n\n\n*" eoh-marker t) (< (point) eoh-marker))
+	  (while (and (re-search-forward "\n\n\n*" eoh-marker t)
+                      (< (point) eoh-marker))
 	    (replace-match "\n"))
 
 	  (let ((case-fold-search t) (addr-regexp))
 	    (goto-char (point-min))
-	    ;; there are some RFC-822 combinations/cases missed here,
-	    ;; but probably good enough and what users expect
+	    ;; There are some RFC-822 combinations/cases missed here,
+	    ;; but probably good enough and what users expect.
 	    ;;
-	    ;; use resent-* stuff only if there is at least one non-empty one
+	    ;; Use resent-* stuff only if there is at least one non-empty one.
 	    (setq feedmail-is-a-resend
 		  (re-search-forward
-		   ;; header name, followed by optional whitespace, followed by
-		   ;; non-whitespace, followed by anything, followed by newline;
-		   ;; the idea is empty Resent-* headers are ignored
+		   ;; Header name, followed by optional whitespace, followed by
+		   ;; non-whitespace, followed by anything, followed by
+                   ;; newline; the idea is empty Resent-* headers are ignored.
 		   "^\\(Resent-To:\\|Resent-Cc:\\|Resent-Bcc:\\)\\s-*\\S-+.*$"
 		   eoh-marker t))
-	    ;; if we say so, gather the Bcc stuff before the main course
-	    (if (eq feedmail-deduce-bcc-where 'first)
-		(progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
-		       (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
-	    ;; the main course
-	    (if (or (eq feedmail-deduce-bcc-where 'first) (eq feedmail-deduce-bcc-where 'last))
-		;; handled by first or last cases, so don't get Bcc stuff
-		(progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtc) (setq addr-regexp a-re-dtc))
-		       (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list)))
-	      ;; not handled by first or last cases, so also get Bcc stuff
-	      (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtcb) (setq addr-regexp a-re-dtcb))
-		     (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
-	    ;; if we say so, gather the Bcc stuff after the main course
-	    (if (eq feedmail-deduce-bcc-where 'last)
-		(progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
-		       (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
-	    (if (not feedmail-address-list) (error "FQM: Sending...abandoned, no addressees"))
-	    ;; not needed, but meets user expectations
+	    ;; If we say so, gather the Bcc stuff before the main course.
+	    (when (eq feedmail-deduce-bcc-where 'first)
+              (setq addr-regexp (if feedmail-is-a-resend a-re-rb a-re-db))
+              (setq feedmail-address-list
+                    (feedmail-deduce-address-list
+                     feedmail-prepped-text-buffer (point-min) eoh-marker
+                     addr-regexp feedmail-address-list)))
+	    ;; The main course.
+            (setq addr-regexp
+                  (if (memq feedmail-deduce-bcc-where '(first last))
+                      ;; Handled by first or last cases, so don't get
+                      ;; Bcc stuff.
+                      (if feedmail-is-a-resend a-re-rtc a-re-dtc)
+                    ;; Not handled by first or last cases, so also get
+                    ;; Bcc stuff.
+                    (if feedmail-is-a-resend a-re-rtcb a-re-dtcb)))
+            (setq feedmail-address-list
+                  (feedmail-deduce-address-list
+                   feedmail-prepped-text-buffer (point-min) eoh-marker
+                   addr-regexp feedmail-address-list))
+	    ;; If we say so, gather the Bcc stuff after the main course.
+	    (when (eq feedmail-deduce-bcc-where 'last)
+              (setq addr-regexp (if feedmail-is-a-resend a-re-rb a-re-db))
+              (setq feedmail-address-list
+                    (feedmail-deduce-address-list
+                     feedmail-prepped-text-buffer (point-min) eoh-marker
+                     addr-regexp feedmail-address-list)))
+	    (if (not feedmail-address-list)
+                (error "FQM: Sending...abandoned, no addressees"))
+	    ;; Not needed, but meets user expectations.
 	    (setq feedmail-address-list (nreverse feedmail-address-list))
 	    ;; Find and handle any Bcc fields.
-	    (setq bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Bcc:"))
-	    (setq resent-bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:"))
-	    (if (and bcc-holder (not feedmail-nuke-bcc))
-		(progn (goto-char (point-min))
-		       (insert bcc-holder)))
-	    (if (and resent-bcc-holder (not feedmail-nuke-resent-bcc))
-		(progn (goto-char (point-min))
-		       (insert resent-bcc-holder)))
+	    (setq bcc-holder
+                  (feedmail-accume-n-nuke-header eoh-marker "^Bcc:"))
+	    (setq resent-bcc-holder
+                  (feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:"))
+	    (when (and bcc-holder (not feedmail-nuke-bcc))
+              (goto-char (point-min))
+              (insert bcc-holder))
+	    (when (and resent-bcc-holder (not feedmail-nuke-resent-bcc))
+              (goto-char (point-min))
+              (insert resent-bcc-holder))
 	    (goto-char (point-min))
 
 	    ;; fiddle about, fiddle about, fiddle about....
@@ -2492,16 +2505,20 @@ mapped to mostly alphanumerics for safety."
 	    (feedmail-fiddle-sender)
 	    (feedmail-fiddle-x-mailer)
 	    (feedmail-fiddle-message-id
-	     (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
+	     (or feedmail-queue-runner-is-active
+                 (buffer-file-name feedmail-raw-text-buffer)))
 	    (feedmail-fiddle-date
-	     (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
-	    (feedmail-fiddle-list-of-fiddle-plexes feedmail-fiddle-plex-user-list)
+	     (or feedmail-queue-runner-is-active
+                 (buffer-file-name feedmail-raw-text-buffer)))
+	    (feedmail-fiddle-list-of-fiddle-plexes
+             feedmail-fiddle-plex-user-list)
 
 	    ;; don't send out a blank headers of various sorts
 	    ;; (this loses on continued line with a blank first line)
 	    (goto-char (point-min))
 	    (and feedmail-nuke-empty-headers ; hey, who's an empty-header?
-		 (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" eoh-marker t)
+		 (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n"
+                                           eoh-marker t)
 		   (replace-match ""))))
 
 	  (feedmail-say-debug "last chance hook: %s" feedmail-last-chance-hook)
@@ -2513,79 +2530,90 @@ mapped to mostly alphanumerics for safety."
 		(confirm (cond
 			  ((eq feedmail-confirm-outgoing 'immediate)
 			   (not feedmail-queue-runner-is-active))
-			  ((eq feedmail-confirm-outgoing 'queued) feedmail-queue-runner-is-active)
+			  ((eq feedmail-confirm-outgoing 'queued)
+                           feedmail-queue-runner-is-active)
 			  (t feedmail-confirm-outgoing)))
 		(fullframe (cond
 			    ((eq feedmail-display-full-frame 'immediate)
 			     (not feedmail-queue-runner-is-active))
-			    ((eq feedmail-display-full-frame 'queued) feedmail-queue-runner-is-active)
+			    ((eq feedmail-display-full-frame 'queued)
+                             feedmail-queue-runner-is-active)
 			    (t feedmail-display-full-frame))))
 	    (if fullframe
 		(progn
 		  (switch-to-buffer feedmail-prepped-text-buffer t)
 		  (delete-other-windows)))
-	    (if (or (not confirm) (feedmail-one-last-look feedmail-prepped-text-buffer))
-		(let ((user-mail-address (feedmail-envelope-deducer eoh-marker)))
+	    (if (or (not confirm)
+                    (feedmail-one-last-look feedmail-prepped-text-buffer))
+		(let ((user-mail-address
+                       (feedmail-envelope-deducer eoh-marker)))
 		  (feedmail-say-debug "give it to buffer-eater")
 		  (feedmail-give-it-to-buffer-eater)
 		  (feedmail-say-debug "gave it to buffer-eater")
-		  (if (and (not feedmail-queue-runner-is-active) (setq also-file (buffer-file-name feedmail-raw-text-buffer)))
-		      (progn		; if a file but not running the queue, offer to delete it
+		  (if (and (not feedmail-queue-runner-is-active)
+                           (setq also-file
+                                 (buffer-file-name feedmail-raw-text-buffer)))
+		      (progn
+                        ;; If a file but not running the queue,
+                        ;; offer to delete it
 			(setq also-file (expand-file-name also-file))
 			(when (or feedmail-queue-auto-file-nuke
                                   (y-or-n-p
                                    (format "FQM: Delete message file %s? "
                                            also-file)))
-                          ;; if we delete the affiliated file, get rid
+                          ;; If we delete the affiliated file, get rid
                           ;; of the file name association and make sure we
-                          ;; don't annoy people with a prompt on exit
+                          ;; don't annoy people with a prompt on exit.
                           (delete-file also-file)
                           (with-current-buffer feedmail-raw-text-buffer
                             (setq buffer-offer-save nil)
                             (setq buffer-file-name nil)))))
 		  (goto-char (point-min))
-		  ;; re-insert and handle any Fcc fields (and, optionally, any Bcc).
-		  (if fcc (letf (((default-value 'buffer-file-type)
-                                  feedmail-force-binary-write))
-			    (insert fcc)
-			    (if (not feedmail-nuke-bcc-in-fcc)
-				(progn (if bcc-holder (insert bcc-holder))
-				       (if resent-bcc-holder (insert resent-bcc-holder))))
-
-			    (run-hooks 'feedmail-before-fcc-hook)
-
-			    (if feedmail-nuke-body-in-fcc
-				(progn (goto-char eoh-marker)
-				       (if (natnump feedmail-nuke-body-in-fcc)
-					   (forward-line feedmail-nuke-body-in-fcc))
-				       (delete-region (point) (point-max))
-				       ))
-			    (mail-do-fcc eoh-marker)
-			    )))
-	      ;; user bailed out of one-last-look
+		  ;; Re-insert and handle any Fcc fields (and, optionally,
+                  ;; any Bcc).
+		  (when fcc
+                    (let ((old (default-value 'buffer-file-type)))
+                      (unwind-protect
+                          (progn
+                            (setq-default buffer-file-type 
+                                          feedmail-force-binary-write)
+                            (insert fcc)
+                            (unless feedmail-nuke-bcc-in-fcc
+                              (if bcc-holder (insert bcc-holder))
+                              (if resent-bcc-holder
+                                  (insert resent-bcc-holder)))
+                          
+                            (run-hooks 'feedmail-before-fcc-hook)
+                          
+                            (when feedmail-nuke-body-in-fcc
+                              (goto-char eoh-marker)
+                              (if (natnump feedmail-nuke-body-in-fcc)
+                                  (forward-line feedmail-nuke-body-in-fcc))
+                              (delete-region (point) (point-max)))
+                            (mail-do-fcc eoh-marker))
+                        (setq-default buffer-file-type old)))))
+	      ;; User bailed out of one-last-look.
 	      (if feedmail-queue-runner-is-active
 		  (throw 'skip-me-q 'skip-me-q)
 		(throw 'skip-me-i 'skip-me-i))
 	      )))) ; unwind-protect body (save-excursion)
 
-      ;; unwind-protect cleanup forms
+      ;; unwind-protect cleanup forms.
       (kill-buffer feedmail-prepped-text-buffer)
       (set-buffer feedmail-error-buffer)
       (if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer)
-	(progn (display-buffer feedmail-error-buffer)
-	       ;; read fast ... the meter is running
-	       (if feedmail-queue-runner-is-active
-		   (progn
-		     (ding t)
-		     (feedmail-say-chatter "Sending...failed")))
-	       (error "FQM: Sending...failed")))
+        (display-buffer feedmail-error-buffer)
+        ;; Read fast ... the meter is running.
+        (if feedmail-queue-runner-is-active
+            (progn
+              (ding t)
+              (feedmail-say-chatter "Sending...failed")))
+        (error "FQM: Sending...failed"))
       (set-buffer feedmail-raw-text-buffer))
     )					; let
-  (if (and feedmail-queue-chatty (not feedmail-queue-runner-is-active))
-      (progn
-	(feedmail-queue-reminder 'after-immediate)
-	(sit-for feedmail-queue-chatty-sit-for)))
-  )
+  (when (and feedmail-queue-chatty (not feedmail-queue-runner-is-active))
+    (feedmail-queue-reminder 'after-immediate)
+    (sit-for feedmail-queue-chatty-sit-for)))
 
 
 (defun feedmail-fiddle-header (name value &optional action folding)
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index f0c6b21513..e342e0ae97 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -35,9 +35,8 @@
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl)
-  (defvar filladapt-token-table))
+(eval-when-compile (require 'cl-lib))
+(defvar filladapt-token-table)
 
 (defgroup footnote nil
   "Support for footnotes in mail and news messages."
@@ -644,12 +643,12 @@ If the variable `footnote-narrow-to-footnotes-when-editing' is set,
 the buffer is narrowed to the footnote body.  The restriction is removed
 by using `Footnote-back-to-message'."
   (interactive "*P")
-  (let (num)
-    (if footnote-text-marker-alist
-	(if (< (point) (cadar (last footnote-pointer-marker-alist)))
-	    (setq num (Footnote-make-hole))
-	  (setq num (1+ (caar (last footnote-text-marker-alist)))))
-      (setq num 1))
+  (let ((num
+         (if footnote-text-marker-alist
+             (if (< (point) (cl-cadar (last footnote-pointer-marker-alist)))
+                 (Footnote-make-hole)
+               (1+ (caar (last footnote-text-marker-alist))))
+           1)))
     (message "Adding footnote %d" num)
     (Footnote-insert-footnote num)
     (insert-before-markers (make-string footnote-body-tag-spacing ? ))
diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el
index 1c917a05df..6adcb25904 100644
--- a/lisp/mail/mailheader.el
+++ b/lisp/mail/mailheader.el
@@ -45,9 +45,6 @@
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl))
-
 (defun mail-header-extract ()
   "Extract headers from current buffer after point.
 Returns a header alist, where each element is a cons cell (name . value),
@@ -110,6 +107,8 @@ If the value is a string, it is the original value of the header.  If the
 value is a list, its first element is the original value of the header,
 with any subsequent elements being the result of parsing the value.
 If HEADER-ALIST is nil, the dynamically bound variable `headers' is used."
+  (declare (gv-setter (lambda (value)
+                        `(mail-header-set ,header ,value ,header-alist))))
   (cdr (assq header (or header-alist headers))))
 
 (defun mail-header-set (header value &optional header-alist)
@@ -123,9 +122,6 @@ See `mail-header' for the semantics of VALUE."
 	(nconc alist (list (cons header value)))))
   value)
 
-(defsetf mail-header (header &optional header-alist) (value)
-  `(mail-header-set ,header ,value ,header-alist))
-
 (defun mail-header-merge (merge-rules headers)
   "Return a new header alist with MERGE-RULES applied to HEADERS.
 MERGE-RULES is an alist whose keys are header names (symbols) and whose