August 2005 - mcclim-devel - mailman3.common-lisp.net

Re: [mcclim-devel] pathname and accept
by rpgoldman＠real-time.com 10 Aug '05

10 Aug '05

Sorry. Let me be more clear (or at least more specific). I have an application that is an MDP (Markov Decision Problem) solver. I have a command that loads a file with an MDP description in it. So I want to ACCEPT a pathname that corresponds to an existing MDP description file. So I want ACCEPT to reject any pathname that doesn't (at least) correspond to a file that really exists. It's a bit of a nuisance, when I use the current UI (which doesn't enforce file existence), to type in a filename, find out that I mistyped, and then have to start over. I would prefer to have ACCEPT help me out by rejecting my input and allowing me to revise it. Does that help? The best test example I could find was the following: (in-package :CLIM-USER) ;;; this stuff doesn't work as well as I would like, unfortunately. [2005/08/10:rpg] (define-presentation-type extant-pathname () :inherit-from 'pathname) (define-presentation-method presentation-typep (object (type extant-pathname)) (and (presentation-typep object 'pathname) (probe-file object))) (define-presentation-method accept ((type extant-pathname) stream view &rest args &key) (let ((raw-value (call-next-method))) (when (probe-file raw-value) (return-from accept (values raw-value 'extant-pathname))) (format stream "~&No directory entry for ~A ~%" raw-value) (apply #'accept type :stream stream :view view args))) But when I try to do this, and type in a pathname that does not correspond to an extant file, it seems to return some odd default. McCLIM correctly rejects the bad value, and prints my format string, but instead of giving me a chance to enter a good value, it just returns the current working directory! (I'd show the results, but I tested in the clim-listener, whence I cannot cut-and-paste :-/). I'm hoping that I've just done something dopey here, and that's why this doesn't work. [BTW, I was poking around at the CLIMACS code base to see if I could pull out a completing-pathname type, but I thought I would see if I could get the existence constraint to work first...]

1 0

[mcclim-devel] pathname and accept
by rpgoldman＠real-time.com 10 Aug '05

10 Aug '05

[Apologies if this is a dumb question...] AFAICT there's no way for me to try to ACCEPT a pathname that is constrained to refer to a file that already exists. Is this true? I could imagine trying to create a new presentation subtype of pathname that would meet this constraint. But doesn't it seem that it would have been reasonable to make a pathname a compound type that would allow for constraints? Also, I have been looking at the Allegro CLIM UG and the CLIM 2 spec, and I have not been able to determine what sort of guarantees ACCEPT provides. When it reads one of my previously-existing pathnames, for example, will it be obligated to run presentation-typep at some point to check that the filename is actually previously-extant? Or is it allowed to just hope that the user has typed in a string that refers to a previously-existing filename, instead of the name of his grandmother's dog? I don't know exactly how to test this, but my rudimentary tests with trace seem to indicate that ACCEPT isn't doing any verification. Is that right? If so, and I want to enforce this constraint, should I be making an :around method for accept that will check the constraint and either return if it's satisfied, or invoke call-next-method if it's violated? I would have thought that there would have been some protocol for bad input (e.g., raise a particular exceptionq), but my cursory examination of the spec doesn't reveal any such. Thanks, Robert

3 5

[mcclim-devel] question about error message
by rpgoldman＠real-time.com 09 Aug '05

09 Aug '05

I run my mcclim application in a separate process under Allegro CL 6.2. Periodically I get the following kind of oddity appearing in my main REPL window (not one of the McCLIM windows): #<GOATEE::BUFFER-BOUNDS-ERROR @ #x7209b98a> #<GOATEE::BUFFER-BOUNDS-ERROR @ #x7209c582> #<GOATEE::BUFFER-BOUNDS-ERROR @ #x7209d05a> Any idea what this might mean? Am I worried? R

1 0

[mcclim-devel] StudlyCaps directories
by Christophe Rhodes 05 Aug '05

05 Aug '05

Um, how come no-one's noticed this before? With a case-insensitive filesystem (such as is found, I believe, on at least some PowerPCs that seem absurdly popular these days), odd things happen to the CVS repository. I see, in the McCLIM directory, lisp-dep/ and Lisp-Dep/ looks/ and Looks/ examples/ and Examples/ Backends/postscript and Backends/PostScript and this has just caused real problems over here, as we attempted to extract diffs for Backends/PostScript/ whereas we had the CVS/Entries file for Backends/postscript... Is it possible to remove these duplicatedly-named directories? Cheers, Christophe

4 3

[mcclim-devel] Would McCLIM benefit from this pretty printer patch for CMUCL/SBCL?
by Matthias Koeppe 04 Aug '05

04 Aug '05

Dear McCLIM list, I have worked on a patch for the pretty printer of CMUCL and SBCL that helps support the new presentation-like features of SLIME in conjunction with the pretty printer. I'd like to ask if someone of you could comment on whether this patch would be useful for McCLIM as well. If so, this would be another reason for including it at as a core extension into SBCL and CMUCL. The patch implements a feature of the Allegro CL pretty printer, which is called SCHEDULE-ANNOTATION there. This function queues arbitrary functions ("annotations") in the pretty-printing stream in sequence with the characters that are printed to the stream, until the stream has decided on the concrete layout. When the characters are forwarded to the target stream, the annotations are invoked at the right position. In my changes to SLIME, I use the function as follows. I believe (without knowing much about CLIM) that it should be possible to use similar code to send CLIM presentation data (output records?), font changes, etc. cleanly through pretty-printing streams. ;; If we are printing to an XP (pretty printing) stream, printing the ;; escape sequences directly would mess up the layout because column ;; counting is disturbed. Use "annotations" instead. #+allegro (defun write-annotation (stream function arg) (if (typep stream 'excl:xp-simple-stream) (excl::schedule-annotation stream function arg) (funcall function arg stream nil))) #+cmu (defun write-annotation (stream function arg) (if (typep stream 'pp:pretty-stream) (pp::enqueue-annotation stream function arg) (funcall function arg stream nil))) #+sbcl (defun write-annotation (stream function arg) (if (typep stream 'sb-pretty::pretty-stream) (sb-pretty::enqueue-annotation stream function arg) (funcall function arg stream nil))) #-(or allegro cmu sbcl) (defun write-annotation (stream function arg) (funcall function arg stream nil)) (defstruct presentation-record (id) (printed-p)) (defun presentation-start (record stream truncatep) (unless truncatep ;; Don't start new presentations when nothing is going to be ;; printed due to *print-lines*. (let ((pid (presentation-record-id record))) (cond (*use-dedicated-output-stream* (write-string "<" stream) (prin1 pid stream) (write-string "" stream)) (t (force-output stream) (send-to-emacs `(:presentation-start ,pid))))) (setf (presentation-record-printed-p record) t))) (defun presentation-end (record stream truncatep) (declare (ignore truncatep)) ;; Always end old presentations that were started. (when (presentation-record-printed-p record) (let ((pid (presentation-record-id record))) (cond (*use-dedicated-output-stream* (write-string ">" stream) (prin1 pid stream) (write-string "" stream)) (t (force-output stream) (send-to-emacs `(:presentation-end ,pid))))))) (defun presenting-object-1 (object stream continue) "Uses the bridge mechanism with two messages >id and <id. The first one says that I am starting to print an object with this id. The second says I am finished" (if (and *record-repl-results* *can-print-presentation* (slime-stream-p stream)) (let* ((pid (swank::save-presented-object object)) (record (make-presentation-record :id pid :printed-p nil))) (write-annotation stream #'presentation-start record) (multiple-value-prog1 (funcall continue) (write-annotation stream #'presentation-end record))) (funcall continue))) I am including the pretty-printer patch (for SBCL) at the end of this message. Cheers, -- Matthias Koeppe -- http://www.math.uni-magdeburg.de/~mkoeppe diff -u /home/mkoeppe/s/slime/sbcl/pprint.lisp.orig /home/mkoeppe/s/slime/sbcl/pprint.lisp --- /home/mkoeppe/s/slime/sbcl/pprint.lisp.orig 2005-07-19 22:56:54.000000000 +0200 +++ /home/mkoeppe/s/slime/sbcl/pprint.lisp 2005-07-24 19:27:29.000000000 +0200 @@ -89,7 +89,12 @@ (queue-tail nil :type list) (queue-head nil :type list) ;; Block-start queue entries in effect at the queue head. - (pending-blocks nil :type list)) + (pending-blocks nil :type list) + ;; Queue of annotations to the buffer. + ;; Annotations are first put into the queue of pending operations. + ;; Just before output they are put into the queue of annotations. + (annotations-tail nil :type list) + (annotations-head nil :type list)) (def!method print-object ((pstream pretty-stream) stream) ;; FIXME: CMU CL had #+NIL'ed out this code and done a hand-written ;; FORMAT hack instead. Make sure that this code actually works instead @@ -360,6 +365,11 @@ (:section-relative (values t t))) (enqueue stream tab :sectionp sectionp :relativep relativep :colnum colnum :colinc colinc))) + +(defstruct (annotation (:include queued-op)) + (handler (constantly nil) :type function) + (record)) + ;;;; tab support @@ -452,6 +462,101 @@ (unless (eq new-buffer buffer) (replace new-buffer buffer :end1 end :end2 end)))))) +;;;; Annotation support + +(defun enqueue-annotation (stream handler record) + #!+sb-doc + "Insert an annotation into the pretty-printing stream STREAM. +HANDLER is a function, and RECORD is an arbitrary datum. The +pretty-printing stream conceptionally queues annotations in sequence +with the characters that are printed to the stream, until the stream +has decided on the concrete layout. When the characters are forwarded +to the target stream, annotations are invoked at the right position. +An annotation is invoked by calling the function HANDLER with the +three arguments RECORD, TARGET-STREAM, and TRUNCATEP. The argument +TRUNCATEP is true if the text surrounding the annotation is suppressed +due to line abbreviation (see *PRINT-LINES*). +If STREAM is not a pretty-printing stream, simply call HANDLER +with the arguments RECORD, STREAM and nil." + (if (pretty-stream-p stream) + (enqueue stream annotation :handler handler + :record record) + (funcall handler record stream nil))) + +(defun re-enqueue-annotation (stream annotation) + #!+sb-doc + "Insert ANNOTATION into the queue of annotations in STREAM." + (let* ((annotation-cons (list annotation)) + (head (pretty-stream-annotations-head stream))) + (if head + (setf (cdr head) annotation-cons) + (setf (pretty-stream-annotations-tail stream) annotation-cons)) + (setf (pretty-stream-annotations-head stream) annotation-cons))) + +(defun re-enqueue-annotations (stream end) + #!+sb-doc + "Insert all annotations in STREAM from the queue of pending +operations into the queue of annotations. When END is non-nil, +stop before reaching the queued-op END." + (loop for tail = (pretty-stream-queue-tail stream) then (cdr tail) + while (and tail (not (eql tail end))) + when (annotation-p (car tail)) + do (re-enqueue-annotation stream (car tail)))) + +(defun dequeue-annotation (stream &key end-posn) + #!+sb-doc + "Dequeue the next annotation from the queue of annotations of STREAM +and return it. Return nil if there are no more annotations. When +:END-POSN is given and the next annotation has a posn greater than +this, also return nil." + (let ((next-annotation (car (pretty-stream-annotations-tail stream)))) + (when next-annotation + (when (or (not end-posn) + (<= (annotation-posn next-annotation) end-posn)) + (pop (pretty-stream-annotations-tail stream)) + (unless (pretty-stream-annotations-tail stream) + (setf (pretty-stream-annotations-head stream) nil)) + next-annotation)))) + +(defun invoke-annotation (stream annotation truncatep) + (let ((target (pretty-stream-target stream))) + (funcall (annotation-handler annotation) + (annotation-record annotation) + target + truncatep))) + +(defun output-buffer-with-annotations (stream end) + #!+sb-doc + "Output the buffer of STREAM up to (excluding) the buffer index END. +When annotations are present, invoke them at the right positions." + (let ((target (pretty-stream-target stream)) + (buffer (pretty-stream-buffer stream)) + (end-posn (index-posn end stream)) + (start 0)) + (loop + for annotation = (dequeue-annotation stream :end-posn end-posn) + while annotation + do + (let ((annotation-index (posn-index (annotation-posn annotation) + stream))) + (when (> annotation-index start) + (write-string buffer target :start start + :end annotation-index) + (setf start annotation-index)) + (invoke-annotation stream annotation nil))) + (when (> end start) + (write-string buffer target :start start :end end)))) + +(defun flush-annotations (stream end truncatep) + #+sb-doc + "Invoke all annotations in STREAM up to (including) the buffer index END." + (let ((end-posn (index-posn end stream))) + (loop + for annotation = (dequeue-annotation stream :end-posn end-posn) + while annotation + do (invoke-annotation stream annotation truncatep)))) + + ;;;; stuff to do the actual outputting (defun ensure-space-in-buffer (stream want) @@ -520,10 +625,11 @@ (ecase (fits-on-line-p stream (block-start-section-end next) force-newlines-p) ((t) - ;; Just nuke the whole logical block and make it look - ;; like one nice long literal. + ;; Just nuke the whole logical block and make it look like one + ;; nice long literal. (But don't nuke annotations.) (let ((end (block-start-block-end next))) (expand-tabs stream end) + (re-enqueue-annotations stream end) (setf tail (cdr (member end tail))))) ((nil) (really-start-logical-block @@ -536,7 +642,9 @@ (block-end (really-end-logical-block stream)) (tab - (expand-tabs stream next)))) + (expand-tabs stream next)) + (annotation + (re-enqueue-annotation stream next)))) (setf (pretty-stream-queue-tail stream) tail)) output-anything)) @@ -582,13 +690,17 @@ (if last-non-blank (1+ last-non-blank) 0))))) - (write-string buffer target :end amount-to-print) + (output-buffer-with-annotations stream amount-to-print) + (flush-annotations stream amount-to-consume nil) (let ((line-number (pretty-stream-line-number stream))) (incf line-number) (when (and (not *print-readably*) (pretty-stream-print-lines stream) (>= line-number (pretty-stream-print-lines stream))) (write-string " .." target) + (flush-annotations stream + (pretty-stream-buffer-fill-pointer stream) + t) (let ((suffix-length (logical-block-suffix-length (car (pretty-stream-blocks stream))))) (unless (zerop suffix-length) @@ -640,8 +752,7 @@ (buffer (pretty-stream-buffer stream))) (when (zerop count) (error "Output-partial-line called when nothing can be output.")) - (write-string buffer (pretty-stream-target stream) - :start 0 :end count) + (output-buffer-with-annotations stream count) (incf (pretty-stream-buffer-start-column stream) count) (replace buffer buffer :end1 new-fill-ptr :start2 count :end2 fill-ptr) (setf (pretty-stream-buffer-fill-pointer stream) new-fill-ptr) @@ -650,9 +761,10 @@ (defun force-pretty-output (stream) (maybe-output stream nil) (expand-tabs stream nil) - (write-string (pretty-stream-buffer stream) - (pretty-stream-target stream) - :end (pretty-stream-buffer-fill-pointer stream))) + (re-enqueue-annotations stream nil) + (output-buffer-with-annotations stream + (pretty-stream-buffer-fill-pointer stream))) + ;;;; user interface to the pretty printer

4 6

[mcclim-devel] McCLIM's dialog.lisp and ACL 7.0
by Robert P. Goldman 03 Aug '05

03 Aug '05

When I tried to recompile McCLIM on ACL 7.0 it crashed because there were some ignorable declarations applied to functions. These are specifically permitted by the ANSI spec. I was a little surprised by this --- I haven't before seen a case where ACL's conformance has degraded with a new version. Any one else seen this? Thanks, R

1 0

[mcclim-devel] Re: international text-style support
by Christophe Rhodes 02 Aug '05

02 Aug '05

[ a very long time ago, in the context of supporting complicated international scripts ] Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de> writes: > Brian Spilsbury writes: > > I have implement (somewhat primitive) international text-style support. > > [...] > > This sounds like a somewhat reasonable design to me, although I would > very much prefer if we could move the fontset logic into the frontend > by coming up with a sort of font protocol. So, now, we (at Goldsmiths) have a need for a specific font. At the moment, we have hacked in support to our application using MAKE-DEVICE-FONT-TEXT-STYLE and some extreme hackiness in CLIM-CLX::TEXT-STYLE-TO-X-FONT; the device-font-text-style support in current CVS is ... not extensive, which is not really surprising given that the spec is approximately equally non-extensive. It tickled my memory, though, and I dug up this proposal: > Something like this: > > A font is a mapping from glyph names (indicies) to glyphs. Fonts > have additional attributes like name, weight, an encoding, a > language and so on. Glyphs have metrics and are drawable to > individual media. > > FONT protocol class > > FONT-NAME font method > FONT-WEIGHT font method > FONT-SLANT font method > FONT-... font method > > The individual typographical properties of the font. > > SCALE-FONT font size -> font method > > Scales the font to a new size. > [Q1: Unit for size?] > [Q2: Should this affect metrics?] > > FONT-SIZE font method > > Returns the size of the font. > > TRANSFORM-FONT font transformation -> font method > > Applies a affine transformation to the font. Each glyph drawn with > the returned font are then drawn under the transformation. This > does not affect the individual glyph metrics. > > FONT-TRANSFORMATION font -> transformation method > > Returns the transformation of the font font. > > FONT-GLYPH-METRICS font glyph method > -> width ascent descent left-bearing right-bearing > > Returns the fonts glyph metrics. To calculate the metrics of > glyphs as drawn my draw-glyph the transformation of the font has > to be applied to the returned values. > > [This is to keep the glyph-metrics as scalars instead of making > each metric into a vector]. > > width should not be negative in case of RTL script, since > typesetting from right to left is consided to be a property of a > text-style; likewise left-bearing bearing on the left hand side > as right bearing is bearing on the right hand size. > > Q4: Is there something like top-bearing, bottom-bearing for fonts > designed towards top-to-bottom scripts? > > > FONT-KERNING font glyph-1 glyph-2 method > > Returns the kerning to be applied when typesetting glyph-1 left of > glyph-2. > > DRAW-GLYPH medium font glyph x y method > > [Q3: Interaction with general designs? Ideally we would make glyphs > into designs itself]. > > A text-style is a mapping of chracter sequences to font, glyph, > position triples for drawing. A text-style then might refer to > multiple fonts thus forming a fontset. > > Each medium then knows its available fonts. These can be queried by > the frontend and combined into a text style. > > As you can see there are some questions and I am not entirely sure how > things should really look like. Nor am I. I don't suppose anyone else has had thoughts in the last three years? We need: a way of specifying that we want to draw text using a specific font (in our case, a FreeType font for tablature) at a specific size. If that's not a DEVICE-FONT-TEXT-STYLE, I don't know where else it should go, but it does imply that a DEVICE-FONT has size. I'm away from my workstation, but tomorrow I'll send patches showing what we're currently doing. Cheers, Christophe

1 1