projects
/
jscl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Newlines after semicolons if *PRETTY-PRINT* is set.
[jscl.git]
/
src
/
print.lisp
diff --git
a/src/print.lisp
b/src/print.lisp
index
48af786
..
02f3919
100644
(file)
--- a/
src/print.lisp
+++ b/
src/print.lisp
@@
-16,6
+16,8
@@
;; You should have received a copy of the GNU General Public License
;; along with JSCL. If not, see <http://www.gnu.org/licenses/>.
;; You should have received a copy of the GNU General Public License
;; along with JSCL. If not, see <http://www.gnu.org/licenses/>.
+(/debug "loading print.lisp!")
+
;;; Printer
(defun lisp-escape-string (string)
;;; Printer
(defun lisp-escape-string (string)
@@
-43,6
+45,7
@@
(when (or (terminalp ch)
(char= ch #\:)
(char= ch #\\)
(when (or (terminalp ch)
(char= ch #\:)
(char= ch #\\)
+ (not (char= ch (char-upcase ch)))
(char= ch #\|))
(return-from escape-symbol-name-p t))))
dots-only))
(char= ch #\|))
(return-from escape-symbol-name-p t))))
dots-only))
@@
-254,14
+257,19
@@
(let ((*print-escape* nil))
(write-to-string form)))
(let ((*print-escape* nil))
(write-to-string form)))
+(defun terpri ()
+ (write-char #\newline)
+ (values))
+
(defun write-line (x)
(write-string x)
(defun write-line (x)
(write-string x)
- (write-string *newline*)
+ (terpri)
x)
x)
-(defun warn (string)
+(defun warn (fmt &rest args)
(write-string "WARNING: ")
(write-string "WARNING: ")
- (write-line string))
+ (apply #'format t fmt args)
+ (terpri))
(defun print (x)
(write-line (prin1-to-string x))
(defun print (x)
(write-line (prin1-to-string x))
@@
-280,7
+288,7
@@
((char= next #\~)
(concatf res "~"))
((char= next #\%)
((char= next #\~)
(concatf res "~"))
((char= next #\%)
- (concatf res *newline*))
+ (concatf res (string #\newline)))
((char= next #\*)
(pop arguments))
(t
((char= next #\*)
(pop arguments))
(t
@@
-297,4
+305,8
@@
(defun format-special (chr arg)
(case (char-upcase chr)
(#\S (prin1-to-string arg))
(defun format-special (chr arg)
(case (char-upcase chr)
(#\S (prin1-to-string arg))
- (#\A (princ-to-string arg))))
+ (#\A (princ-to-string arg))
+ (#\D (princ-to-string arg))
+ (t
+ (warn "~S is not implemented yet, using ~~S instead" chr)
+ (prin1-to-string arg))))