diff options
author | nobutaka <nobutaka@FreeBSD.org> | 2019-08-12 22:11:47 +0800 |
---|---|---|
committer | nobutaka <nobutaka@FreeBSD.org> | 2019-08-12 22:11:47 +0800 |
commit | 993dedd0dc773fd282ab8ba40cb9dc3a0a04c146 (patch) | |
tree | fce60360d378b01228a2a0494b450841c3e228d9 | |
parent | b2468aa59c03847944cd80f6f8ef493f31f7ac96 (diff) | |
download | freebsd-ports-gnome-993dedd0dc773fd282ab8ba40cb9dc3a0a04c146.tar.gz freebsd-ports-gnome-993dedd0dc773fd282ab8ba40cb9dc3a0a04c146.tar.zst freebsd-ports-gnome-993dedd0dc773fd282ab8ba40cb9dc3a0a04c146.zip |
- Switch to the version maintained by the developers of Wanderlust.
- Update to the snapshot on 2019-04-07.
-rw-r--r-- | editors/apel/Makefile | 9 | ||||
-rw-r--r-- | editors/apel/distinfo | 5 | ||||
-rw-r--r-- | editors/apel/files/patch-broken.el | 84 | ||||
-rw-r--r-- | editors/apel/files/patch-filename.el | 51 | ||||
-rw-r--r-- | editors/apel/files/patch-pccl.el | 268 | ||||
-rw-r--r-- | editors/apel/files/patch-poe.el | 1443 | ||||
-rw-r--r-- | editors/apel/files/patch-product.el | 83 | ||||
-rw-r--r-- | editors/apel/files/patch-pym.el | 282 | ||||
-rw-r--r-- | editors/apel/files/patch-static.el | 71 | ||||
-rw-r--r-- | editors/apel/pkg-descr | 5 |
10 files changed, 9 insertions, 2292 deletions
diff --git a/editors/apel/Makefile b/editors/apel/Makefile index d6f4b68175fd..0e49f402fe64 100644 --- a/editors/apel/Makefile +++ b/editors/apel/Makefile @@ -2,10 +2,8 @@ # $FreeBSD$ PORTNAME= apel -PORTVERSION= ${APEL_VER} -PORTREVISION= 18 +PORTVERSION= 10.8.${SNAPDATE} CATEGORIES= editors elisp -MASTER_SITES= http://git.chise.org/elisp/dist/apel/ PKGNAMESUFFIX= ${EMACS_PKGNAMESUFFIX} MAINTAINER= nobutaka@FreeBSD.org @@ -14,10 +12,13 @@ COMMENT= Portable Emacs Library LICENSE= GPLv2 USES= emacs +USE_GITHUB= yes +GH_ACCOUNT= wanderlust +GH_TAGNAME= d146ddb +SNAPDATE= 20190407 NO_ARCH= yes -APEL_VER= 10.8 ALL_TARGET= elc MAKE_ARGS+= PREFIX="${STAGEDIR}${PREFIX}" \ LISPDIR="${STAGEDIR}${PREFIX}/${EMACS_VERSION_SITE_LISPDIR}" \ diff --git a/editors/apel/distinfo b/editors/apel/distinfo index 641abd695c16..e871183bf4ba 100644 --- a/editors/apel/distinfo +++ b/editors/apel/distinfo @@ -1,2 +1,3 @@ -SHA256 (apel-10.8.tar.gz) = a511cc36bb51dc32b4915c9e03c67a994060b3156ceeab6fafa0be7874b9ccfe -SIZE (apel-10.8.tar.gz) = 126326 +TIMESTAMP = 1565577043 +SHA256 (wanderlust-apel-10.8.20190407-d146ddb_GH0.tar.gz) = 9709b1ed326a51c98f1f28722b03db725b904e0dbd771d441e098837266af7dd +SIZE (wanderlust-apel-10.8.20190407-d146ddb_GH0.tar.gz) = 94730 diff --git a/editors/apel/files/patch-broken.el b/editors/apel/files/patch-broken.el deleted file mode 100644 index 607a405ec734..000000000000 --- a/editors/apel/files/patch-broken.el +++ /dev/null @@ -1,84 +0,0 @@ -Index: broken.el -=================================================================== ---- broken.el.orig 2005-07-06 02:08:52 UTC -+++ broken.el -@@ -58,51 +58,51 @@ FACILITY must be symbol. - - 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 diff --git a/editors/apel/files/patch-filename.el b/editors/apel/files/patch-filename.el deleted file mode 100644 index d3414d1b1018..000000000000 --- a/editors/apel/files/patch-filename.el +++ /dev/null @@ -1,51 +0,0 @@ -Index: filename.el -=================================================================== ---- filename.el.orig 2005-07-06 02:08:52 UTC -+++ filename.el -@@ -102,26 +102,26 @@ Moreover, if you want to convert Japanes - 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)) diff --git a/editors/apel/files/patch-pccl.el b/editors/apel/files/patch-pccl.el deleted file mode 100644 index 204d68e30355..000000000000 --- a/editors/apel/files/patch-pccl.el +++ /dev/null @@ -1,268 +0,0 @@ -Index: pccl.el -=================================================================== ---- pccl.el.orig 2005-07-06 02:08:53 UTC -+++ pccl.el -@@ -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 diff --git a/editors/apel/files/patch-poe.el b/editors/apel/files/patch-poe.el deleted file mode 100644 index 656a4f5829f5..000000000000 --- a/editors/apel/files/patch-poe.el +++ /dev/null @@ -1,1443 +0,0 @@ ---- poe.el.orig 2008-09-06 15:16:14 UTC -+++ poe.el -@@ -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 @@ but in this case `load' insists on addin - 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 @@ Normally the return value is FEATURE." - ;; (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 @@ one of the properties on the list." - ;; (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 @@ If PROP is already a property on the lis - 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 @@ The PLIST is modified by side effects." - (>= 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 @@ See `read-from-minibuffer' for details o - (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 @@ DEF, if non-nil, is the default value. - - 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 @@ Completion ignores case if the ambient v - (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 @@ DEF, if non-nil, is the default value. - - 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 @@ Completion ignores case if the ambient v - ;; 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 @@ It ignores leading spaces and tabs. - 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 @@ If the base used is not 10, floating poi - ;; 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 @@ the value of `foo'." - ;; 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 @@ APEL provides this as dummy for compatib - (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 @@ The value of the last form in FORMS is r - 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 @@ STRING should be given if the last searc - ;; 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. -@@ -1080,48 +1080,48 @@ then capitalize each word in NEWTEXT. - - If third arg LITERAL is non-nil, insert NEWTEXT literally. - Otherwise treat `\' as special: -- `\&' in NEWTEXT means substitute original matched text. -- `\N' means substitute what matched the Nth `\(...\)'. -+ `\\&' in NEWTEXT means substitute original matched text. -+ `\\N' means substitute what matched the Nth `\\(...\\)'. - If Nth parens didn't match, substitute nothing. -- `\\' means insert one `\'. -+ `\\\\' means insert one `\\'. - FIXEDCASE and LITERAL are optional arguments. - Leaves point at end of replacement text. - - 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. -@@ -1132,34 +1132,34 @@ then capitalize each word in NEWTEXT. - - If third arg LITERAL is non-nil, insert NEWTEXT literally. - Otherwise treat `\' as special: -- `\&' in NEWTEXT means substitute original matched text. -- `\N' means substitute what matched the Nth `\(...\)'. -+ `\\&' in NEWTEXT means substitute original matched text. -+ `\\N' means substitute what matched the Nth `\\(...\\)'. - If Nth parens didn't match, substitute nothing. -- `\\' means insert one `\'. -+ `\\\\' means insert one `\'. - FIXEDCASE and LITERAL are optional arguments. - Leaves point at end of replacement text. - - 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 @@ which is made by replacing the part of S - ;; 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 @@ Compatibility Note. - 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'. -@@ -1667,7 +1667,7 @@ See `walk-windows' for the meaning of MI - ))) - ;; arglist: (prefix &optional dir-flag suffix) - (cond -- ((not arglist) -+ ((or (not arglist) (not (listp arglist))) - ;; `make-temp-file' is a built-in; expects 3-args. - (put 'make-temp-file 'defun-maybe '3-args)) - ((> (length arglist) 3) diff --git a/editors/apel/files/patch-product.el b/editors/apel/files/patch-product.el deleted file mode 100644 index 56aa05331836..000000000000 --- a/editors/apel/files/patch-product.el +++ /dev/null @@ -1,83 +0,0 @@ -Index: product.el -=================================================================== ---- product.el.orig 2006-04-24 05:53:58 UTC -+++ product.el -@@ -232,21 +232,21 @@ PRODUCT-DEF is a definition of the produ - (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 @@ The 1st argument is a product structure. - 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 ret - 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) diff --git a/editors/apel/files/patch-pym.el b/editors/apel/files/patch-pym.el deleted file mode 100644 index bb76ba06392f..000000000000 --- a/editors/apel/files/patch-pym.el +++ /dev/null @@ -1,282 +0,0 @@ -Index: pym.el -=================================================================== ---- pym.el.orig 2005-07-06 02:08:53 UTC -+++ pym.el -@@ -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 `defun'." - 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 function `defmacro'." - 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 @@ See also the function `defalias'." - (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 @@ See also the function `defun'." - 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 @@ See also the function `defmacro'." - 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 @@ See also the macro `defsubst'." - 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 @@ See also the macro `defsubst'." - "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) diff --git a/editors/apel/files/patch-static.el b/editors/apel/files/patch-static.el deleted file mode 100644 index abc5306317eb..000000000000 --- a/editors/apel/files/patch-static.el +++ /dev/null @@ -1,71 +0,0 @@ -Index: static.el -=================================================================== ---- static.el.orig 2005-07-06 02:08:53 UTC -+++ static.el -@@ -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." diff --git a/editors/apel/pkg-descr b/editors/apel/pkg-descr index 35859c84a01d..2c0e26797500 100644 --- a/editors/apel/pkg-descr +++ b/editors/apel/pkg-descr @@ -17,7 +17,4 @@ APEL stands for "A Portable Emacs Library" and contains these modules: - poem: provide basic functions to write portable MULE programs - static: utility for static evaluation -To use apel, put the following setup into your ~/.emacs: - (require 'apel-setupel) - -WWW: http://git.chise.org/elisp/apel/index.html.en +WWW: https://github.com/wanderlust/apel |