; .EnTete "Le-Lisp (c) version 15.2" " " "Loadfile de l'Enfer" ; .EnPied "loadfile.ll" "%" " " ; .SuperTitre "Loadfile de l'Enfer" ; ; .Auteur "Vindieux Matheu" ; ; .Centre "*****************************************************************" ; .Centre " (c) Le-Lisp est une marque de'pose'e de l'INRIA " ; .Centre "*****************************************************************" ; ; .Centre "$Header: loadfile.ll,v 4.1 88/01/13 12:35:20 kuczynsk Rel $" (unless (>= (version) 15.2) (error 'load 'erricf 'loadfile)) (setq #:sys-package:colon 'system) (unless (boundp 'ERRLOADFILEREADING) (defvar :current-line) (defvar :curread) (defvar :read-line) (defvar ERRLOADFILEINFILE #+ #:system:foreign-language "error in file" #- #:system:foreign-language "erreur dans le fichier") (defvar ERRLOADFILEATLINE #+ #:system:foreign-language "at line" #- #:system:foreign-language "a la ligne") (defvar ERRLOADFILEREADING #+ #:system:foreign-language "while reading" #- #:system:foreign-language "durant la lecture de") (defvar :loaded-from-file) ) (de loadfile (file redef?) (ifn (probefile file) (error 'loadfile errfile file) (let ((:current-line 0) :read-line :curread (#:sys-package:itsoft (ifn (memq ':loadfile #:sys-package:itsoft) (cons ':loadfile #:sys-package:itsoft) #:sys-package:itsoft)) :loaded-from-file (:redef-flag redef?) (#:sys-package:colon #:sys-package:colon) (:in-read-flag ())) (with ((inchan (openi file))) (protect (untilexit eof (setq :read-line (add1 :current-line)) (setq :loaded-from-file (cons file :read-line)) (eval (read))) (when (inchan) (close (inchan))))) file))) (de :loadfile:bol () (incr :current-line) (super-itsoft ':loadfile 'bol ())) (de :loadfile:eof (n) (setq :curread (with ((inchan n)) (curread))) (super-itsoft ':loadfile 'eof (list n))) (de :loadfile:syserror (:f :m :b) (prin "** " ERRLOADFILEINFILE (car :loaded-from-file) " : " ERRLOADFILEATLINE " : ") (if (and (eq :m 'errsxt) (memq :b '(2 3 5 11)) (<> :read-line :current-line)) (print :read-line "-" :current-line) (print :current-line)) (unless :curread (setq :curread (curread))) (when :curread (with ((printline 1)) (print "**" ERRLOADFILEREADING " : " (cdr :curread)))) (super-itsoft ':loadfile 'syserror (list :f :m :b)))