Date: Sat, 25 Aug 2012 12:01:12 +0000 (UTC) From: MANTANI Nobutaka <nobutaka@FreeBSD.org> To: ports-committers@freebsd.org, svn-ports-all@freebsd.org, svn-ports-head@freebsd.org Subject: svn commit: r303130 - in head/editors/apel: . files Message-ID: <201208251201.q7PC1CmP034525@svn.freebsd.org>
next in thread | raw e-mail | index | archive | help
Author: nobutaka Date: Sat Aug 25 12:01:11 2012 New Revision: 303130 URL: http://svn.freebsd.org/changeset/ports/303130 Log: Fix old-style backquotes issue. PR: ports/170961 Submitted by: Yasuhiro KIMURA <yasu@utahime.org> Added: head/editors/apel/files/patch-broken.el (contents, props changed) head/editors/apel/files/patch-filename.el (contents, props changed) head/editors/apel/files/patch-pccl.el (contents, props changed) head/editors/apel/files/patch-poe.el (contents, props changed) head/editors/apel/files/patch-product.el (contents, props changed) head/editors/apel/files/patch-pym.el (contents, props changed) head/editors/apel/files/patch-static.el (contents, props changed) Modified: head/editors/apel/Makefile (contents, props changed) Modified: head/editors/apel/Makefile ============================================================================== --- head/editors/apel/Makefile Sat Aug 25 11:37:59 2012 (r303129) +++ head/editors/apel/Makefile Sat Aug 25 12:01:11 2012 (r303130) @@ -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} Added: head/editors/apel/files/patch-broken.el ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ head/editors/apel/files/patch-broken.el Sat Aug 25 12:01:11 2012 (r303130) @@ -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 Added: head/editors/apel/files/patch-filename.el ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ head/editors/apel/files/patch-filename.el Sat Aug 25 12:01:11 2012 (r303130) @@ -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)) Added: head/editors/apel/files/patch-pccl.el ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ head/editors/apel/files/patch-pccl.el Sat Aug 25 12:01:11 2012 (r303130) @@ -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 Added: head/editors/apel/files/patch-poe.el ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ head/editors/apel/files/patch-poe.el Sat Aug 25 12:01:11 2012 (r303130) @@ -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 @@ *** DIFF OUTPUT TRUNCATED AT 1000 LINES ***
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?201208251201.q7PC1CmP034525>