Index: Makefile
===================================================================
RCS file: /usr0/freebsd/cvsroot/ports/editors/apel/Makefile,v
retrieving revision 1.58
diff -u -r1.58 Makefile
--- Makefile	1 Aug 2012 16:50:15 -0000	1.58
+++ Makefile	24 Aug 2012 00:35:40 -0000
@@ -7,7 +7,7 @@
 
 PORTNAME=	apel
 PORTVERSION=	${APEL_VER}
-PORTREVISION=	6
+PORTREVISION=	7
 CATEGORIES=	editors elisp
 MASTER_SITES=	http://kanji.zinbun.kyoto-u.ac.jp/~tomo/lemi/dist/apel/
 PKGNAMESUFFIX=	-${EMACS_PORT_NAME}
Index: files/patch-broken.el
===================================================================
RCS file: files/patch-broken.el
diff -N files/patch-broken.el
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ files/patch-broken.el	24 Aug 2012 00:34:45 -0000
@@ -0,0 +1,84 @@
+Index: broken.el
+===================================================================
+--- broken.el	(revision 2)
++++ broken.el	(working copy)
+@@ -58,51 +58,51 @@
+ 
+ If ASSERTION is not omitted and evaluated to nil and NO-NOTICE is nil,
+ it is noticed."
+-  (` (static-if (, assertion)
+-	 (eval-and-compile
+-	   (broken-facility-internal '(, facility) (, docstring) t))
+-       (eval-when-compile
+-	 (when (and '(, assertion) (not '(, no-notice))
+-		    notice-non-obvious-broken-facility)
+-	   (message "BROKEN FACILITY DETECTED: %s" (, docstring)))
+-	 nil)
+-       (eval-and-compile
+-	 (broken-facility-internal '(, facility) (, docstring) nil)))))
++  `(static-if ,assertion
++	      (eval-and-compile
++		(broken-facility-internal ',facility ,docstring t))
++	      (eval-when-compile
++		(when (and ',assertion (not ',no-notice)
++			   notice-non-obvious-broken-facility)
++		  (message "BROKEN FACILITY DETECTED: %s" ,docstring))
++		nil)
++	      (eval-and-compile
++		(broken-facility-internal ',facility ,docstring nil))))
+ 
+ (put 'if-broken 'lisp-indent-function 2)
+ (defmacro if-broken (facility then &rest else)
+   "If FACILITY is broken, expand to THEN, otherwise (progn . ELSE)."
+-  (` (static-if (broken-p '(, facility))
+-	 (, then)
+-       (,@ else))))
++  `(static-if (broken-p ',facility)
++	      ,then
++	      ,@else))
+ 
+ 
+ (put 'when-broken 'lisp-indent-function 1)
+ (defmacro when-broken (facility &rest body)
+   "If FACILITY is broken, expand to (progn . BODY), otherwise nil."
+-  (` (static-when (broken-p '(, facility))
+-       (,@ body))))
++  `(static-when (broken-p ',facility)
++		,@body))
+ 
+ (put 'unless-broken 'lisp-indent-function 1)
+ (defmacro unless-broken (facility &rest body)
+   "If FACILITY is not broken, expand to (progn . BODY), otherwise nil."
+-  (` (static-unless (broken-p '(, facility))
+-       (,@ body))))
++  `(static-unless (broken-p ',facility)
++		  ,@body))
+ 
+ (defmacro check-broken-facility (facility)
+   "Check FACILITY is broken or not. If the status is different on
+ compile(macro expansion) time and run time, warn it."
+-  (` (if-broken (, facility)
+-	 (unless (broken-p '(, facility))
+-	   (message "COMPILE TIME ONLY BROKEN FACILITY DETECTED: %s" 
+-		    (or
+-		     '(, (broken-facility-description facility))
+-		     (broken-facility-description '(, facility)))))
+-       (when (broken-p '(, facility))
+-	 (message "RUN TIME ONLY BROKEN FACILITY DETECTED: %s" 
+-		  (or
+-		   (broken-facility-description '(, facility))
+-		   '(, (broken-facility-description facility))))))))
++  `(if-broken ,facility
++	      (unless (broken-p ',facility)
++		(message "COMPILE TIME ONLY BROKEN FACILITY DETECTED: %s" 
++			 (or
++			  ',(broken-facility-description facility)
++			  (broken-facility-description ',facility))))
++	      (when (broken-p ',facility)
++		(message "RUN TIME ONLY BROKEN FACILITY DETECTED: %s" 
++			 (or
++			  (broken-facility-description ',facility)
++			  ',(broken-facility-description facility))))))
+ 
+ 
+ ;;; @ end
Index: files/patch-filename.el
===================================================================
RCS file: files/patch-filename.el
diff -N files/patch-filename.el
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ files/patch-filename.el	24 Aug 2012 00:34:46 -0000
@@ -0,0 +1,51 @@
+Index: filename.el
+===================================================================
+--- filename.el	(revision 2)
++++ filename.el	(working copy)
+@@ -102,26 +102,26 @@
+ 		inc-i '(1+ i))
+ 	(setq sref 'aref
+ 	      inc-i '(+ i (char-length chr))))
+-      (` (let ((len (length (, string)))
+-	       (b 0)(i 0)
+-	       (dest ""))
+-	   (while (< i len)
+-	     (let ((chr ((, sref) (, string) i))
+-		   (lst filename-replacement-alist)
+-		   ret)
+-	       (while (and lst (not ret))
+-		 (if (if (functionp (car (car lst)))
+-			 (setq ret (funcall (car (car lst)) chr))
+-		       (setq ret (memq chr (car (car lst)))))
+-		     t			; quit this loop.
+-		   (setq lst (cdr lst))))
+-	       (if ret
+-		   (setq dest (concat dest (substring (, string) b i)
+-				      (cdr (car lst)))
+-			 i (, inc-i)
+-			 b i)
+-		 (setq i (, inc-i)))))
+-	   (concat dest (substring (, string) b)))))))
++      `(let ((len (length ,string))
++	     (b 0)(i 0)
++	     (dest ""))
++	 (while (< i len)
++	   (let ((chr (,sref ,string i))
++		 (lst filename-replacement-alist)
++		 ret)
++	     (while (and lst (not ret))
++	       (if (if (functionp (car (car lst)))
++		       (setq ret (funcall (car (car lst)) chr))
++		     (setq ret (memq chr (car (car lst)))))
++		   t			; quit this loop.
++		 (setq lst (cdr lst))))
++	     (if ret
++		 (setq dest (concat dest (substring ,string b i)
++				    (cdr (car lst)))
++		       i ,inc-i
++		       b i)
++	       (setq i ,inc-i))))
++	 (concat dest (substring ,string b))))))
+ 
+ (defun filename-special-filter (string)
+   (filename-special-filter-1 string))
Index: files/patch-pccl.el
===================================================================
RCS file: files/patch-pccl.el
diff -N files/patch-pccl.el
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ files/patch-pccl.el	24 Aug 2012 00:34:46 -0000
@@ -0,0 +1,268 @@
+Index: pccl.el
+===================================================================
+--- pccl.el	(revision 2)
++++ pccl.el	(working copy)
+@@ -27,138 +27,138 @@
+ (require 'broken)
+ 
+ (broken-facility ccl-usable
+-  "Emacs has not CCL."
+-  (and (featurep 'mule)
+-       (if (featurep 'xemacs)
+-           (>= emacs-major-version 21)
+-         (>= emacs-major-version 19))))
++		 "Emacs has not CCL."
++		 (and (featurep 'mule)
++		      (if (featurep 'xemacs)
++			  (>= emacs-major-version 21)
++			(>= emacs-major-version 19))))
+ 
+ (unless-broken ccl-usable
+-  (require 'advice)
++	       (require 'advice)
+ 
+-  (if (featurep 'mule)
+-      (progn
+-	(require 'ccl)
+-	(if (featurep 'xemacs)
+-            (if (>= emacs-major-version 21)
+-                ;; for XEmacs 21 with mule
+-                (require 'pccl-20))
+-          (if (>= emacs-major-version 20)
+-              ;; for Emacs 20
+-              (require 'pccl-20)
+-            ;; for Mule 2.*
+-            (require 'pccl-om)))))
++	       (if (featurep 'mule)
++		   (progn
++		     (require 'ccl)
++		     (if (featurep 'xemacs)
++			 (if (>= emacs-major-version 21)
++			     ;; for XEmacs 21 with mule
++			     (require 'pccl-20))
++		       (if (>= emacs-major-version 20)
++			   ;; for Emacs 20
++			   (require 'pccl-20)
++			 ;; for Mule 2.*
++			 (require 'pccl-om)))))
+ 
+-  (static-if (or (featurep 'xemacs) (< emacs-major-version 21))
+-    (defadvice define-ccl-program
+-      (before accept-long-ccl-program activate)
+-      "When CCL-PROGRAM is too long, internal buffer is extended automatically."
+-      (let ((try-ccl-compile t)
+-	    (prog (eval (ad-get-arg 1))))
+-	(ad-set-arg 1 (` '(, prog)))
+-	(while try-ccl-compile
+-	  (setq try-ccl-compile nil)
+-	  (condition-case sig
+-	      (ccl-compile prog)
+-	    (args-out-of-range
+-	     (if (and (eq (car (cdr sig)) ccl-program-vector)
+-		      (= (car (cdr (cdr sig))) (length ccl-program-vector)))
+-		 (setq ccl-program-vector
+-		       (make-vector (* 2 (length ccl-program-vector)) 0)
+-		       try-ccl-compile t)
+-	       (signal (car sig) (cdr sig)))))))))
++	       (static-if (or (featurep 'xemacs) (< emacs-major-version 21))
++			  (defadvice define-ccl-program
++			    (before accept-long-ccl-program activate)
++			    "When CCL-PROGRAM is too long, internal buffer is extended automatically."
++			    (let ((try-ccl-compile t)
++				  (prog (eval (ad-get-arg 1))))
++			      (ad-set-arg 1 `',prog)
++			      (while try-ccl-compile
++				(setq try-ccl-compile nil)
++				(condition-case sig
++				    (ccl-compile prog)
++				  (args-out-of-range
++				   (if (and (eq (car (cdr sig)) ccl-program-vector)
++					    (= (car (cdr (cdr sig))) (length ccl-program-vector)))
++				       (setq ccl-program-vector
++					     (make-vector (* 2 (length ccl-program-vector)) 0)
++					     try-ccl-compile t)
++				     (signal (car sig) (cdr sig)))))))))
+ 
+-  (static-when (and (not (featurep 'xemacs)) (< emacs-major-version 21))
+-    (defun-maybe transform-make-coding-system-args (name type &optional doc-string props)
+-      "For internal use only.
++	       (static-when (and (not (featurep 'xemacs)) (< emacs-major-version 21))
++			    (defun-maybe transform-make-coding-system-args (name type &optional doc-string props)
++			      "For internal use only.
+ Transform XEmacs style args for `make-coding-system' to Emacs style.
+ Value is a list of transformed arguments."
+-      (let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?")))
+-	    (eol-type (plist-get props 'eol-type))
+-	    properties tmp)
+-	(cond
+-	 ((eq eol-type 'lf) (setq eol-type 'unix))
+-	 ((eq eol-type 'crlf) (setq eol-type 'dos))
+-	 ((eq eol-type 'cr) (setq eol-type 'mac)))
+-	(if (setq tmp (plist-get props 'post-read-conversion))
+-	    (setq properties (plist-put properties 'post-read-conversion tmp)))
+-	(if (setq tmp (plist-get props 'pre-write-conversion))
+-	    (setq properties (plist-put properties 'pre-write-conversion tmp)))
+-	(cond
+-	 ((eq type 'shift-jis)
+-	  (` ((, name) 1 (, mnemonic) (, doc-string)
+-	      nil (, properties) (, eol-type))))
+-	 ((eq type 'iso2022) ; This is not perfect.
+-	  (if (plist-get props 'escape-quoted)
+-	      (error "escape-quoted is not supported: %S"
+-		     (` ((, name) (, type) (, doc-string) (, props)))))
+-	  (let ((g0 (plist-get props 'charset-g0))
+-		(g1 (plist-get props 'charset-g1))
+-		(g2 (plist-get props 'charset-g2))
+-		(g3 (plist-get props 'charset-g3))
+-		(use-roman
+-		 (and
+-		  (eq (cadr (assoc 'latin-jisx0201
+-				   (plist-get props 'input-charset-conversion)))
+-		      'ascii)
+-		  (eq (cadr (assoc 'ascii
+-				   (plist-get props 'output-charset-conversion)))
+-		      'latin-jisx0201)))
+-		(use-oldjis
+-		 (and
+-		  (eq (cadr (assoc 'japanese-jisx0208-1978
+-				   (plist-get props 'input-charset-conversion)))
+-		      'japanese-jisx0208)
+-		  (eq (cadr (assoc 'japanese-jisx0208
+-				   (plist-get props 'output-charset-conversion)))
+-		      'japanese-jisx0208-1978))))
+-	    (if (charsetp g0)
+-		(if (plist-get props 'force-g0-on-output)
+-		    (setq g0 (` (nil (, g0))))
+-		  (setq g0 (` ((, g0) t)))))
+-	    (if (charsetp g1)
+-		(if (plist-get props 'force-g1-on-output)
+-		    (setq g1 (` (nil (, g1))))
+-		  (setq g1 (` ((, g1) t)))))
+-	    (if (charsetp g2)
+-		(if (plist-get props 'force-g2-on-output)
+-		    (setq g2 (` (nil (, g2))))
+-		  (setq g2 (` ((, g2) t)))))
+-	    (if (charsetp g3)
+-		(if (plist-get props 'force-g3-on-output)
+-		    (setq g3 (` (nil (, g3))))
+-		  (setq g3 (` ((, g3) t)))))
+-	    (` ((, name) 2 (, mnemonic) (, doc-string)
+-		((, g0) (, g1) (, g2) (, g3)
+-		 (, (plist-get props 'short))
+-		 (, (not (plist-get props 'no-ascii-eol)))
+-		 (, (not (plist-get props 'no-ascii-cntl)))
+-		 (, (plist-get props 'seven))
+-		 t
+-		 (, (not (plist-get props 'lock-shift)))
+-		 (, use-roman)
+-		 (, use-oldjis)
+-		 (, (plist-get props 'no-iso6429))
+-		 nil nil nil nil)
+-		(, properties) (, eol-type)))))
+-	 ((eq type 'big5)
+-	  (` ((, name) 3 (, mnemonic) (, doc-string)
+-	      nil (, properties) (, eol-type))))
+-	 ((eq type 'ccl)
+-	  (` ((, name) 4 (, mnemonic) (, doc-string)
+-	      ((, (plist-get props 'decode)) . (, (plist-get props 'encode)))
+-	      (, properties) (, eol-type))))
+-	 (t
+-	  (error "unsupported XEmacs style make-coding-style arguments: %S"
+-		 (` ((, name) (, type) (, doc-string) (, props))))))))
+-    (defadvice make-coding-system
+-      (before ccl-compat (name type &rest ad-subr-args) activate)
+-      "Emulate XEmacs style make-coding-system."
+-      (when (and (symbolp type) (not (memq type '(t nil))))
+-        (let ((args (apply 'transform-make-coding-system-args
+-	                   name type ad-subr-args)))
+-	  (setq type (cadr args)
+-	        ad-subr-args (cddr args)))))))
++			      (let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?")))
++				    (eol-type (plist-get props 'eol-type))
++				    properties tmp)
++				(cond
++				 ((eq eol-type 'lf) (setq eol-type 'unix))
++				 ((eq eol-type 'crlf) (setq eol-type 'dos))
++				 ((eq eol-type 'cr) (setq eol-type 'mac)))
++				(if (setq tmp (plist-get props 'post-read-conversion))
++				    (setq properties (plist-put properties 'post-read-conversion tmp)))
++				(if (setq tmp (plist-get props 'pre-write-conversion))
++				    (setq properties (plist-put properties 'pre-write-conversion tmp)))
++				(cond
++				 ((eq type 'shift-jis)
++				  `(,name 1 ,mnemonic ,doc-string
++					  nil ,properties ,eol-type))
++				 ((eq type 'iso2022) ; This is not perfect.
++				  (if (plist-get props 'escape-quoted)
++				      (error "escape-quoted is not supported: %S"
++					     `(,name ,type ,doc-string ,props)))
++				  (let ((g0 (plist-get props 'charset-g0))
++					(g1 (plist-get props 'charset-g1))
++					(g2 (plist-get props 'charset-g2))
++					(g3 (plist-get props 'charset-g3))
++					(use-roman
++					 (and
++					  (eq (cadr (assoc 'latin-jisx0201
++							   (plist-get props 'input-charset-conversion)))
++					      'ascii)
++					  (eq (cadr (assoc 'ascii
++							   (plist-get props 'output-charset-conversion)))
++					      'latin-jisx0201)))
++					(use-oldjis
++					 (and
++					  (eq (cadr (assoc 'japanese-jisx0208-1978
++							   (plist-get props 'input-charset-conversion)))
++					      'japanese-jisx0208)
++					  (eq (cadr (assoc 'japanese-jisx0208
++							   (plist-get props 'output-charset-conversion)))
++					      'japanese-jisx0208-1978))))
++				    (if (charsetp g0)
++					(if (plist-get props 'force-g0-on-output)
++					    (setq g0 `(nil ,g0))
++					  (setq g0 `(,g0 t))))
++				    (if (charsetp g1)
++					(if (plist-get props 'force-g1-on-output)
++					    (setq g1 `(nil ,g1))
++					  (setq g1 `(,g1 t))))
++				    (if (charsetp g2)
++					(if (plist-get props 'force-g2-on-output)
++					    (setq g2 `(nil ,g2))
++					  (setq g2 `(,g2 t))))
++				    (if (charsetp g3)
++					(if (plist-get props 'force-g3-on-output)
++					    (setq g3 `(nil ,g3))
++					  (setq g3 `(,g3 t))))
++				    `(,name 2 ,mnemonic ,doc-string
++					    (,g0 ,g1 ,g2 ,g3
++						 ,(plist-get props 'short)
++						 ,(not (plist-get props 'no-ascii-eol))
++						 ,(not (plist-get props 'no-ascii-cntl))
++						 ,(plist-get props 'seven)
++						 t
++						 ,(not (plist-get props 'lock-shift))
++						 ,use-roman
++						 ,use-oldjis
++						 ,(plist-get props 'no-iso6429)
++						 nil nil nil nil)
++					    ,properties ,eol-type)))
++				 ((eq type 'big5)
++				  `(,name 3 ,mnemonic ,doc-string
++					  nil ,properties ,eol-type))
++				 ((eq type 'ccl)
++				  `(,name 4 ,mnemonic ,doc-string
++					  (,(plist-get props 'decode) . ,(plist-get props 'encode))
++					  ,properties ,eol-type))
++				 (t
++				  (error "unsupported XEmacs style make-coding-style arguments: %S"
++					 `(,name ,type ,doc-string ,props))))))
++			    (defadvice make-coding-system
++			      (before ccl-compat (name type &rest ad-subr-args) activate)
++			      "Emulate XEmacs style make-coding-system."
++			      (when (and (symbolp type) (not (memq type '(t nil))))
++				(let ((args (apply 'transform-make-coding-system-args
++						   name type ad-subr-args)))
++				  (setq type (cadr args)
++					ad-subr-args (cddr args)))))))
+ 
+ 
+ ;;; @ end
Index: files/patch-poe.el
===================================================================
RCS file: files/patch-poe.el
diff -N files/patch-poe.el
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ files/patch-poe.el	24 Aug 2012 00:34:46 -0000
@@ -0,0 +1,1410 @@
+Index: poe.el
+===================================================================
+--- poe.el	(revision 2)
++++ poe.el	(working copy)
+@@ -38,22 +38,22 @@
+ ;;;
+ 
+ (static-when (= emacs-major-version 18)
+-  (require 'poe-18))
++	     (require 'poe-18))
+ 
+ ;; Some ancient version of XEmacs did not provide 'xemacs.
+ (static-when (string-match "XEmacs" emacs-version)
+-  (provide 'xemacs))
++	     (provide 'xemacs))
+ 
+ ;; `file-coding' was appeared in the spring of 1998, just before XEmacs
+ ;; 21.0. Therefore it is not provided in XEmacs with MULE versions 20.4
+ ;; or earlier.
+ (static-when (featurep 'xemacs)
+-  ;; must be load-time check to share .elc between w/ MULE and w/o MULE.
+-  (when (featurep 'mule)
+-    (provide 'file-coding)))
++	     ;; must be load-time check to share .elc between w/ MULE and w/o MULE.
++	     (when (featurep 'mule)
++	       (provide 'file-coding)))
+ 
+ (static-when (featurep 'xemacs)
+-  (require 'poe-xemacs))
++	     (require 'poe-xemacs))
+ 
+ ;; must be load-time check to share .elc between different systems.
+ (or (fboundp 'open-network-stream)
+@@ -66,18 +66,18 @@
+ ;; Emacs 20.3 and earlier: (require FEATURE &optional FILENAME)
+ ;; Emacs 20.4 and later: (require FEATURE &optional FILENAME NOERROR)
+ (static-condition-case nil
+-    ;; compile-time check.
+-    (progn
+-      (require 'nofeature "nofile" 'noerror)
+-      (if (get 'require 'defun-maybe)
+-	  (error "`require' is already redefined")))
+-  (error
+-   ;; load-time check.
+-   (or (fboundp 'si:require)
+-       (progn
+-	 (fset 'si:require (symbol-function 'require))
+-	 (defun require (feature &optional filename noerror)
+-	   "\
++		       ;; compile-time check.
++		       (progn
++			 (require 'nofeature "nofile" 'noerror)
++			 (if (get 'require 'defun-maybe)
++			     (error "`require' is already redefined")))
++		       (error
++			;; load-time check.
++			(or (fboundp 'si:require)
++			    (progn
++			      (fset 'si:require (symbol-function 'require))
++			      (defun require (feature &optional filename noerror)
++				"\
+ If feature FEATURE is not loaded, load it from FILENAME.
+ If FEATURE is not a member of the list `features', then the feature
+ is not loaded; so load the file FILENAME.
+@@ -86,14 +86,14 @@
+ If the optional third argument NOERROR is non-nil,
+ then return nil if the file is not found.
+ Normally the return value is FEATURE."
+-	   (if noerror
+-	       (condition-case nil
+-		   (si:require feature filename)
+-		 (file-error))
+-	     (si:require feature filename)))
+-	 ;; for `load-history'.
+-	 (setq current-load-list (cons 'require current-load-list))
+-	 (put 'require 'defun-maybe t)))))
++				(if noerror
++				    (condition-case nil
++					(si:require feature filename)
++				      (file-error))
++				  (si:require feature filename)))
++			      ;; for `load-history'.
++			      (setq current-load-list (cons 'require current-load-list))
++			      (put 'require 'defun-maybe t)))))
+ 
+ ;; Emacs 19.29 and later: (plist-get PLIST PROP)
+ ;; (defun-maybe plist-get (plist prop)
+@@ -103,21 +103,21 @@
+ ;;   (car (cdr plist)))
+ (static-unless (and (fboundp 'plist-get)
+ 		    (not (get 'plist-get 'defun-maybe)))
+-  (or (fboundp 'plist-get)
+-      (progn
+-	(defvar plist-get-internal-symbol)
+-	(defun plist-get (plist prop)
+-	  "\
++	       (or (fboundp 'plist-get)
++		   (progn
++		     (defvar plist-get-internal-symbol)
++		     (defun plist-get (plist prop)
++		       "\
+ Extract a value from a property list.
+ PLIST is a property list, which is a list of the form
+ \(PROP1 VALUE1 PROP2 VALUE2...\).  This function returns the value
+ corresponding to the given PROP, or nil if PROP is not
+ one of the properties on the list."
+-	  (setplist 'plist-get-internal-symbol plist)
+-	  (get 'plist-get-internal-symbol prop))
+-	;; for `load-history'.
+-	(setq current-load-list (cons 'plist-get current-load-list))
+-	(put 'plist-get 'defun-maybe t))))
++		       (setplist 'plist-get-internal-symbol plist)
++		       (get 'plist-get-internal-symbol prop))
++		     ;; for `load-history'.
++		     (setq current-load-list (cons 'plist-get current-load-list))
++		     (put 'plist-get 'defun-maybe t))))
+ 
+ ;; Emacs 19.29 and later: (plist-put PLIST PROP VAL)
+ ;; (defun-maybe plist-put (plist prop val)
+@@ -138,11 +138,11 @@
+ ;;         (list prop val)))))
+ (static-unless (and (fboundp 'plist-put)
+ 		    (not (get 'plist-put 'defun-maybe)))
+-  (or (fboundp 'plist-put)
+-      (progn
+-	(defvar plist-put-internal-symbol)
+-	(defun plist-put (plist prop val)
+-	  "\
++	       (or (fboundp 'plist-put)
++		   (progn
++		     (defvar plist-put-internal-symbol)
++		     (defun plist-put (plist prop val)
++		       "\
+ Change value in PLIST of PROP to VAL.
+ PLIST is a property list, which is a list of the form
+ \(PROP1 VALUE1 PROP2 VALUE2 ...\).  PROP is a symbol and VAL is any object.
+@@ -150,12 +150,12 @@
+ otherwise the new PROP VAL pair is added.  The new plist is returned;
+ use `\(setq x \(plist-put x prop val\)\)' to be sure to use the new value.
+ The PLIST is modified by side effects."
+-	  (setplist 'plist-put-internal-symbol plist)
+-	  (put 'plist-put-internal-symbol prop val)
+-	  (symbol-plist 'plist-put-internal-symbol))
+-	;; for `load-history'.
+-	(setq current-load-list (cons 'plist-put current-load-list))
+-	(put 'plist-put 'defun-maybe t))))
++		       (setplist 'plist-put-internal-symbol plist)
++		       (put 'plist-put-internal-symbol prop val)
++		       (symbol-plist 'plist-put-internal-symbol))
++		     ;; for `load-history'.
++		     (setq current-load-list (cons 'plist-put current-load-list))
++		     (put 'plist-put 'defun-maybe t))))
+ 
+ ;; Emacs 19.23 and later: (minibuffer-prompt-width)
+ (defun-maybe minibuffer-prompt-width ()
+@@ -170,16 +170,16 @@
+ 		   (>= emacs-major-version 20)
+ 		   (and (= emacs-major-version 19)
+ 			(>= emacs-minor-version 29)))
+-  (or (fboundp 'si:read-string)
+-      (progn
+-	(fset 'si:read-string (symbol-function 'read-string))
+-	(defun read-string (prompt &optional initial-input history)
+-	  "\
++	       (or (fboundp 'si:read-string)
++		   (progn
++		     (fset 'si:read-string (symbol-function 'read-string))
++		     (defun read-string (prompt &optional initial-input history)
++		       "\
+ Read a string from the minibuffer, prompting with string PROMPT.
+ If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
+ The third arg HISTORY, is dummy for compatibility.
+ See `read-from-minibuffer' for details of HISTORY argument."
+-	  (si:read-string prompt initial-input)))))
++		       (si:read-string prompt initial-input)))))
+ 
+ ;; (completing-read prompt table &optional
+ ;; FSF Emacs
+@@ -203,8 +203,8 @@
+ 	(fset 'si:completing-read (symbol-function 'completing-read))
+ 	(defun completing-read
+ 	  (prompt table &optional predicate require-match init
+-		                  hist def)
+-	"Read a string in the minibuffer, with completion.
++		  hist def)
++	  "Read a string in the minibuffer, with completion.
+ PROMPT is a string to prompt with; normally it ends in a colon and a space.
+ TABLE is an alist whose elements' cars are strings, or an obarray.
+ PREDICATE limits completion to a subset of TABLE.
+@@ -225,10 +225,10 @@
+ 
+ Completion ignores case if the ambient value of
+   `completion-ignore-case' is non-nil."
+-	(let ((string (si:completing-read prompt table predicate
+-					  require-match init)))
+-	  (if (and (string= string "") def)
+-	      def string))))))
++	  (let ((string (si:completing-read prompt table predicate
++					    require-match init)))
++	    (if (and (string= string "") def)
++		def string))))))
+  ;; add 'def' argument.
+  ((or (and (featurep 'xemacs)
+ 	   (or (and (eq emacs-major-version 21)
+@@ -240,8 +240,8 @@
+ 	(fset 'si:completing-read (symbol-function 'completing-read))
+ 	(defun completing-read
+ 	  (prompt table &optional predicate require-match init
+-		                  hist def)
+-	"Read a string in the minibuffer, with completion.
++		  hist def)
++	  "Read a string in the minibuffer, with completion.
+ PROMPT is a string to prompt with; normally it ends in a colon and a space.
+ TABLE is an alist whose elements' cars are strings, or an obarray.
+ PREDICATE limits completion to a subset of TABLE.
+@@ -269,10 +269,10 @@
+ 
+ Completion ignores case if the ambient value of
+   `completion-ignore-case' is non-nil."
+-	(let ((string (si:completing-read prompt table predicate
+-					  require-match init hist)))
+-	  (if (and (string= string "") def)
+-	      def string)))))))
++	  (let ((string (si:completing-read prompt table predicate
++					    require-match init hist)))
++	    (if (and (string= string "") def)
++		def string)))))))
+ 
+ ;; v18:	(string-to-int STRING)
+ ;; v19:	(string-to-number STRING)
+@@ -281,24 +281,24 @@
+ ;; XXX: `string-to-number' of Emacs 20.3 and earlier is broken.
+ ;;	(string-to-number "1e1" 16) => 10.0, should be 481.
+ (static-condition-case nil
+-    ;; compile-time check.
+-    (if (= (string-to-number "1e1" 16) 481)
+-	(if (get 'string-to-number 'defun-maybe)
+-	    (error "`string-to-number' is already redefined"))
+-      (error "`string-to-number' is broken"))
+-  (error
+-   ;; load-time check.
+-   (or (fboundp 'si:string-to-number)
+-       (progn
+-	 (if (fboundp 'string-to-number)
+-	     (fset 'si:string-to-number (symbol-function 'string-to-number))
+-	   (fset 'si:string-to-number (symbol-function 'string-to-int))
+-	   ;; XXX: In v18, this causes infinite loop while byte-compiling.
+-	   ;; (defalias 'string-to-int 'string-to-number)
+-	   )
+-	 (put 'string-to-number 'defun-maybe t)
+-	 (defun string-to-number (string &optional base)
+-	   "\
++		       ;; compile-time check.
++		       (if (= (string-to-number "1e1" 16) 481)
++			   (if (get 'string-to-number 'defun-maybe)
++			       (error "`string-to-number' is already redefined"))
++			 (error "`string-to-number' is broken"))
++		       (error
++			;; load-time check.
++			(or (fboundp 'si:string-to-number)
++			    (progn
++			      (if (fboundp 'string-to-number)
++				  (fset 'si:string-to-number (symbol-function 'string-to-number))
++				(fset 'si:string-to-number (symbol-function 'string-to-int))
++				;; XXX: In v18, this causes infinite loop while byte-compiling.
++				;; (defalias 'string-to-int 'string-to-number)
++				)
++			      (put 'string-to-number 'defun-maybe t)
++			      (defun string-to-number (string &optional base)
++				"\
+ Convert STRING to a number by parsing it as a decimal number.
+ This parses both integers and floating point numbers.
+ It ignores leading spaces and tabs.
+@@ -306,39 +306,39 @@
+ If BASE, interpret STRING as a number in that base.  If BASE isn't
+ present, base 10 is used.  BASE must be between 2 and 16 (inclusive).
+ If the base used is not 10, floating point is not recognized."
+-	   (if (or (null base) (= base 10))
+-	       (si:string-to-number string)
+-	     (if (or (< base 2)(> base 16))
+-		 (signal 'args-out-of-range (cons base nil)))
+-	     (let ((len (length string))
+-		   (pos 0))
+-	       ;; skip leading whitespace.
+-	       (while (and (< pos len)
+-			   (memq (aref string pos) '(?\  ?\t)))
+-		 (setq pos (1+ pos)))
+-	       (if (= pos len)
+-		   0
+-		 (let ((number 0)(negative 1)
+-		       chr num)
+-		   (if (eq (aref string pos) ?-)
+-		       (setq negative -1
+-			     pos (1+ pos))
+-		     (if (eq (aref string pos) ?+)
+-			 (setq pos (1+ pos))))
+-		   (while (and (< pos len)
+-			       (setq chr (aref string pos)
+-				     num (cond
+-					  ((and (<= ?0 chr)(<= chr ?9))
+-					   (- chr ?0))
+-					  ((and (<= ?A chr)(<= chr ?F))
+-					   (+ (- chr ?A) 10))
+-					  ((and (<= ?a chr)(<= chr ?f))
+-					   (+ (- chr ?a) 10))
+-					  (t nil)))
+-			       (< num base))
+-		     (setq number (+ (* number base) num)
+-			   pos (1+ pos)))
+-		   (* negative number))))))))))
++				(if (or (null base) (= base 10))
++				    (si:string-to-number string)
++				  (if (or (< base 2)(> base 16))
++				      (signal 'args-out-of-range (cons base nil)))
++				  (let ((len (length string))
++					(pos 0))
++				    ;; skip leading whitespace.
++				    (while (and (< pos len)
++						(memq (aref string pos) '(?\  ?\t)))
++				      (setq pos (1+ pos)))
++				    (if (= pos len)
++					0
++				      (let ((number 0)(negative 1)
++					    chr num)
++					(if (eq (aref string pos) ?-)
++					    (setq negative -1
++						  pos (1+ pos))
++					  (if (eq (aref string pos) ?+)
++					      (setq pos (1+ pos))))
++					(while (and (< pos len)
++						    (setq chr (aref string pos)
++							  num (cond
++							       ((and (<= ?0 chr)(<= chr ?9))
++								(- chr ?0))
++							       ((and (<= ?A chr)(<= chr ?F))
++								(+ (- chr ?A) 10))
++							       ((and (<= ?a chr)(<= chr ?f))
++								(+ (- chr ?a) 10))
++							       (t nil)))
++						    (< num base))
++					  (setq number (+ (* number base) num)
++						pos (1+ pos)))
++					(* negative number))))))))))
+ 
+ ;; Emacs 20.1 and 20.2: (concat-chars &rest CHARS)
+ ;; Emacs 20.3/XEmacs 21.0 and later: (string &rest CHARS)
+@@ -362,130 +362,130 @@
+ ;; Mule: (char-before POS)
+ ;; v20: (char-before &optional POS)
+ (static-condition-case nil
+-    ;; compile-time check.
+-    (progn
+-      (char-before)
+-      (if (get 'char-before 'defun-maybe)
+-	  (error "`char-before' is already defined")))
+-  (wrong-number-of-arguments            ; Mule.
+-   ;; load-time check.
+-   (or (fboundp 'si:char-before)
+-       (progn
+-         (fset 'si:char-before (symbol-function 'char-before))
+-         (put 'char-before 'defun-maybe t)
+-         ;; takes IGNORED for backward compatibility.
+-         (defun char-before (&optional pos ignored)
+-           "\
++		       ;; compile-time check.
++		       (progn
++			 (char-before)
++			 (if (get 'char-before 'defun-maybe)
++			     (error "`char-before' is already defined")))
++		       (wrong-number-of-arguments            ; Mule.
++			;; load-time check.
++			(or (fboundp 'si:char-before)
++			    (progn
++			      (fset 'si:char-before (symbol-function 'char-before))
++			      (put 'char-before 'defun-maybe t)
++			      ;; takes IGNORED for backward compatibility.
++			      (defun char-before (&optional pos ignored)
++				"\
+ Return character in current buffer preceding position POS.
+ POS is an integer or a buffer pointer.
+ If POS is out of range, the value is nil."
+-           (si:char-before (or pos (point)))))))
+-  (void-function                        ; non-Mule.
+-   ;; load-time check.
+-   (defun-maybe char-before (&optional pos)
+-     "\
++				(si:char-before (or pos (point)))))))
++		       (void-function                        ; non-Mule.
++			;; load-time check.
++			(defun-maybe char-before (&optional pos)
++			  "\
+ Return character in current buffer preceding position POS.
+ POS is an integer or a buffer pointer.
+ If POS is out of range, the value is nil."
+-     (if pos
+-         (save-excursion
+-           (and (= (goto-char pos) (point))
+-                (not (bobp))
+-                (preceding-char)))
+-       (and (not (bobp))
+-            (preceding-char)))))
+-  (error                                ; found our definition at compile-time.
+-   ;; load-time check.
+-   (condition-case nil
+-       (char-before)
+-     (wrong-number-of-arguments         ; Mule.
+-      (or (fboundp 'si:char-before)
+-          (progn
+-            (fset 'si:char-before (symbol-function 'char-before))
+-            (put 'char-before 'defun-maybe t)
+-            ;; takes IGNORED for backward compatibility.
+-            (defun char-before (&optional pos ignored)
+-              "\
++			  (if pos
++			      (save-excursion
++				(and (= (goto-char pos) (point))
++				     (not (bobp))
++				     (preceding-char)))
++			    (and (not (bobp))
++				 (preceding-char)))))
++		       (error                                ; found our definition at compile-time.
++			;; load-time check.
++			(condition-case nil
++			    (char-before)
++			  (wrong-number-of-arguments         ; Mule.
++			   (or (fboundp 'si:char-before)
++			       (progn
++				 (fset 'si:char-before (symbol-function 'char-before))
++				 (put 'char-before 'defun-maybe t)
++				 ;; takes IGNORED for backward compatibility.
++				 (defun char-before (&optional pos ignored)
++				   "\
+ Return character in current buffer preceding position POS.
+ POS is an integer or a buffer pointer.
+ If POS is out of range, the value is nil."
+-              (si:char-before (or pos (point)))))))
+-     (void-function                     ; non-Mule.
+-      (defun-maybe char-before (&optional pos)
+-        "\
++				   (si:char-before (or pos (point)))))))
++			  (void-function                     ; non-Mule.
++			   (defun-maybe char-before (&optional pos)
++			     "\
+ Return character in current buffer preceding position POS.
+ POS is an integer or a buffer pointer.
+ If POS is out of range, the value is nil."
+-        (if pos
+-            (save-excursion
+-              (and (= (goto-char pos) (point))
+-                   (not (bobp))
+-                   (preceding-char)))
+-          (and (not (bobp))
+-               (preceding-char))))))))
++			     (if pos
++				 (save-excursion
++				   (and (= (goto-char pos) (point))
++					(not (bobp))
++					(preceding-char)))
++			       (and (not (bobp))
++				    (preceding-char))))))))
+ 
+ ;; v18, v19: (char-after POS)
+ ;; v20: (char-after &optional POS)
+ (static-condition-case nil
+-    ;; compile-time check.
+-    (progn
+-      (char-after)
+-      (if (get 'char-after 'defun-maybe)
+-	  (error "`char-after' is already redefined")))
+-  (wrong-number-of-arguments		; v18, v19
+-   ;; load-time check.
+-   (or (fboundp 'si:char-after)
+-       (progn
+-         (fset 'si:char-after (symbol-function 'char-after))
+-         (put 'char-after 'defun-maybe t)
+-         (defun char-after (&optional pos)
+-           "\
++		       ;; compile-time check.
++		       (progn
++			 (char-after)
++			 (if (get 'char-after 'defun-maybe)
++			     (error "`char-after' is already redefined")))
++		       (wrong-number-of-arguments		; v18, v19
++			;; load-time check.
++			(or (fboundp 'si:char-after)
++			    (progn
++			      (fset 'si:char-after (symbol-function 'char-after))
++			      (put 'char-after 'defun-maybe t)
++			      (defun char-after (&optional pos)
++				"\
+ Return character in current buffer at position POS.
+ POS is an integer or a buffer pointer.
+ If POS is out of range, the value is nil."
+-           (si:char-after (or pos (point)))))))
+-  (void-function			; NEVER happen?
+-   ;; load-time check.
+-   (defun-maybe char-after (&optional pos)
+-     "\
++				(si:char-after (or pos (point)))))))
++		       (void-function			; NEVER happen?
++			;; load-time check.
++			(defun-maybe char-after (&optional pos)
++			  "\
+ Return character in current buffer at position POS.
+ POS is an integer or a buffer pointer.
+ If POS is out of range, the value is nil."
+-     (if pos
+-         (save-excursion
+-           (and (= (goto-char pos) (point))
+-                (not (eobp))
+-                (following-char)))
+-       (and (not (eobp))
+-            (following-char)))))
+-  (error                                ; found our definition at compile-time.
+-   ;; load-time check.
+-   (condition-case nil
+-       (char-after)
+-     (wrong-number-of-arguments         ; v18, v19
+-      (or (fboundp 'si:char-after)
+-          (progn
+-            (fset 'si:char-after (symbol-function 'char-after))
+-            (put 'char-after 'defun-maybe t)
+-	    (defun char-after (&optional pos)
+-	      "\
++			  (if pos
++			      (save-excursion
++				(and (= (goto-char pos) (point))
++				     (not (eobp))
++				     (following-char)))
++			    (and (not (eobp))
++				 (following-char)))))
++		       (error                                ; found our definition at compile-time.
++			;; load-time check.
++			(condition-case nil
++			    (char-after)
++			  (wrong-number-of-arguments         ; v18, v19
++			   (or (fboundp 'si:char-after)
++			       (progn
++				 (fset 'si:char-after (symbol-function 'char-after))
++				 (put 'char-after 'defun-maybe t)
++				 (defun char-after (&optional pos)
++				   "\
+ Return character in current buffer at position POS.
+ POS is an integer or a buffer pointer.
+ If POS is out of range, the value is nil."
+-	      (si:char-after (or pos (point)))))))
+-     (void-function                     ; NEVER happen?
+-      (defun-maybe char-after (&optional pos)
+-	"\
++				   (si:char-after (or pos (point)))))))
++			  (void-function                     ; NEVER happen?
++			   (defun-maybe char-after (&optional pos)
++			     "\
+ Return character in current buffer at position POS.
+ POS is an integer or a buffer pointer.
+ If POS is out of range, the value is nil."
+-	(if pos
+-	    (save-excursion
+-	      (and (= (goto-char pos) (point))
+-		   (not (eobp))
+-		   (following-char)))
+-	  (and (not (eobp))
+-	       (following-char))))))))
++			     (if pos
++				 (save-excursion
++				   (and (= (goto-char pos) (point))
++					(not (eobp))
++					(following-char)))
++			       (and (not (eobp))
++				    (following-char))))))))
+ 
+ ;; Emacs 19.29 and later: (buffer-substring-no-properties START END)
+ (defun-maybe buffer-substring-no-properties (start end)
+@@ -813,7 +813,7 @@
+ ;; So, in Emacs 19.29, `run-hooks' and others will be overrided.
+ ;; But, who cares it?
+ (static-unless (subrp (symbol-function 'run-hooks))
+-  (require 'localhook))
++	       (require 'localhook))
+ 
+ ;; Emacs 19.29/XEmacs 19.14(?) and later: (add-to-list LIST-VAR ELEMENT)
+ (defun-maybe add-to-list (list-var element)
+@@ -916,20 +916,20 @@
+ (defmacro-maybe save-current-buffer (&rest body)
+   "Save the current buffer; execute BODY; restore the current buffer.
+ Executes BODY just like `progn'."
+-  (` (let ((orig-buffer (current-buffer)))
+-       (unwind-protect
+-	   (progn (,@ body))
+-	 (if (buffer-live-p orig-buffer)
+-	     (set-buffer orig-buffer))))))
++  `(let ((orig-buffer (current-buffer)))
++     (unwind-protect
++	 (progn ,@body)
++       (if (buffer-live-p orig-buffer)
++	   (set-buffer orig-buffer)))))
+ 
+ ;; Emacs 20.1/XEmacs 20.3(?) and later: (with-current-buffer BUFFER &rest BODY)
+ (defmacro-maybe with-current-buffer (buffer &rest body)
+   "Execute the forms in BODY with BUFFER as the current buffer.
+ The value returned is the value of the last form in BODY.
+ See also `with-temp-buffer'."
+-  (` (save-current-buffer
+-       (set-buffer (, buffer))
+-       (,@ body))))
++  `(save-current-buffer
++     (set-buffer ,buffer)
++     ,@body))
+ 
+ ;; Emacs 20.1/XEmacs 20.3(?) and later: (with-temp-file FILE &rest FORMS)
+ (defmacro-maybe with-temp-file (file &rest forms)
+@@ -938,68 +938,68 @@
+ See also `with-temp-buffer'."
+   (let ((temp-file (make-symbol "temp-file"))
+ 	(temp-buffer (make-symbol "temp-buffer")))
+-    (` (let (((, temp-file) (, file))
+-	     ((, temp-buffer)
+-	      (get-buffer-create (generate-new-buffer-name " *temp file*"))))
+-	 (unwind-protect
+-	     (prog1
+-		 (with-current-buffer (, temp-buffer)
+-		   (,@ forms))
+-	       (with-current-buffer (, temp-buffer)
+-		 (widen)
+-		 (write-region (point-min) (point-max) (, temp-file) nil 0)))
+-	   (and (buffer-name (, temp-buffer))
+-		(kill-buffer (, temp-buffer))))))))
++    `(let ((,temp-file ,file)
++	   (,temp-buffer
++	    (get-buffer-create (generate-new-buffer-name " *temp file*"))))
++       (unwind-protect
++	   (prog1
++	       (with-current-buffer ,temp-buffer
++		 ,@forms)
++	     (with-current-buffer ,temp-buffer
++	       (widen)
++	       (write-region (point-min) (point-max) ,temp-file nil 0)))
++	 (and (buffer-name ,temp-buffer)
++	      (kill-buffer ,temp-buffer))))))
+ 
+ ;; Emacs 20.4 and later: (with-temp-message MESSAGE &rest BODY)
+ ;; This macro uses `current-message', which appears in v20.
+ (static-when (and (fboundp 'current-message)
+ 		  (subrp (symbol-function 'current-message)))
+-  (defmacro-maybe with-temp-message (message &rest body)
+-    "\
++	     (defmacro-maybe with-temp-message (message &rest body)
++	       "\
+ Display MESSAGE temporarily if non-nil while BODY is evaluated.
+ The original message is restored to the echo area after BODY has finished.
+ The value returned is the value of the last form in BODY.
+ MESSAGE is written to the message log buffer if `message-log-max' is non-nil.
+ If MESSAGE is nil, the echo area and message log buffer are unchanged.
+ Use a MESSAGE of \"\" to temporarily clear the echo area."
+-    (let ((current-message (make-symbol "current-message"))
+-	  (temp-message (make-symbol "with-temp-message")))
+-      (` (let (((, temp-message) (, message))
+-	       ((, current-message)))
+-	   (unwind-protect
+-	       (progn
+-		 (when (, temp-message)
+-		   (setq (, current-message) (current-message))
+-		   (message "%s" (, temp-message))
+-		   (,@ body))
+-		 (and (, temp-message) (, current-message)
+-		      (message "%s" (, current-message))))))))))
++	       (let ((current-message (make-symbol "current-message"))
++		     (temp-message (make-symbol "with-temp-message")))
++		 `(let ((,temp-message ,message)
++			(,current-message))
++		    (unwind-protect
++			(progn
++			  (when ,temp-message
++			    (setq ,current-message (current-message))
++			    (message "%s" ,temp-message)
++			    ,@body)
++			  (and ,temp-message ,current-message
++			       (message "%s" ,current-message))))))))
+ 
+ ;; Emacs 20.1/XEmacs 20.3(?) and later: (with-temp-buffer &rest FORMS)
+ (defmacro-maybe with-temp-buffer (&rest forms)
+   "Create a temporary buffer, and evaluate FORMS there like `progn'.
+ See also `with-temp-file' and `with-output-to-string'."
+   (let ((temp-buffer (make-symbol "temp-buffer")))
+-    (` (let (((, temp-buffer)
+-	      (get-buffer-create (generate-new-buffer-name " *temp*"))))
+-	 (unwind-protect
+-	     (with-current-buffer (, temp-buffer)
+-	       (,@ forms))
+-	   (and (buffer-name (, temp-buffer))
+-		(kill-buffer (, temp-buffer))))))))
++    `(let ((,temp-buffer
++	    (get-buffer-create (generate-new-buffer-name " *temp*"))))
++       (unwind-protect
++	   (with-current-buffer ,temp-buffer
++	     ,@forms)
++	 (and (buffer-name ,temp-buffer)
++	      (kill-buffer ,temp-buffer))))))
+ 
+ ;; Emacs 20.1/XEmacs 20.3(?) and later: (with-output-to-string &rest BODY)
+ (defmacro-maybe with-output-to-string (&rest body)
+   "Execute BODY, return the text it sent to `standard-output', as a string."
+-  (` (let ((standard-output
+-	    (get-buffer-create (generate-new-buffer-name " *string-output*"))))
+-       (let ((standard-output standard-output))
+-	 (,@ body))
+-       (with-current-buffer standard-output
+-	 (prog1
+-	     (buffer-string)
+-	   (kill-buffer nil))))))
++  `(let ((standard-output
++	  (get-buffer-create (generate-new-buffer-name " *string-output*"))))
++     (let ((standard-output standard-output))
++       ,@body)
++     (with-current-buffer standard-output
++       (prog1
++	   (buffer-string)
++	 (kill-buffer nil)))))
+ 
+ ;; Emacs 20.1 and later: (combine-after-change-calls &rest BODY)
+ (defmacro-maybe combine-after-change-calls (&rest body)
+@@ -1056,20 +1056,20 @@
+ ;; We support following API.
+ ;;  (replace-match NEWTEXT &optional FIXEDCASE LITERAL STRING)
+ (static-condition-case nil
+-    ;; compile-time check
+-    (progn
+-      (string-match "" "")
+-      (replace-match "" nil nil "")
+-      (if (get 'replace-match 'defun-maybe)
+-	  (error "`replace-match' is already defined")))
+-  (wrong-number-of-arguments ; Emacs 19.28 and earlier
+-   ;; load-time check.
+-   (or (fboundp 'si:replace-match)
+-       (progn
+-	 (fset 'si:replace-match (symbol-function 'replace-match))
+-	 (put 'replace-match 'defun-maybe t)
+-	 (defun replace-match (newtext &optional fixedcase literal string)
+-	   "Replace text matched by last search with NEWTEXT.
++		       ;; compile-time check
++		       (progn
++			 (string-match "" "")
++			 (replace-match "" nil nil "")
++			 (if (get 'replace-match 'defun-maybe)
++			     (error "`replace-match' is already defined")))
++		       (wrong-number-of-arguments ; Emacs 19.28 and earlier
++			;; load-time check.
++			(or (fboundp 'si:replace-match)
++			    (progn
++			      (fset 'si:replace-match (symbol-function 'replace-match))
++			      (put 'replace-match 'defun-maybe t)
++			      (defun replace-match (newtext &optional fixedcase literal string)
++				"Replace text matched by last search with NEWTEXT.
+ If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
+ Otherwise maybe capitalize the whole text, or maybe just word initials,
+ based on the replaced text.
+@@ -1090,38 +1090,38 @@
+ The optional fourth argument STRING can be a string to modify.
+ In that case, this function creates and returns a new string
+ which is made by replacing the part of STRING that was matched."
+-	   (if string
+-	       (with-temp-buffer
+-		(save-match-data
+-		  (insert string)
+-		  (let* ((matched (match-data))
+-			 (beg (nth 0 matched))
+-			 (end (nth 1 matched)))
+-		    (store-match-data
+-		     (list
+-		      (if (markerp beg)
+-			  (move-marker beg (1+ (match-beginning 0)))
+-			(1+ (match-beginning 0)))
+-		      (if (markerp end)
+-			  (move-marker end (1+ (match-end 0)))
+-			(1+ (match-end 0))))))
+-		  (si:replace-match newtext fixedcase literal)
+-		  (buffer-string)))
+-	     (si:replace-match newtext fixedcase literal))))))
+-  (error ; found our definition at compile-time.
+-   ;; load-time check.
+-   (condition-case nil
+-    (progn
+-      (string-match "" "")
+-      (replace-match "" nil nil ""))
+-    (wrong-number-of-arguments ; Emacs 19.28 and earlier
+-     ;; load-time check.
+-     (or (fboundp 'si:replace-match)
+-	 (progn
+-	   (fset 'si:replace-match (symbol-function 'replace-match))
+-	   (put 'replace-match 'defun-maybe t)
+-	   (defun replace-match (newtext &optional fixedcase literal string)
+-	     "Replace text matched by last search with NEWTEXT.
++				(if string
++				    (with-temp-buffer
++				      (save-match-data
++					(insert string)
++					(let* ((matched (match-data))
++					       (beg (nth 0 matched))
++					       (end (nth 1 matched)))
++					  (store-match-data
++					   (list
++					    (if (markerp beg)
++						(move-marker beg (1+ (match-beginning 0)))
++					      (1+ (match-beginning 0)))
++					    (if (markerp end)
++						(move-marker end (1+ (match-end 0)))
++					      (1+ (match-end 0))))))
++					(si:replace-match newtext fixedcase literal)
++					(buffer-string)))
++				  (si:replace-match newtext fixedcase literal))))))
++		       (error ; found our definition at compile-time.
++			;; load-time check.
++			(condition-case nil
++			    (progn
++			      (string-match "" "")
++			      (replace-match "" nil nil ""))
++			  (wrong-number-of-arguments ; Emacs 19.28 and earlier
++			   ;; load-time check.
++			   (or (fboundp 'si:replace-match)
++			       (progn
++				 (fset 'si:replace-match (symbol-function 'replace-match))
++				 (put 'replace-match 'defun-maybe t)
++				 (defun replace-match (newtext &optional fixedcase literal string)
++				   "Replace text matched by last search with NEWTEXT.
+ If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
+ Otherwise maybe capitalize the whole text, or maybe just word initials,
+ based on the replaced text.
+@@ -1142,24 +1142,24 @@
+ The optional fourth argument STRING can be a string to modify.
+ In that case, this function creates and returns a new string
+ which is made by replacing the part of STRING that was matched."
+-	     (if string
+-		 (with-temp-buffer
+-		  (save-match-data
+-		    (insert string)
+-		    (let* ((matched (match-data))
+-			   (beg (nth 0 matched))
+-			   (end (nth 1 matched)))
+-		      (store-match-data
+-		       (list
+-			(if (markerp beg)
+-			    (move-marker beg (1+ (match-beginning 0)))
+-			  (1+ (match-beginning 0)))
+-			(if (markerp end)
+-			    (move-marker end (1+ (match-end 0)))
+-			  (1+ (match-end 0))))))
+-		    (si:replace-match newtext fixedcase literal)
+-		    (buffer-string)))
+-	       (si:replace-match newtext fixedcase literal)))))))))
++				   (if string
++				       (with-temp-buffer
++					 (save-match-data
++					   (insert string)
++					   (let* ((matched (match-data))
++						  (beg (nth 0 matched))
++						  (end (nth 1 matched)))
++					     (store-match-data
++					      (list
++					       (if (markerp beg)
++						   (move-marker beg (1+ (match-beginning 0)))
++						 (1+ (match-beginning 0)))
++					       (if (markerp end)
++						   (move-marker end (1+ (match-end 0)))
++						 (1+ (match-end 0))))))
++					   (si:replace-match newtext fixedcase literal)
++					   (buffer-string)))
++				     (si:replace-match newtext fixedcase literal)))))))))
+ 
+ ;; Emacs 20: (format-time-string FORMAT &optional TIME UNIVERSAL)
+ ;; Those format constructs are yet to be implemented.
+@@ -1167,26 +1167,26 @@
+ ;; Not fully compatible especially when invalid format is specified.
+ (static-unless (and (fboundp 'format-time-string)
+ 		    (not (get 'format-time-string 'defun-maybe)))
+-  (or (fboundp 'format-time-string)
+-  (progn
+-  (defconst format-time-month-list
+-    '(( "Zero" . ("Zero" . 0))
+-      ("Jan" . ("January" . 1)) ("Feb" . ("February" . 2))
+-      ("Mar" . ("March" . 3)) ("Apr" . ("April" . 4)) ("May" . ("May" . 5))
+-      ("Jun" . ("June" . 6))("Jul" . ("July" . 7)) ("Aug" . ("August" . 8))
+-      ("Sep" . ("September" . 9)) ("Oct" . ("October" . 10))
+-      ("Nov" . ("November" . 11)) ("Dec" . ("December" . 12)))
+-    "Alist of months and their number.")
++	       (or (fboundp 'format-time-string)
++		   (progn
++		     (defconst format-time-month-list
++		       '(( "Zero" . ("Zero" . 0))
++			 ("Jan" . ("January" . 1)) ("Feb" . ("February" . 2))
++			 ("Mar" . ("March" . 3)) ("Apr" . ("April" . 4)) ("May" . ("May" . 5))
++			 ("Jun" . ("June" . 6))("Jul" . ("July" . 7)) ("Aug" . ("August" . 8))
++			 ("Sep" . ("September" . 9)) ("Oct" . ("October" . 10))
++			 ("Nov" . ("November" . 11)) ("Dec" . ("December" . 12)))
++		       "Alist of months and their number.")
+ 
+-  (defconst format-time-week-list
+-    '(("Sun" . ("Sunday" . 0)) ("Mon" . ("Monday" . 1))
+-      ("Tue" . ("Tuesday" . 2)) ("Wed" . ("Wednesday" . 3))
+-      ("Thu" . ("Thursday" . 4)) ("Fri" . ("Friday" . 5))
+-      ("Sat" . ("Saturday" . 6)))
+-    "Alist of weeks and their number.")
++		     (defconst format-time-week-list
++		       '(("Sun" . ("Sunday" . 0)) ("Mon" . ("Monday" . 1))
++			 ("Tue" . ("Tuesday" . 2)) ("Wed" . ("Wednesday" . 3))
++			 ("Thu" . ("Thursday" . 4)) ("Fri" . ("Friday" . 5))
++			 ("Sat" . ("Saturday" . 6)))
++		       "Alist of weeks and their number.")
+ 
+-  (defun format-time-string (format &optional time universal)
+-    "Use FORMAT-STRING to format the time TIME, or now if omitted.
++		     (defun format-time-string (format &optional time universal)
++		       "Use FORMAT-STRING to format the time TIME, or now if omitted.
+ TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as returned by
+ `current-time' or `file-attributes'.
+ The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
+@@ -1238,250 +1238,250 @@
+ Those format constructs are yet to be implemented.
+   %c, %C, %j, %U, %W, %x, %X
+ Not fully compatible especially when invalid format is specified."
+-    (let ((fmt-len (length format))
+-	  (ind 0)
+-	  prev-ind
+-	  cur-char
+-	  (prev-char nil)
+-	  strings-so-far
+-	  (result "")
+-	  field-width
+-	  field-result
+-	  pad-left change-case
+-	  (paren-level 0)
+-	  hour ms ls
+-	  (tz (car (current-time-zone)))
+-	  time-string)
+-      (if universal
+-	  (progn
+-	    (or time
+-		(setq time (current-time)))
+-	    (setq ms (car time)
+-		  ls (- (nth 1 time) tz))
+-	    (cond ((< ls 0)
+-		   (setq ms (1- ms)
+-			 ls (+ ls 65536)))
+-		  ((>= ls 65536)
+-		   (setq ms (1+ ms)
+-			 ls (- ls 65536))))
+-	    (setq time (append (list ms ls) (nth 2 time)))))
+-      (setq time-string (current-time-string time)
+-	    hour (string-to-int (substring time-string 11 13)))
+-      (while (< ind fmt-len)
+-	(setq cur-char (aref format ind))
+-	(setq
+-	 result
+-	 (concat result
+-	(cond
+-	 ((eq cur-char ?%)
+-	  ;; eat any additional args to allow for future expansion, not!!
+-	  (setq pad-left nil change-case nil field-width "" prev-ind ind
+-		strings-so-far "")
+-;	  (catch 'invalid
+-	  (while (progn
+-		   (setq ind (1+ ind))
+-		   (setq cur-char (if (< ind fmt-len)
+-				      (aref format ind)
+-				    ?\0))
+-		   (or (eq ?- cur-char) ; pad on left
+-		       (eq ?# cur-char) ; case change
+-		       (if (and (string-equal field-width "")
+-				(<= ?0 cur-char) (>= ?9 cur-char))
+-			   ;; get format width
+-			   (let ((field-index ind))
+-			     (while (progn
+-				      (setq ind (1+ ind))
+-				      (setq cur-char (if (< ind fmt-len)
+-							 (aref format ind)
+-						       ?\0))
+-				      (and (<= ?0 cur-char) (>= ?9 cur-char))))
+-			     (setq field-width
+-				   (substring format field-index ind))
+-			     (setq ind (1- ind)
+-				   cur-char nil)
+-			     t))))
+-	    (setq prev-char cur-char
+-		  strings-so-far (concat strings-so-far
+-					 (if cur-char
+-					     (char-to-string cur-char)
+-					   field-width)))
+-	    ;; characters we actually use
+-	    (cond ((eq cur-char ?-)
+-		   ;; padding to left must be specified before field-width
+-		   (setq pad-left (string-equal field-width "")))
+-		  ((eq cur-char ?#)
+-		   (setq change-case t))))
+-	  (setq field-result
+-		(cond
+-		 ((eq cur-char ?%)
+-		  "%")
+-		 ;; the abbreviated name of the day of week.
+-		 ((eq cur-char ?a)
+-		  (substring time-string 0 3))
+-		 ;; the full name of the day of week
+-		 ((eq cur-char ?A)
+-		  (cadr (assoc (substring time-string 0 3)
+-			       format-time-week-list)))
+-		 ;; the abbreviated name of the month
+-		 ((eq cur-char ?b)
+-		  (substring time-string 4 7))
+-		 ;; the full name of the month
+-		 ((eq cur-char ?B)
+-		  (cadr (assoc (substring time-string 4 7)
+-			       format-time-month-list)))
+-		 ;; a synonym for `%x %X' (yet to come)
+-		 ((eq cur-char ?c)
+-		  "")
+-		 ;; locale specific (yet to come)
+-		 ((eq cur-char ?C)
+-		  "")
+-		 ;; the day of month, zero-padded
+-		 ((eq cur-char ?d)
+-		  (format "%02d" (string-to-int (substring time-string 8 10))))
+-		 ;; a synonym for `%m/%d/%y'
+-		 ((eq cur-char ?D)
+-		  (format "%02d/%02d/%s"
+-			  (cddr (assoc (substring time-string 4 7)
+-				       format-time-month-list))
+-			  (string-to-int (substring time-string 8 10))
+-			  (substring time-string -2)))
+-		 ;; the day of month, blank-padded
+-		 ((eq cur-char ?e)
+-		  (format "%2d" (string-to-int (substring time-string 8 10))))
+-		 ;; a synonym for `%b'
+-		 ((eq cur-char ?h)
+-		  (substring time-string 4 7))
+-		 ;; the hour (00-23)
+-		 ((eq cur-char ?H)
+-		  (substring time-string 11 13))
+-		 ;; the hour (00-12)
+-		 ((eq cur-char ?I)
+-		  (format "%02d" (if (> hour 12) (- hour 12) hour)))
+-		 ;; the day of the year (001-366) (yet to come)
+-		 ((eq cur-char ?j)
+-		  "")
+-		 ;; the hour (0-23), blank padded
+-		 ((eq cur-char ?k)
+-		  (format "%2d" hour))
+-		 ;; the hour (1-12), blank padded
+-		 ((eq cur-char ?l)
+-		  (format "%2d" (if (> hour 12) (- hour 12) hour)))
+-		 ;; the month (01-12)
+-		 ((eq cur-char ?m)
+-		  (format "%02d" (cddr (assoc (substring time-string 4 7)
+-					      format-time-month-list))))
+-		 ;; the minute (00-59)
+-		 ((eq cur-char ?M)
+-		  (substring time-string 14 16))
+-		 ;; a newline
+-		 ((eq cur-char ?n)
+-		  "\n")
+-		 ;; `AM' or `PM', as appropriate
+-		 ((eq cur-char ?p)
+-		  (setq change-case (not change-case))
+-		  (if (> hour 12) "pm" "am"))
+-		 ;; a synonym for `%I:%M:%S %p'
+-		 ((eq cur-char ?r)
+-		  (format "%02d:%s:%s %s"
+-			  (if (> hour 12) (- hour 12) hour)
+-			  (substring time-string 14 16)
+-			  (substring time-string 17 19)
+-			  (if (> hour 12) "PM" "AM")))
+-		 ;; a synonym for `%H:%M'
+-		 ((eq cur-char ?R)
+-		  (format "%s:%s"
+-			  (substring time-string 11 13)
+-			  (substring time-string 14 16)))
+-		 ;; the seconds (00-60)
+-		 ((eq cur-char ?S)
+-		  (substring time-string 17 19))
+-		 ;; a tab character
+-		 ((eq cur-char ?t)
+-		  "\t")
+-		 ;; a synonym for `%H:%M:%S'
+-		 ((eq cur-char ?T)
+-		  (format "%s:%s:%s"
+-			  (substring time-string 11 13)
+-			  (substring time-string 14 16)
+-			  (substring time-string 17 19)))
+-		 ;; the week of the year (01-52), assuming that weeks
+-		 ;; start on Sunday (yet to come)
+-		 ((eq cur-char ?U)
+-		  "")
+-		 ;; the numeric day of week (0-6).  Sunday is day 0
+-		 ((eq cur-char ?w)
+-		  (format "%d" (cddr (assoc (substring time-string 0 3)
+-					    format-time-week-list))))
+-		 ;; the week of the year (01-52), assuming that weeks
+-		 ;; start on Monday (yet to come)
+-		 ((eq cur-char ?W)
+-		  "")
+-		 ;; locale specific (yet to come)
+-		 ((eq cur-char ?x)
+-		  "")
+-		 ;; locale specific (yet to come)
+-		 ((eq cur-char ?X)
+-		  "")
+-		 ;; the year without century (00-99)
+-		 ((eq cur-char ?y)
+-		  (substring time-string -2))
+-		 ;; the year with century
+-		 ((eq cur-char ?Y)
+-		  (substring time-string -4))
+-		 ;; the time zone abbreviation
+-		 ((eq cur-char ?Z)
+-		  (if universal
+-		      "UTC"
+-		    (setq change-case (not change-case))
+-		    (downcase (cadr (current-time-zone)))))
+-		 ((eq cur-char ?z)
+-		  (if universal
+-		      "+0000"
+-		    (if (< tz 0)
+-			(format "-%02d%02d"
+-				(/ (- tz) 3600) (/ (% (- tz) 3600) 60))
+-		      (format "+%02d%02d"
+-			      (/ tz 3600) (/ (% tz 3600) 60)))))
+-		 (t
+-		  (concat
+-		   "%"
+-		   strings-so-far
+-		   (char-to-string cur-char)))))
+-;		  (setq ind prev-ind)
+-;		  (throw 'invalid "%"))))
+-	  (if (string-equal field-width "")
+-	      (if change-case (upcase field-result) field-result)
+-	    (let ((padded-result
+-		   (format (format "%%%s%s%c"
+-				   ""	; pad on left is ignored
+-;				   (if pad-left "-" "")
+-				   field-width
+-				   ?s)
+-			   (or field-result ""))))
+-	      (let ((initial-length (length padded-result))
+-		    (desired-length (string-to-int field-width)))
+-		(when (and (string-match "^0" field-width)
+-			   (string-match "^ +" padded-result))
+-		  (setq padded-result
+-			(replace-match
+-			 (make-string
+-			  (length (match-string 0 padded-result)) ?0)
+-			 nil nil padded-result)))
+-		(if (> initial-length desired-length)
+-		    ;; truncate strings on right, years on left
+-		    (if (stringp field-result)
+-			(substring padded-result 0 desired-length)
+-		      (if (eq cur-char ?y)
+-			  (substring padded-result (- desired-length))
+-			padded-result))) ;non-year numbers don't truncate
+-		(if change-case (upcase padded-result) padded-result))))) ;)
+-	 (t
+-	  (char-to-string cur-char)))))
+-	(setq ind (1+ ind)))
+-      result))
+-  ;; for `load-history'.
+-  (setq current-load-list (cons 'format-time-string current-load-list))
+-  (put 'format-time-string 'defun-maybe t))))
++		       (let ((fmt-len (length format))
++			     (ind 0)
++			     prev-ind
++			     cur-char
++			     (prev-char nil)
++			     strings-so-far
++			     (result "")
++			     field-width
++			     field-result
++			     pad-left change-case
++			     (paren-level 0)
++			     hour ms ls
++			     (tz (car (current-time-zone)))
++			     time-string)
++			 (if universal
++			     (progn
++			       (or time
++				   (setq time (current-time)))
++			       (setq ms (car time)
++				     ls (- (nth 1 time) tz))
++			       (cond ((< ls 0)
++				      (setq ms (1- ms)
++					    ls (+ ls 65536)))
++				     ((>= ls 65536)
++				      (setq ms (1+ ms)
++					    ls (- ls 65536))))
++			       (setq time (append (list ms ls) (nth 2 time)))))
++			 (setq time-string (current-time-string time)
++			       hour (string-to-int (substring time-string 11 13)))
++			 (while (< ind fmt-len)
++			   (setq cur-char (aref format ind))
++			   (setq
++			    result
++			    (concat result
++				    (cond
++				     ((eq cur-char ?%)
++				      ;; eat any additional args to allow for future expansion, not!!
++				      (setq pad-left nil change-case nil field-width "" prev-ind ind
++					    strings-so-far "")
++					;	  (catch 'invalid
++				      (while (progn
++					       (setq ind (1+ ind))
++					       (setq cur-char (if (< ind fmt-len)
++								  (aref format ind)
++								?\0))
++					       (or (eq ?- cur-char) ; pad on left
++						   (eq ?# cur-char) ; case change
++						   (if (and (string-equal field-width "")
++							    (<= ?0 cur-char) (>= ?9 cur-char))
++						       ;; get format width
++						       (let ((field-index ind))
++							 (while (progn
++								  (setq ind (1+ ind))
++								  (setq cur-char (if (< ind fmt-len)
++										     (aref format ind)
++										   ?\0))
++								  (and (<= ?0 cur-char) (>= ?9 cur-char))))
++							 (setq field-width
++							       (substring format field-index ind))
++							 (setq ind (1- ind)
++							       cur-char nil)
++							 t))))
++					(setq prev-char cur-char
++					      strings-so-far (concat strings-so-far
++								     (if cur-char
++									 (char-to-string cur-char)
++								       field-width)))
++					;; characters we actually use
++					(cond ((eq cur-char ?-)
++					       ;; padding to left must be specified before field-width
++					       (setq pad-left (string-equal field-width "")))
++					      ((eq cur-char ?#)
++					       (setq change-case t))))
++				      (setq field-result
++					    (cond
++					     ((eq cur-char ?%)
++					      "%")
++					     ;; the abbreviated name of the day of week.
++					     ((eq cur-char ?a)
++					      (substring time-string 0 3))
++					     ;; the full name of the day of week
++					     ((eq cur-char ?A)
++					      (cadr (assoc (substring time-string 0 3)
++							   format-time-week-list)))
++					     ;; the abbreviated name of the month
++					     ((eq cur-char ?b)
++					      (substring time-string 4 7))
++					     ;; the full name of the month
++					     ((eq cur-char ?B)
++					      (cadr (assoc (substring time-string 4 7)
++							   format-time-month-list)))
++					     ;; a synonym for `%x %X' (yet to come)
++					     ((eq cur-char ?c)
++					      "")
++					     ;; locale specific (yet to come)
++					     ((eq cur-char ?C)
++					      "")
++					     ;; the day of month, zero-padded
++					     ((eq cur-char ?d)
++					      (format "%02d" (string-to-int (substring time-string 8 10))))
++					     ;; a synonym for `%m/%d/%y'
++					     ((eq cur-char ?D)
++					      (format "%02d/%02d/%s"
++						      (cddr (assoc (substring time-string 4 7)
++								   format-time-month-list))
++						      (string-to-int (substring time-string 8 10))
++						      (substring time-string -2)))
++					     ;; the day of month, blank-padded
++					     ((eq cur-char ?e)
++					      (format "%2d" (string-to-int (substring time-string 8 10))))
++					     ;; a synonym for `%b'
++					     ((eq cur-char ?h)
++					      (substring time-string 4 7))
++					     ;; the hour (00-23)
++					     ((eq cur-char ?H)
++					      (substring time-string 11 13))
++					     ;; the hour (00-12)
++					     ((eq cur-char ?I)
++					      (format "%02d" (if (> hour 12) (- hour 12) hour)))
++					     ;; the day of the year (001-366) (yet to come)
++					     ((eq cur-char ?j)
++					      "")
++					     ;; the hour (0-23), blank padded
++					     ((eq cur-char ?k)
++					      (format "%2d" hour))
++					     ;; the hour (1-12), blank padded
++					     ((eq cur-char ?l)
++					      (format "%2d" (if (> hour 12) (- hour 12) hour)))
++					     ;; the month (01-12)
++					     ((eq cur-char ?m)
++					      (format "%02d" (cddr (assoc (substring time-string 4 7)
++									  format-time-month-list))))
++					     ;; the minute (00-59)
++					     ((eq cur-char ?M)
++					      (substring time-string 14 16))
++					     ;; a newline
++					     ((eq cur-char ?n)
++					      "\n")
++					     ;; `AM' or `PM', as appropriate
++					     ((eq cur-char ?p)
++					      (setq change-case (not change-case))
++					      (if (> hour 12) "pm" "am"))
++					     ;; a synonym for `%I:%M:%S %p'
++					     ((eq cur-char ?r)
++					      (format "%02d:%s:%s %s"
++						      (if (> hour 12) (- hour 12) hour)
++						      (substring time-string 14 16)
++						      (substring time-string 17 19)
++						      (if (> hour 12) "PM" "AM")))
++					     ;; a synonym for `%H:%M'
++					     ((eq cur-char ?R)
++					      (format "%s:%s"
++						      (substring time-string 11 13)
++						      (substring time-string 14 16)))
++					     ;; the seconds (00-60)
++					     ((eq cur-char ?S)
++					      (substring time-string 17 19))
++					     ;; a tab character
++					     ((eq cur-char ?t)
++					      "\t")
++					     ;; a synonym for `%H:%M:%S'
++					     ((eq cur-char ?T)
++					      (format "%s:%s:%s"
++						      (substring time-string 11 13)
++						      (substring time-string 14 16)
++						      (substring time-string 17 19)))
++					     ;; the week of the year (01-52), assuming that weeks
++					     ;; start on Sunday (yet to come)
++					     ((eq cur-char ?U)
++					      "")
++					     ;; the numeric day of week (0-6).  Sunday is day 0
++					     ((eq cur-char ?w)
++					      (format "%d" (cddr (assoc (substring time-string 0 3)
++									format-time-week-list))))
++					     ;; the week of the year (01-52), assuming that weeks
++					     ;; start on Monday (yet to come)
++					     ((eq cur-char ?W)
++					      "")
++					     ;; locale specific (yet to come)
++					     ((eq cur-char ?x)
++					      "")
++					     ;; locale specific (yet to come)
++					     ((eq cur-char ?X)
++					      "")
++					     ;; the year without century (00-99)
++					     ((eq cur-char ?y)
++					      (substring time-string -2))
++					     ;; the year with century
++					     ((eq cur-char ?Y)
++					      (substring time-string -4))
++					     ;; the time zone abbreviation
++					     ((eq cur-char ?Z)
++					      (if universal
++						  "UTC"
++						(setq change-case (not change-case))
++						(downcase (cadr (current-time-zone)))))
++					     ((eq cur-char ?z)
++					      (if universal
++						  "+0000"
++						(if (< tz 0)
++						    (format "-%02d%02d"
++							    (/ (- tz) 3600) (/ (% (- tz) 3600) 60))
++						  (format "+%02d%02d"
++							  (/ tz 3600) (/ (% tz 3600) 60)))))
++					     (t
++					      (concat
++					       "%"
++					       strings-so-far
++					       (char-to-string cur-char)))))
++					;		  (setq ind prev-ind)
++					;		  (throw 'invalid "%"))))
++				      (if (string-equal field-width "")
++					  (if change-case (upcase field-result) field-result)
++					(let ((padded-result
++					       (format (format "%%%s%s%c"
++							       ""	; pad on left is ignored
++					;				   (if pad-left "-" "")
++							       field-width
++							       ?s)
++						       (or field-result ""))))
++					  (let ((initial-length (length padded-result))
++						(desired-length (string-to-int field-width)))
++					    (when (and (string-match "^0" field-width)
++						       (string-match "^ +" padded-result))
++					      (setq padded-result
++						    (replace-match
++						     (make-string
++						      (length (match-string 0 padded-result)) ?0)
++						     nil nil padded-result)))
++					    (if (> initial-length desired-length)
++						;; truncate strings on right, years on left
++						(if (stringp field-result)
++						    (substring padded-result 0 desired-length)
++						  (if (eq cur-char ?y)
++						      (substring padded-result (- desired-length))
++						    padded-result))) ;non-year numbers don't truncate
++					    (if change-case (upcase padded-result) padded-result))))) ;)
++				     (t
++				      (char-to-string cur-char)))))
++			   (setq ind (1+ ind)))
++			 result))
++		     ;; for `load-history'.
++		     (setq current-load-list (cons 'format-time-string current-load-list))
++		     (put 'format-time-string 'defun-maybe t))))
+ 
+ ;; Emacs 19.29-19.34/XEmacs: `format-time-string' neither supports the
+ ;; format string "%z" nor the third argument `universal'.
Index: files/patch-product.el
===================================================================
RCS file: files/patch-product.el
diff -N files/patch-product.el
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ files/patch-product.el	24 Aug 2012 00:34:46 -0000
@@ -0,0 +1,83 @@
+Index: product.el
+===================================================================
+--- product.el	(revision 2)
++++ product.el	(working copy)
+@@ -232,21 +232,21 @@
+ 	 (product-version (product-version product))
+ 	 (product-code-name (product-code-name product))
+ 	 (product-version-string (product-version-string product)))
+-    (` (progn
+-	 (, product-def)
+-	 (put (, feature) 'product
+-	      (let ((product (product-find-by-name (, product-name))))
+-		(product-run-checkers product '(, product-version))
+-		(and (, product-family)
+-		     (product-add-to-family (, product-family)
+-					    (, product-name)))
+-		(product-add-feature product (, feature))
+-		(if (equal '(, product-version) (product-version product))
+-		    product
+-		  (vector (, product-name) (, product-family)
+-			  '(, product-version) (, product-code-name)
+-			  nil nil nil (, product-version-string)))))
+-	 (, feature-def)))))
++    `(progn
++       ,product-def
++       (put ,feature 'product
++	    (let ((product (product-find-by-name ,product-name)))
++	      (product-run-checkers product ',product-version)
++	      (and ,product-family
++		   (product-add-to-family ,product-family
++					  ,product-name))
++	      (product-add-feature product ,feature)
++	      (if (equal ',product-version (product-version product))
++		  product
++		(vector ,product-name ,product-family
++			',product-version ,product-code-name
++			nil nil nil ,product-version-string))))
++       ,feature-def)))
+ 
+ (defun product-version-as-string (product)
+   "Return version number of product as a string.
+@@ -293,13 +293,13 @@
+ PRODUCT is a product structure which returned by `product-define'."
+   (let (dest)
+     (product-for-each product nil
+-     (function
+-      (lambda (product)
+-	(let ((str (product-string-1 product nil)))
+-	  (if str
+-	      (setq dest (if dest
+-			     (concat dest " " str)
+-			   str)))))))
++		      (function
++		       (lambda (product)
++			 (let ((str (product-string-1 product nil)))
++			   (if str
++			       (setq dest (if dest
++					      (concat dest " " str)
++					    str)))))))
+     dest))
+ 
+ (defun product-string-verbose (product)
+@@ -307,13 +307,13 @@
+ PRODUCT is a product structure which returned by `product-define'."
+   (let (dest)
+     (product-for-each product nil
+-     (function
+-      (lambda (product)
+-	(let ((str (product-string-1 product t)))
+-	  (if str
+-	      (setq dest (if dest
+-			     (concat dest " " str)
+-			   str)))))))
++		      (function
++		       (lambda (product)
++			 (let ((str (product-string-1 product t)))
++			   (if str
++			       (setq dest (if dest
++					      (concat dest " " str)
++					    str)))))))
+     dest))
+ 
+ (defun product-version-compare (v1 v2)
Index: files/patch-pym.el
===================================================================
RCS file: files/patch-pym.el
diff -N files/patch-pym.el
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ files/patch-pym.el	24 Aug 2012 00:34:46 -0000
@@ -0,0 +1,282 @@
+Index: pym.el
+===================================================================
+--- pym.el	(revision 2)
++++ pym.el	(working copy)
+@@ -63,15 +63,15 @@
+ See also the function `defun'."
+   (or (and (fboundp name)
+ 	   (not (get name 'defun-maybe)))
+-      (` (or (fboundp (quote (, name)))
+-	     (prog1
+-		 (defun (, name) (,@ everything-else))
+-	       ;; This `defun' will be compiled to `fset',
+-	       ;; which does not update `load-history'.
+-	       ;; We must update `current-load-list' explicitly.
+-	       (setq current-load-list
+-		     (cons (quote (, name)) current-load-list))
+-	       (put (quote (, name)) 'defun-maybe t))))))
++      `(or (fboundp (quote ,name))
++	   (prog1
++	       (defun ,name ,@everything-else)
++	     ;; This `defun' will be compiled to `fset',
++	     ;; which does not update `load-history'.
++	     ;; We must update `current-load-list' explicitly.
++	     (setq current-load-list
++		   (cons (quote ,name) current-load-list))
++	     (put (quote ,name) 'defun-maybe t)))))
+ 
+ (put 'defmacro-maybe 'lisp-indent-function 'defun)
+ (defmacro defmacro-maybe (name &rest everything-else)
+@@ -79,15 +79,15 @@
+ See also the function `defmacro'."
+   (or (and (fboundp name)
+ 	   (not (get name 'defmacro-maybe)))
+-      (` (or (fboundp (quote (, name)))
+-	     (prog1
+-		 (defmacro (, name) (,@ everything-else))
+-	       ;; This `defmacro' will be compiled to `fset',
+-	       ;; which does not update `load-history'.
+-	       ;; We must update `current-load-list' explicitly.
+-	       (setq current-load-list
+-		     (cons (quote (, name)) current-load-list))
+-	       (put (quote (, name)) 'defmacro-maybe t))))))
++      `(or (fboundp (quote ,name))
++	   (prog1
++	       (defmacro ,name ,@everything-else)
++	     ;; This `defmacro' will be compiled to `fset',
++	     ;; which does not update `load-history'.
++	     ;; We must update `current-load-list' explicitly.
++	     (setq current-load-list
++		   (cons (quote ,name) current-load-list))
++	     (put (quote ,name) 'defmacro-maybe t)))))
+ 
+ (put 'defsubst-maybe 'lisp-indent-function 'defun)
+ (defmacro defsubst-maybe (name &rest everything-else)
+@@ -95,15 +95,15 @@
+ See also the macro `defsubst'."
+   (or (and (fboundp name)
+ 	   (not (get name 'defsubst-maybe)))
+-      (` (or (fboundp (quote (, name)))
+-	     (prog1
+-		 (defsubst (, name) (,@ everything-else))
+-	       ;; This `defsubst' will be compiled to `fset',
+-	       ;; which does not update `load-history'.
+-	       ;; We must update `current-load-list' explicitly.
+-	       (setq current-load-list
+-		     (cons (quote (, name)) current-load-list))
+-	       (put (quote (, name)) 'defsubst-maybe t))))))
++      `(or (fboundp (quote ,name))
++	   (prog1
++	       (defsubst ,name ,@everything-else)
++	     ;; This `defsubst' will be compiled to `fset',
++	     ;; which does not update `load-history'.
++	     ;; We must update `current-load-list' explicitly.
++	     (setq current-load-list
++		   (cons (quote ,name) current-load-list))
++	     (put (quote ,name) 'defsubst-maybe t)))))
+ 
+ (defmacro defalias-maybe (symbol definition)
+   "Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined.
+@@ -111,35 +111,35 @@
+   (setq symbol (eval symbol))
+   (or (and (fboundp symbol)
+ 	   (not (get symbol 'defalias-maybe)))
+-      (` (or (fboundp (quote (, symbol)))
+-	     (prog1
+-		 (defalias (quote (, symbol)) (, definition))
+-	       ;; `defalias' updates `load-history' internally.
+-	       (put (quote (, symbol)) 'defalias-maybe t))))))
++      `(or (fboundp (quote ,symbol))
++	   (prog1
++	       (defalias (quote ,symbol) ,definition)
++	     ;; `defalias' updates `load-history' internally.
++	     (put (quote ,symbol) 'defalias-maybe t)))))
+ 
+ (defmacro defvar-maybe (name &rest everything-else)
+   "Define NAME as a variable if NAME is not defined.
+ See also the function `defvar'."
+   (or (and (boundp name)
+ 	   (not (get name 'defvar-maybe)))
+-      (` (or (boundp (quote (, name)))
+-	     (prog1
+-		 (defvar (, name) (,@ everything-else))
+-	       ;; byte-compiler will generate code to update
+-	       ;; `load-history'.
+-	       (put (quote (, name)) 'defvar-maybe t))))))
++      `(or (boundp (quote ,name))
++	   (prog1
++	       (defvar ,name ,@everything-else)
++	     ;; byte-compiler will generate code to update
++	     ;; `load-history'.
++	     (put (quote ,name) 'defvar-maybe t)))))
+ 
+ (defmacro defconst-maybe (name &rest everything-else)
+   "Define NAME as a constant variable if NAME is not defined.
+ See also the function `defconst'."
+   (or (and (boundp name)
+ 	   (not (get name 'defconst-maybe)))
+-      (` (or (boundp (quote (, name)))
+-	     (prog1
+-		 (defconst (, name) (,@ everything-else))
+-	       ;; byte-compiler will generate code to update
+-	       ;; `load-history'.
+-	       (put (quote (, name)) 'defconst-maybe t))))))
++      `(or (boundp (quote ,name))
++	   (prog1
++	       (defconst ,name ,@everything-else)
++	     ;; byte-compiler will generate code to update
++	     ;; `load-history'.
++	     (put (quote ,name) 'defconst-maybe t)))))
+ 
+ (defmacro defun-maybe-cond (name args &optional doc &rest clauses)
+   "Define NAME as a function if NAME is not defined.
+@@ -152,26 +152,26 @@
+ 	    doc nil))
+   (or (and (fboundp name)
+ 	   (not (get name 'defun-maybe)))
+-      (` (or (fboundp (quote (, name)))
+-	     (prog1
+-		 (static-cond
+-		  (,@ (mapcar
+-		       (function
+-			(lambda (case)
+-			  (list (car case)
+-				(if doc
+-				    (` (defun (, name) (, args)
+-					 (, doc)
+-					 (,@ (cdr case))))
+-				  (` (defun (, name) (, args)
+-				       (,@ (cdr case))))))))
+-		       clauses)))
+-	       ;; This `defun' will be compiled to `fset',
+-	       ;; which does not update `load-history'.
+-	       ;; We must update `current-load-list' explicitly.
+-	       (setq current-load-list
+-		     (cons (quote (, name)) current-load-list))
+-	       (put (quote (, name)) 'defun-maybe t))))))
++      `(or (fboundp (quote ,name))
++	   (prog1
++	       (static-cond
++		,@(mapcar
++		   (function
++		    (lambda (case)
++		      (list (car case)
++			    (if doc
++				`(defun ,name ,args
++				   ,doc
++				   ,@(cdr case))
++			      `(defun ,name ,args
++				 ,@ (cdr case))))))
++		   clauses))
++	     ;; This `defun' will be compiled to `fset',
++	     ;; which does not update `load-history'.
++	     ;; We must update `current-load-list' explicitly.
++	     (setq current-load-list
++		   (cons (quote ,name) current-load-list))
++	     (put (quote ,name) 'defun-maybe t)))))
+ 
+ (defmacro defmacro-maybe-cond (name args &optional doc &rest clauses)
+   "Define NAME as a macro if NAME is not defined.
+@@ -184,26 +184,26 @@
+ 	    doc nil))
+   (or (and (fboundp name)
+ 	   (not (get name 'defmacro-maybe)))
+-      (` (or (fboundp (quote (, name)))
+-	     (prog1
+-		 (static-cond
+-		  (,@ (mapcar
+-		       (function
+-			(lambda (case)
+-			  (list (car case)
+-				(if doc
+-				    (` (defmacro (, name) (, args)
+-					 (, doc)
+-					 (,@ (cdr case))))
+-				  (` (defmacro (, name) (, args)
+-				       (,@ (cdr case))))))))
+-		       clauses)))
+-	       ;; This `defmacro' will be compiled to `fset',
+-	       ;; which does not update `load-history'.
+-	       ;; We must update `current-load-list' explicitly.
+-	       (setq current-load-list
+-		     (cons (quote (, name)) current-load-list))
+-	       (put (quote (, name)) 'defmacro-maybe t))))))
++      `(or (fboundp (quote ,name))
++	   (prog1
++	       (static-cond
++		,@(mapcar
++		   (function
++		    (lambda (case)
++		      (list (car case)
++			    (if doc
++				`(defmacro ,name ,args
++				   ,doc
++				   ,@(cdr case))
++			      `(defmacro ,name ,args
++				 @(cdr case))))))
++		   clauses))
++	     ;; This `defmacro' will be compiled to `fset',
++	     ;; which does not update `load-history'.
++	     ;; We must update `current-load-list' explicitly.
++	     (setq current-load-list
++		   (cons (quote ,name) current-load-list))
++	     (put (quote ,name) 'defmacro-maybe t)))))
+ 
+ (defmacro defsubst-maybe-cond (name args &optional doc &rest clauses)
+   "Define NAME as an inline function if NAME is not defined.
+@@ -216,26 +216,26 @@
+ 	    doc nil))
+   (or (and (fboundp name)
+ 	   (not (get name 'defsubst-maybe)))
+-      (` (or (fboundp (quote (, name)))
+-	     (prog1
+-		 (static-cond
+-		  (,@ (mapcar
+-		       (function
+-			(lambda (case)
+-			  (list (car case)
+-				(if doc
+-				    (` (defsubst (, name) (, args)
+-					 (, doc)
+-					 (,@ (cdr case))))
+-				  (` (defsubst (, name) (, args)
+-				       (,@ (cdr case))))))))
+-		       clauses)))
+-	       ;; This `defsubst' will be compiled to `fset',
+-	       ;; which does not update `load-history'.
+-	       ;; We must update `current-load-list' explicitly.
+-	       (setq current-load-list
+-		     (cons (quote (, name)) current-load-list))
+-	       (put (quote (, name)) 'defsubst-maybe t))))))
++      `(or (fboundp (quote ,name))
++	   (prog1
++	       (static-cond
++		,@ (mapcar
++		    (function
++		     (lambda (case)
++		       (list (car case)
++			     (if doc
++				 `(defsubst ,name ,args
++				    ,doc
++				    ,@ (cdr case))
++			       `(defsubst ,name ,args
++				  ,@(cdr case))))))
++		    clauses))
++	     ;; This `defsubst' will be compiled to `fset',
++	     ;; which does not update `load-history'.
++	     ;; We must update `current-load-list' explicitly.
++	     (setq current-load-list
++		   (cons (quote ,name) current-load-list))
++	     (put (quote ,name) 'defsubst-maybe t)))))
+ 
+ 
+ ;;; Edebug spec.
+@@ -246,7 +246,7 @@
+   "Set the edebug-form-spec property of SYMBOL according to SPEC.
+ Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
+ \(naming a function\), or a list."
+-  (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
++  `(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))
+ 
+ ;; edebug-spec for `def*-maybe' macros.
+ (def-edebug-spec defun-maybe defun)
Index: files/patch-static.el
===================================================================
RCS file: files/patch-static.el
diff -N files/patch-static.el
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ files/patch-static.el	24 Aug 2012 00:34:45 -0000
@@ -0,0 +1,71 @@
+Index: static.el
+===================================================================
+--- static.el	(revision 2)
++++ static.el	(working copy)
+@@ -29,38 +29,38 @@
+   "Like `if', but evaluate COND at compile time."
+   (if (eval cond)
+       then
+-    (` (progn  (,@ else)))))
++    `(progn  ,@else)))
+ 
+ (put 'static-when 'lisp-indent-function 1)
+ (defmacro static-when (cond &rest body)
+   "Like `when', but evaluate COND at compile time."
+   (if (eval cond)
+-      (` (progn (,@ body)))))
++      `(progn ,@body)))
+ 
+ (put 'static-unless 'lisp-indent-function 1)
+ (defmacro static-unless (cond &rest body)
+   "Like `unless', but evaluate COND at compile time."
+   (if (eval cond)
+       nil
+-    (` (progn (,@ body)))))
++    `(progn ,@body)))
+ 
+ (put 'static-condition-case 'lisp-indent-function 2)
+ (defmacro static-condition-case (var bodyform &rest handlers)
+   "Like `condition-case', but evaluate BODYFORM at compile time."
+-  (eval (` (condition-case (, var)
+-	       (list (quote quote) (, bodyform))
+-	     (,@ (mapcar
+-		  (if var
+-		      (function
+-		       (lambda (h)
+-			 (` ((, (car h))
+-			     (list (quote funcall)
+-				   (function (lambda ((, var)) (,@ (cdr h))))
+-				   (list (quote quote) (, var)))))))
+-		    (function
+-		     (lambda (h)
+-		       (` ((, (car h)) (quote (progn (,@ (cdr h)))))))))
+-		  handlers))))))
++  (eval `(condition-case ,var
++	     (list (quote quote) ,bodyform)
++	   ,@(mapcar
++	      (if var
++		  (function
++		   (lambda (h)
++		     `(,(car h)
++		       (list (quote funcall)
++			     (function (lambda (,var) ,@(cdr h)))
++			     (list (quote quote) ,var)))))
++		(function
++		 (lambda (h)
++		   `(,(car h) (quote (progn ,@(cdr h)))))))
++	      handlers))))
+ 
+ (put 'static-defconst 'lisp-indent-function 'defun)
+ (defmacro static-defconst (symbol initvalue &optional docstring)
+@@ -68,8 +68,8 @@
+ 
+ The variable SYMBOL can be referred at both compile time and run time."
+   (let ((value (eval initvalue)))
+-    (eval (` (defconst (, symbol) (quote (, value)) (, docstring))))
+-    (` (defconst (, symbol) (quote (, value)) (, docstring)))))
++    (eval `(defconst ,symbol (quote ,value) ,docstring))
++    `(defconst ,symbol (quote ,value) ,docstring)))
+ 
+ (defmacro static-cond (&rest clauses)
+   "Like `cond', but evaluate CONDITION part of each clause at compile time."