mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-04-21 09:10:41 -07:00
Code Issues Projects Releases Packages Wiki Activity

Final fixes to ~( parser

Browse source
This commit is contained in:
jgarcia 2008-02-04 22:57:39 +00:00
parent 1b5ea4a433
commit bc39c7189f
2 changed files with 22 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/lsp/config.lsp.in
View file

@ -24,7 +24,7 @@ Returns, as a string, the location of the machine on which ECL runs."
(defun lisp-implementation-version ()
"Args:()
Returns the version of your ECL as a string."
"@PACKAGE_VERSION@ (CVS 2008-02-04 21:03)")
"@PACKAGE_VERSION@ (CVS 2008-02-04 23:57)")
(defun machine-type ()
"Args: ()

48
src/lsp/format.lsp
View file

@ -1996,13 +1996,16 @@
:downcase)))))
,@(expand-directive-list before))
#+ecl
`(princ
(,(if colonp
(if atsignp 'nstring-upcase 'nstring-capitalize)
(if atsignp 'nstring-capitalize-first 'nstring-downcase))
(with-output-to-string (stream)
,@(expand-directive-list before)))
stream))
`(let ((string (make-array 10 :element-type 'character :fill-pointer 0
:adjustable t)))
(unwind-protect
(with-output-to-string (stream string)
,@(expand-directive-list before))
(princ (,(if colonp
(if atsignp 'nstring-upcase 'nstring-capitalize)
(if atsignp 'nstring-capitalize-first 'nstring-downcase))
string)
stream))))
after))))
(def-complex-format-interpreter #\( (colonp atsignp params directives)
@ -2029,26 +2032,17 @@
(let* ((posn (position close directives))
(before (subseq directives 0 posn))
(jumped t)
(after (nthcdr (1+ posn) directives)))
(princ
(funcall (if colonp
(if atsignp
'nstring-upcase
'nstring-capitalize)
(if atsignp
'nstring-capitalize-first
'nstring-downcase))
(with-output-to-string (stream)
(setf args
(catch 'up-and-out
(prog1
(interpret-directive-list stream before
orig-args args)
(setf jumped nil)
)))))
stream)
(when jumped
(throw 'up-and-out args))
(after (nthcdr (1+ posn) directives))
(string (make-array 10 :element-type 'character :adjustable t
:fill-pointer 0)))
(unwind-protect
(with-output-to-string (stream string)
(setf args (interpret-directive-list stream before orig-args args)))
(princ (funcall
(if colonp
(if atsignp 'nstring-upcase 'nstring-capitalize)
(if atsignp 'nstring-capitalize-first 'nstring-downcase))
string) stream))
after))))
(def-complex-format-directive #\) ()