Date: Fri, 24 Aug 2012 10:58:51 +0900 (JST) From: Yasuhiro KIMURA <yasu@utahime.org> To: FreeBSD-gnats-submit@FreeBSD.org Subject: ports/170961: [PATCH] editors/apel: fix old-style backquotes issue Message-ID: <20120824015851.638782E504@eastasia.home.utahime.org> Resent-Message-ID: <201208240210.q7O2A6nA013240@freefall.freebsd.org>
next in thread | raw e-mail | index | archive | help
>Number: 170961
>Category: ports
>Synopsis: [PATCH] editors/apel: fix old-style backquotes issue
>Confidential: no
>Severity: non-critical
>Priority: low
>Responsible: freebsd-ports-bugs
>State: open
>Quarter:
>Keywords:
>Date-Required:
>Class: sw-bug
>Submitter-Id: current-users
>Arrival-Date: Fri Aug 24 02:10:06 UTC 2012
>Closed-Date:
>Last-Modified:
>Originator: Yasuhiro KIMURA
>Release: FreeBSD 9.0-RELEASE-p4 i386
>Organization:
>Environment:
System: FreeBSD xxxx 9.0-RELEASE-p4 FreeBSD 9.0-RELEASE-p4 #0: Sun Aug 12 22:27:34 JST 2012 xxxx i386
>Description:
Fix old-style backquotes issue
>How-To-Repeat:
>Fix:
--- patch-apel begins here ---
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."
--- patch-apel ends here ---
>Release-Note:
>Audit-Trail:
>Unformatted:
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?20120824015851.638782E504>