Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/upsala/fixpel.clisp
There are no other files named fixpel.clisp in the archive.
;;; -*- Mode:CLISP; Package:LISP -*-
;Aida::Ss:<Clisp.Upsala>Fixpel.Clisp.11, 20-Mar-86 03:05:40, Ed: Victor
; It isn't a feature, it's a module. Provide it.
;Aida::Ss:<Clisp.Upsala>Fixpel.Clisp.11, 17-Jan-86 12:48:41, Ed: Victor
; Export Fixpel-Error-Init, but don't call it, let the user choose.
;Aida::Ss:<Clisp.Upsala>Fixpel.Clisp.2, 15-Jan-86 19:07:14, Ed: Victor
; Gaah. Started looking at the code, sorry.
; Define FIXPEL-foobar-handler, and define fixpel-error-init, so people who
;don't like it can revert by saying (lisp::error-init).
; Rehacked some strings too. This code needs cleaning up, believe me...
;;; Aida::Ss:<Clisp.Upsala>Fixpel.Clisp.1, 23-Dec-85 23:37:08, Ed: Victor
;;; Merged Per's Handlers and DWIM into FIXPEL.CLISP,
;;; set *dwim-searched-packages* to something reasonable,
;;; made it a feature to have Fixpel.
;<D85.PER-MILDNER.CLISP>HANDLERS.CLISP.7, 9-Dec-85 23:58:42, Edit by D85.PER-MILDNER
; Now it's possible to get a description of a symbol at query.
;<D85.PER-MILDNER.CLISP>HANDLERS.CLISP.123, 6-Dec-85 05:13:42, Edit by D85.PER-MILDNER
; Added friendlier query-fun to everything (Argh again).
;<D85.PER-MILDNER.CLISP>HANDLERS.CLISP.91, 5-Dec-85 02:42:22, Edit by D85.PER-MILDNER
; Added handler for unbound function (Argh..)
;<D85.PER-MILDNER.CLISP>HANDLERS.CLISP.83, 3-Dec-85 17:42:56, Edit by D85.PER-MILDNER
; Yet another complete rehack now also handles local variables.
;<D85.PER-MILDNER.CLISP>HANDLERS.CLISP.18, 2-Dec-85 17:25:49, Edit by D85.PER-MILDNER
; Complete rehack now also handles step and stuff at top-level.
;<D85.PER-MILDNER.CLISP>ERRH.CLISP.29, 27-Nov-85 03:40:37, Edit by D85.PER-MILDNER
; Created.
;;; By Per Mildner
(provide "FIXPEL")
(in-package 'lisp)
(export '(*dwim-searched-packages* similar-pname-p fixpel-error-init))
(defvar *%handler-debug* nil
"Controls some printout from the handler.")
(defvar *dwim-searched-packages*
(remove (find-package 'keyword)
(remove (find-package 'compiler)
(list-all-packages)))
"A package,symbol or a list of such denoting the packages to search in
after misspelled symbols. If T search all packages including internals.")
;;; Fixpel-unbound-variable handler is a handler for the :unbound-variable
;;; condition. If the error is signaled correctably, then the correction
;;; value is obtained either by getting a new symbol from user or
;;; by forcing the user to setq the symbol in the break loop.
;;; Note for hackers: It would be desirable to correctly patch even in
;;; sub-evaluations e.g. (defun foo ()
;;; (eval '(let ((flip flop) (blip blip))
;;; (cons flip blip)))).
;;; It doesn't work just to use nsubst on (spdlrt nexteval..) because
;;; of the possibility that a symbol appears at more than one place,
;;; compare with (blip blip) above.
;;; I have not figured out how to get a handle to the cons inside a let as
;;; above and it doesn't seem to be possible.
;;; Fixpel-Undefined-Function-Handler
(defun Fixpel-unbound-variable-handler
(ignore continue-string function error-string &rest args)
(declare (ignore ignore))
(error-print error-string args function continue-string)
(if continue-string
(let ((error-level (get-error))
(var (car args)))
(if error-level
(let*
((sp-err (car error-level))
(p-err (cdr error-level))
(sp-p-var (multiple-value-list (nextbl sp-err p-err)))
(sp (car sp-p-var))
(varentry (caddr sp-p-var)) ; Var should be cdr of varentry.
(nextevalblip (or (and (numberp sp) (nextev (1- sp))) sp))
(formentry (memq var (spdlrt nextevalblip)))
(ans
(%dwimdosyms
var sp-err
"Use the local variable ~A instead?"
"Use the global ~[variable~;constant~] ~A instead?"))
(returnkey (car ans))
(newvar (cdr ans)))
(if ans
(progn
(if varentry (setf (cdr varentry) newvar))
(if formentry (setf (car formentry) newvar))
(return-from Fixpel-unbound-variable-handler
(values returnkey
(speval sp-err newvar)))))
;;; Comes here if no symbols matched or suited the user.
(prog ()
loop
(internal-break-loop)
(if (speval sp-err `(boundp ',var))
(return (values ':return (speval sp var))))
(format *error-output*
"~%;Warning, Can not proceed until ~S has been Setq'd."
var)
(go loop)))
;;; Goes here if error-level could not be determined
;;; This should never happen but in that case use (boundp ..)
;;; instead of (speval...) since there's no context for speval.
(prog ()
loop
(internal-break-loop)
(if (boundp var)
(return-from Fixpel-unbound-variable-handler
(values ':return (symbol-value var))))
(format *error-output*
"~%;Warning, Can not proceed until ~S has been Setq'd."
var)
(go loop))))
;;; Goes here if continue-string was nil i.e. if the error was
;;; uncorrectable.
(dont-proceed)))
;;; Fixpel-Undefined-Function-Handler
;;; Fixpel-undefined-function-handler is a handler for the :undefined-function
;;; condition. If the error is signaled correctably, then the correction
;;; value is obtained either by getting a new symbol from user or
;;; by forcing the user to define it in the break loop.
(defun Fixpel-undefined-function-handler
(ignore continue-string function error-string &rest args)
(declare (ignore ignore))
(error-print error-string args function continue-string)
(if continue-string
(let ((error-level (get-error))
(var (car args)))
(if error-level
(let*
((sp-err (car error-level))
(p-err (cdr error-level))
(sp-p-var (multiple-value-list (nextbl sp-err p-err)))
(sp (car sp-p-var))
(varentry (caddr sp-p-var)) ; Var should be cdr of varentry.
(formentry (memq var varentry)))
(when formentry
(let*
((ans (%dwimdofuns
var sp-err
"Use the local ~[function~;macro~] ~A instead?"
"Use the ~[function~;macro~;special form~] ~A ~
instead?"))
(newvar (cdr ans)))
(when ans ; I.e. match and user liked it.
(setf (car formentry) newvar)
;;; return (values :return (symbol-function..))
;;; doesn't work so we'll have to do this instead:
(spredo sp) ; And Pray...
;;; Spredo never returns, but if, then I want to know.
(format *error-output*
"~%Internal error in FIXPEL, please report it!!!"))))
;;; Comes here if no symbols were good or if something went wrong.
(prog ()
loop
(internal-break-loop)
(if (fboundp var)
(return (values ':return (symbol-function var))))
(format *error-output*
"~%;Warning, Can not proceed until ~S has been defun'd."
var)
(go loop)))
;;; Goes here if error-level could not be determined
;;; This should never happen but in that case use (boundp ..)
;;; instead of (speval...) since there's no context for speval.
(prog ()
loop
(internal-break-loop)
(if (fboundp (car args))
(return (values ':return (symbol-function (car args)))))
(format *error-output*
"~%;Warning, Can not proceed until ~S has been defun'd."
(car args))
(go loop))))
;;; Goes here if continue-string was nil i.e. if the error was
;;; uncorrectable.
(dont-proceed)))
(defun %dwimdosyms (var sp-err local-query global-query)
"A very local elephantiasis function."
(let ((asked ()))
;;; Check if any local symbols match.
(and (speval sp-err `(boundp '%venv%))
(do*
((matches? (member var
(mapcan #'(lambda (x) ; Filter out non conses.
(if (consp x)
`(,(car x))))
(speval sp-err '%venv%))
:test #'similar-pname-p)
(member var (cdr matches?) :test #'similar-pname-p))
(newvar (car matches?) (car matches?)))
((atom matches?))
(and
(not (memq newvar asked)) ; Only ask once.
(push newvar asked) ; Remember the already asked.
(let ((ans
(%dwimquery
sp-err nil nil local-query
"Answer~%~
~7TYes to use this local variable instead of ~
the undefined one,~%~
~7TNo to search for another matching symbol,~%~
~7TQuit to get to the break-loop immediately or~%~
~7T'symb to use this symb instead." newvar)))
(ecase (car ans)
(:no nil)
(:yes
(return-from %dwimdosyms (cons :return newvar)))
(:quit
(return-from %dwimdosyms nil))
(:return
(return-from %dwimdosyms ans)))))))
;;; Check if any global symbols of the current package match.
(do-symbols
(newvar *package*)
(and
(speval sp-err `(boundp ',newvar))
(similar-pname-p var newvar)
(not (memq newvar asked)) ; Don't ask more than once.
(push newvar asked) ; Remember which have been asked.
(loop
(let* ((what (or (and (assoc `lisp::%constant newvar) 1) 0))
;; What is 0 for constants 1 for variables.
(ans
(%dwimquery
sp-err nil t global-query
"Answer~%~
~7TYes to use this ~[constant~;variable~] ~
instead of the undefined one,~%~
~7TNo to search for another matching symbol,~%~
~7TQuit to get to the break-loop immediately,~%~
~7TDescribe to describe it or~%~
~7T'symb to use this symb instead." what newvar)))
(ecase (car ans)
(:no (return nil))
(:yes
(return-from %dwimdosyms (cons :return newvar)))
(:quit
(return-from %dwimdosyms nil))
(:describe (describe newvar))
(:return
(return-from %dwimdosyms ans)))))))
;;; Check if any global symbols from the other packages match.
(or
(and (eq *dwim-searched-packages* t) ; If package-list is T
(let ((ans
(%dwimquery
sp-err nil nil
"Look at the internal symbols of all packages ~
for a match?"
"Answer~%~
~7TYes to try to find a matching internal symbol ~
(may take some time),~%~
~7TNo to only look at exported symbols,~%~
~7TQuit to get to the break-loop immediately or~%~
~7T'symb to use this symb instead.")))
(ecase (car ans)
(:no nil)
(:yes T)
(:quit
(return-from %dwimdosyms nil))
(:return
(return-from %dwimdosyms ans))))
;;; Check all symbols in all packages.
(do-all-symbols
(newvar)
(and
(speval sp-err `(boundp ',newvar))
(similar-pname-p var newvar)
(not (memq newvar asked)) ; Don't ask more than once.
(push newvar asked) ; Remember which have been asked.
(loop
(let* ((what (or (and (assoc `lisp::%constant newvar) 1) 0))
;; What is 0 for constants 1 for variables.
(ans
(%dwimquery
sp-err nil t global-query
"Answer~%~
~7TYes to use this ~[constant~;variable~] instead ~
of the undefined one,~%~
~7TNo to search for another matching symbol,~%~
~7TQuit to get to the break-loop immediately,~%~
~7TDescribe to describe it or~%~
~7T'symb to use this symb instead." what newvar)))
(ecase (car ans)
(:no (return nil))
(:yes
(return-from %dwimdosyms (cons :return newvar)))
(:quit
(return-from %dwimdosyms nil))
(:describe (describe newvar))
(:return
(return-from %dwimdosyms ans))))))))
;;; Else Only check external-symbols of selected packages.
(let
((packages (remove *package* (%mdwimpln))))
(and packages
(let ((ans
(%dwimquery
sp-err nil nil
"Look at the symbols exported from~%~
the package~??"
"Answer~%~
~7TYes to try to find a matching external symbol,~%~
~7TNo or Quit to get to the break-loop immediately or~%~
~7T'symb to use this symbol instead."
"~p~#[ none~; ~a~; ~a and ~a~:;~
~@{~#[~; and~] ~a~^,~}~]"
(cons (length packages) (mapcar #'package-name packages)))))
(ecase (car ans)
(:yes T)
(:no
(return-from %dwimdosyms nil))
(:quit
(return-from %dwimdosyms nil))
(:return
(return-from %dwimdosyms ans))))
(dolist
(package (remove *package* (%mdwimpln)))
(do-external-symbols
(newvar package)
(and
(speval sp-err `(boundp ',newvar))
(not (memq newvar asked)) ; Only ask once.
(push newvar asked) ; Remember the already asked.
(similar-pname-p var newvar)
(loop
(let* ((what (or (and (assoc `lisp::%constant newvar) 1) 0))
;; What is 0 for constants 1 for variables.
(ans
(%dwimquery
sp-err nil t global-query
"Answer~%~
~7TYes to use this ~[constant~;variable~] instead ~
of the undefined one,~%~
~7TNo to search for another matching symbol,~%~
~7TQuit to get to the break-loop immediately,~%~
~7TDescribe to describe it or~%~
~7T'symb to use this symbol instead." what newvar)))
(ecase (car ans)
(:no
(return nil))
(:yes
(return-from %dwimdosyms (cons :return newvar)))
(:quit
(return-from %dwimdosyms nil))
(:describe (describe newvar))
(:return
(return-from %dwimdosyms ans)))))))))))))
(defun %dwimdofuns (fun sp-err local-query global-query)
"Just another very local elephantiasis function."
(let ((asked ()))
;;; Check if any local symbols match.
(when (speval sp-err `(boundp '%fenv%))
(let ((env (speval sp-err `%fenv%)))
(do*
((matches?
(member
fun
(mapcan #'(lambda (y) ; Filter out non conses from noisy a-list.
(if (consp y)
`(,(car y))))
env) :test #'similar-pname-p)
(member fun (cdr matches?) :test #'similar-pname-p))
(newfun (car matches?) (car matches?)))
((atom matches?))
(and
(not (memq newfun asked)) ; Only ask once.
(push newfun asked) ; Remember the already asked.
(let* ((what (or (and (eq 'macro (cadr (assoc newfun env))) 1)
0))
(ans
(%dwimquery
sp-err t nil local-query
"Answer~%~
~7TYes to use this local ~[function~;macro~] instead ~
of the undefined one,~%~
~7TNo to search for another matching symbol,~%~
~7TQuit to get to the break-loop immediately or~%~
~7T'FUN to use the form (normally a function-name) ~
ANY instead."
what newfun)))
(ecase (car ans)
(:no nil)
(:yes
(return-from %dwimdofuns (cons :return newfun)))
(:quit
(return-from %dwimdofuns nil))
(:return
(return-from %dwimdofuns ans))))))))
;;; Check if any global symbols of the current package match.
(do-symbols
(newfun *package*)
(and
(speval sp-err `(fboundp ',newfun))
(similar-pname-p fun newfun)
(not (memq newfun asked)) ; Only ask once.
(push newfun asked) ; Remember the already asked.
(loop
(let* ((what (or
(and (special-form-p newfun) 2)
(and
(speval sp-err `(macro-function ',newfun)) 1)
0))
;;; What is 0 if function, 1 if macro or 2 if a special-form.
(ans
(%dwimquery
sp-err t t global-query
"Answer~%~
~7TYes to use this global ~[function~;macro~;special form~] ~
instead of the undefined one,~%~
~7TNo to search for another matching symbol,~%~
~7TQuit to get to the break-loop immediately,~%~
~7TDescribe to describe it or~%~
~7T'FUN to use the form (normally a function-name) ~
FUN instead."
what newfun)))
(ecase (car ans)
(:no (return nil))
(:yes
(return-from %dwimdofuns (cons :return newfun)))
(:quit
(return-from %dwimdofuns nil))
(:describe (describe newfun))
(:return
(return-from %dwimdofuns ans)))))))
(or
(and (eq *dwim-searched-packages* t) ; If package-list is T
(let ((ans
(%dwimquery
sp-err t nil
"Look at the internal symbols of all packages ~
for a match?"
"Answer~%~
~7TYes to try to find a matching internal symbol ~
(may take some time),~%~
~7TNo to only look at exported symbols,~%~
~7TQuit to get to the break-loop immediately or~%~
~7T'FUN to use the form (normally a function-name) ~
FUN instead of the undefined symbol.")))
(ecase (car ans)
(:no
NIL)
(:yes T)
(:quit
(return-from %dwimdofuns nil))
(:return
(return-from %dwimdofuns ans))))
;;; Check all symbols in all packages..
(do-all-symbols
(newfun)
(and
(speval sp-err `(fboundp ',newfun))
(similar-pname-p fun newfun)
(not (memq newfun asked)) ; Only ask once.
(push newfun asked) ; Remember the already asked.
(loop
(let* ((what (or
(and (special-form-p newfun) 2)
(and
(speval sp-err `(macro-function ',newfun)) 1)
0))
;;; What is 0 if function, 1 if macro or 2 if a special-form.
(ans
(%dwimquery
sp-err t t global-query
"Answer~%~
~7TYes to use this global ~
~[function~;macro~;special form~] ~
instead of the undefined one,~%~
~7TNo to search for another matching symbol,~%~
~7TQuit to get to the break-loop immediately,~%~
~7TDescribe to describe it or~%~
~7T'FUN to use the form (normally a function-name)~%~~
FUN instead."
what newfun)))
(ecase (car ans)
(:no (return nil))
(:yes
(return-from %dwimdofuns (cons :return newfun)))
(:quit
(return-from %dwimdofuns nil))
(:describe (describe newfun))
(:return
(return-from %dwimdofuns ans))))))))
;;; Only check external-symbols of selected packages.
(let
((packages (remove *package* (%mdwimpln))))
(and packages
(let ((ans
(%dwimquery
sp-err nil nil
"Look at the symbols exported from~%~
the package~??"
"Answer~%~
~7TYes to try to find a matching external symbol,~%~
~7TNo or Quit to get to the break-loop immediately or~%~
~7T'FUN to use the form (normally a function-name) ~
FUN instead of the undefined symbol."
"~p~#[ none~; ~a~; ~a and ~a~:;~
~@{~#[~; and~] ~a~^,~}~]"
(cons (length packages) (mapcar #'package-name packages)))))
(ecase (car ans)
(:no
(return-from %dwimdofuns nil))
(:yes T)
(:quit
(return-from %dwimdofuns nil))
(:return
(return-from %dwimdofuns ans))))
(dolist
(package packages)
(do-external-symbols
(newfun package)
(and
(speval sp-err `(fboundp ',newfun))
(similar-pname-p fun newfun)
(not (memq newfun asked)) ; Only ask once.
(push newfun asked) ; Remember the already asked.
(loop
(let* ((what (or
(and (special-form-p newfun) 2)
(and
(speval sp-err `(macro-function ',newfun)) 1)
0))
;;; What is 0 if function, 1 if macro or 2 if a special-form.
(ans
(%dwimquery
sp-err t t global-query
"Answer~%~
~7TYes to use this ~[function~;macro~;special form~] ~
instead of the undefined one,~%~
~7TNo to search for another matching symbol,~%~
~7TQuit to get to the break-loop immediately,~%~
~7TDescribe to describe it or~%~
~7T'FUN to use the form (normally a function-name) ~
FUN instead."
what newfun)))
(ecase (car ans)
(:no (return nil))
(:yes
(return-from %dwimdofuns (cons :return newfun)))
(:quit
(return-from %dwimdofuns nil))
(:describe (describe newfun))
(:return
(return-from %dwimdofuns ans))))))))
))
)))
(defun %mdwimpln ()
; Make Dwim Package-List Normal.
"Implements the meaning of *dwim-searched-packages*"
(cond ((eq *dwim-searched-packages* t) ; T means check all packages.
(list-all-packages))
((packagep *dwim-searched-packages*) ; Could be a single package to.
(list *dwim-searched-packages*))
((symbolp *dwim-searched-packages*) ; or a symbol.
(let
((xx (find-package *dwim-searched-packages*)))
(if xx ; If a package of that name exists
(list xx)))) ; return a list of it.
((listp *dwim-searched-packages*)
; Is normally a list of packages or symbols denoting packages.
; If It's not this will convert it to that format making
; a symbol or a package into a list of a package or else
; turning all symbols into packages and removing all nonmatching
; symbols and other stuff.
(mapcan
#'(lambda (x)
(cond
((packagep x) (list x))
((symbolp x) (let ((xx (find-package x)))
(if xx (list xx))))))
*dwim-searched-packages*))))
(defun %dwimquery (sp any desc? query help &rest formatargs)
(let ((query (concatenate 'string query " (Y N D Q) ")))
(loop
(fresh-line)
(apply #'format *debug-io* query formatargs)
(let* ((ans (read *debug-io*))
(symans (and (consp ans) (null (caddr ans))
(eq (car ans) 'QUOTE)
(or any (symbolp (cadr ans)))))
(ans-string (and (symbolp ans) (subseq (symbol-name ans) 0 1))))
(cond (symans
(return-from %dwimquery (cons :return (cadr ans))))
((string-equal ans-string "Y")
(return-from %dwimquery '(:yes)))
((string-equal ans-string "N")
(return-from %dwimquery '(:no)))
((string-equal ans-string "Q")
(return-from %dwimquery '(:quit)))
((and desc? (string-equal ans-string "D"))
(return-from %dwimquery '(:describe)))
(t (apply #'format *debug-io* help formatargs)))))))
;<HACKS.CLISP.CARMEN>DWIM.CLISP.3, 9-Dec-85 17:28:19, Edit by D85.PER-MILDNER
; Redone for speed.
;<D85.PER-MILDNER.CLISP>DWIM.CLISP.24, 3-Dec-85 11:06:08, Edit by D85.PER-MILDNER
; Is Finixed jes?
;;; By Per Mildner.
;;; A spelling-corrector similar in purpose to Maclisp's Dwim.
;;;
;;; Algorithm:
;;; x matches y iff: 1. x has the same printname as y, or
;;; 2. x has two adjacent chars switched
;;; compared to y, or
;;; 3. x has one extra char compared to y, or
;;; 4. x has one char missing compared to y, or
;;; 5. x has one different char compared to y.
;;; exception: 2 and 5 does not apply if pname of x is one char long.
;;;
;;; Examples:
;;; ALAN matches ALAN, AALN, ALLAN, ALN, ALAM.
#| This version works too but is sometimes much slower.
(defun similar-pname-p (x y)
"T if the print-name of the symbol x is similar to that of the symbol y.
primarily useful as in:
(member 'xsym list-of-ysyms :test #'similar-pname-p)"
(let* ((xn (symbol-name x))
(xl (length xn))
(yn (symbol-name y))
(yl (length yn))
(x-y (- xl yl)))
(and
(<= -1 x-y 1) ; If length differ more than 1 char then skip immediately
; this is somewhat redundant but may speed things up.
(let ((indx1 (mismatch xn yn :test #'char-equal)))
(cond
((not indx1) t) ; No difference. (1. above)
((and (zerop x-y) ; Same length and
(> xl 1)) ; pname of x longer than one char.
(let ((indx2
(1- (mismatch xn yn :test #'char-equal :from-end t))))
(or (= indx1 indx2) ; One char is different. (5. above)
(string-equal ; Two chars is switched. (2. above)
(concatenate 'string
(subseq xn 0 indx1)
(string (elt xn (1+ indx1)))
(string (elt xn indx1))
(subseq xn (+ 2 indx1)))
yn))))
((plusp x-y) ; X has one extra char. (3. above)
(string-equal (concatenate 'string
(subseq xn 0 indx1)
(subseq xn (1+ indx1)))
yn))
((minusp x-y) ; X has one missing char. (4. above)
(string-equal (concatenate 'string
(subseq yn 0 indx1)
(subseq yn (1+ indx1)))
xn)))))))
|#
(defun similar-pname-p (x y)
"T if the print-name of the symbol x is similar to that of the symbol y.
primarily useful as in:
(member 'xsym list-of-ysyms :test #'similar-pname-p)."
(let* ((xn (symbol-name x))
(xl (length xn))
(yn (symbol-name y))
(yl (length yn))
(x-y (- xl yl)))
(and
(<= -1 x-y 1) ; If length differ more than 1 char then skip immediately
; this is somewhat redundant but may speed things up.
(let* ((indx1 (%sp-string-compare-ignore xn 0 xl yn 0 yl))
(indx1+1 (and indx1 (1+ indx1))))
(cond
((not indx1) t) ; No difference. (1. above)
((and (zerop x-y) ; Same length and
(> xl 1)) ; pname of x longer than one char.
(let ((indx2
(%sp-string-compare-ignore
xn indx1+1 xl yn indx1+1 yl)))
(or (not indx2) ; One char is different. (5. above)
(and
(char-equal (aref xn indx1) (aref yn indx1+1))
(char-equal (aref xn indx1+1) (aref yn indx1))))))
((plusp x-y) ; X has one extra char. (3. above)
(not (%sp-string-compare-ignore xn indx1+1 xl yn indx1 yl)))
((minusp x-y) ; X has one missing char. (4. abovze)
(not (%sp-string-compare-ignore xn indx1 xl yn indx1+1 yl))))))))
(defun fixpel-error-init ()
(condition-psetq
:unbound-variable #'fixpel-unbound-variable-handler
:undefined-function #'fixpel-undefined-function-handler
))