Ignore:
Timestamp:
08/17/12 06:26:49 (9 years ago)
Author:
ehuelsmann
Message:

Fix some compilation warnings and errors.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/top-level.lisp

    r14071 r14101  
    4242(in-package #:top-level)
    4343
    44 (import '(sys::%format sys::list-traced-functions sys::trace-1 sys::untrace-1 sys::untrace-all))
    4544
    4645(defvar *null-cmd* (gensym))
     
    6261  (fresh-line stream)
    6362  (when (> *debug-level* 0)
    64     (%format stream "[~D~A] "
     63    (sys::%format stream "[~D~A] "
    6564             *debug-level*
    6665             (if sys::*inspect-break* "i" "")))
    67   (%format stream "~A(~D): " (prompt-package-name) *cmd-number*))
     66  (sys::%format stream "~A(~D): " (prompt-package-name) *cmd-number*))
    6867
    6968(defparameter *repl-prompt-fun* #'repl-prompt-fun)
     
    9594  (declare (ignore ignored))
    9695  (when *debug-condition*
    97     (let* ((s (%format nil "~A" *debug-condition*))
     96    (let* ((s (sys::%format nil "~A" *debug-condition*))
    9897           (len (length s)))
    9998      (when (plusp len)
     
    101100        (unless (eql (schar s (1- len)) #\.)
    102101          (setf s (concatenate 'string s "."))))
    103       (%format *debug-io* "~A~%" s))
     102      (sys::%format *debug-io* "~A~%" s))
    104103    (show-restarts (compute-restarts) *debug-io*)))
    105104
     
    173172(defun package-command (args)
    174173  (cond ((null args)
    175          (%format *standard-output* "The ~A package is current.~%"
     174         (sys::%format *standard-output* "The ~A package is current.~%"
    176175                  (package-name *package*)))
    177176        ((and *old-package* (string= args "-") (null (find-package "-")))
     
    185184               (setf *old-package* *package*
    186185                     *package* pkg)
    187                (%format *standard-output* "Unknown package ~A.~%" args))))))
     186               (sys::%format *standard-output* "Unknown package ~A.~%" args))))))
    188187
    189188(defun reset-command (ignored)
     
    206205             (setf args (namestring *old-pwd*))
    207206             (progn
    208                (%format t "No previous directory.")
     207               (sys::%format t "No previous directory.")
    209208               (return-from cd-command))))
    210209        ((and (> (length args) 1) (string= (subseq args 0 2) "~/")
     
    218217            (setf *old-pwd* *default-pathname-defaults*
    219218                  *default-pathname-defaults* dir))
    220           (%format t "~A" (namestring *default-pathname-defaults*)))
    221         (%format t "Error: no such directory (~S).~%" args))))
     219          (sys::%format t "~A" (namestring *default-pathname-defaults*)))
     220        (sys::%format t "Error: no such directory (~S).~%" args))))
    222221
    223222(defun ls-command (args)
     
    266265(defun pwd-command (ignored)
    267266  (declare (ignore ignored))
    268   (%format t "~A~%" (namestring *default-pathname-defaults*)))
     267  (sys::%format t "~A~%" (namestring *default-pathname-defaults*)))
    269268
    270269(defun trace-command (args)
    271270  (if (null args)
    272     (%format t "~A~%" (list-traced-functions))
     271    (sys::%format t "~A~%" (sys::list-traced-functions))
    273272    (dolist (f (tokenize args))
    274       (trace-1 (read-from-string f)))))
     273      (sys::trace-1 (read-from-string f)))))
    275274
    276275(defun untrace-command (args)
    277276  (if (null args)
    278     (untrace-all)
     277    (sys::untrace-all)
    279278    (dolist (f (tokenize args))
    280       (untrace-1 (read-from-string f)))))
     279      (sys::untrace-1 (read-from-string f)))))
    281280
    282281(defconstant spaces (make-string 32 :initial-element #\space))
     
    286285      (concatenate 'string string (subseq spaces 0 (- width (length string))))
    287286      string))
    288 
    289 (defun %help-command (prefix)
    290   (let ((prefix-len (length prefix)))
    291     (when (and (> prefix-len 0)
    292                (eql (schar prefix 0) *command-char*))
    293       (setf prefix (subseq prefix 1))
    294       (decf prefix-len))
    295     (%format t "~%  COMMAND     ABBR DESCRIPTION~%")
    296     (dolist (entry *command-table*)
    297       (when (or (null prefix)
    298                 (and (<= prefix-len (length (entry-name entry)))
    299                      (string-equal prefix (subseq (entry-name entry) 0 prefix-len))))
    300         (%format t "  ~A~A~A~%"
    301                  (pad (entry-name entry) 12)
    302                  (pad (entry-abbreviation entry) 5)
    303                  (entry-help entry))))
    304     (%format t "~%Commands must be prefixed by the command character, which is '~A'~A.~%~%"
    305              *command-char* (if (eql *command-char* #\:) " by default" ""))))
    306 
    307 (defun help-command (&optional ignored)
    308   (declare (ignore ignored))
    309   (%help-command nil))
    310287
    311288(defparameter *command-table*
     
    333310    ("untrace" "untr" untrace-command "untrace function(s)")))
    334311
     312(defun %help-command (prefix)
     313  (let ((prefix-len (length prefix)))
     314    (when (and (> prefix-len 0)
     315               (eql (schar prefix 0) *command-char*))
     316      (setf prefix (subseq prefix 1))
     317      (decf prefix-len))
     318    (sys::%format t "~%  COMMAND     ABBR DESCRIPTION~%")
     319    (dolist (entry *command-table*)
     320      (when (or (null prefix)
     321                (and (<= prefix-len (length (entry-name entry)))
     322                     (string-equal prefix (subseq (entry-name entry) 0 prefix-len))))
     323        (sys::%format t "  ~A~A~A~%"
     324                 (pad (entry-name entry) 12)
     325                 (pad (entry-abbreviation entry) 5)
     326                 (entry-help entry))))
     327    (sys::%format t "~%Commands must be prefixed by the command character, which is '~A'~A.~%~%"
     328             *command-char* (if (eql *command-char* #\:) " by default" ""))))
     329
     330(defun help-command (&optional ignored)
     331  (declare (ignore ignored))
     332  (%help-command nil))
     333
    335334(defun entry-name (entry)
    336335  (first entry))
     
    368367      (let ((command (find-command command-string)))
    369368        (cond ((null command)
    370                (%format t "Unknown top-level command \"~A\".~%" command-string)
    371                (%format t "Type \"~Ahelp\" for a list of available commands." *command-char*))
     369               (sys::%format t "Unknown top-level command \"~A\".~%" command-string)
     370               (sys::%format t "Type \"~Ahelp\" for a list of available commands." *command-char*))
    372371              (t
    373372               (when args
     
    425424  (fresh-line)
    426425  (unless sys:*noinform*
    427     (%format t "Type \"~Ahelp\" for a list of available commands.~%" *command-char*))
     426    (sys::%format t "Type \"~Ahelp\" for a list of available commands.~%" *command-char*))
    428427  (loop
    429428    (setf *inspected-object* nil
Note: See TracChangeset for help on using the changeset viewer.