diff --git a/clim/pixmap-streams.lisp b/clim/pixmap-streams.lisp index 08c8c8c18e97d0ea44aeedd5840d53e845bd1414..f9c2937f1625a20f1ac868f869cce8b5c8d36837 100644 --- a/clim/pixmap-streams.lisp +++ b/clim/pixmap-streams.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: pixmap-streams.lisp,v 1.14 92/11/09 19:54:58 cer Exp $ +;; $fiHeader: pixmap-streams.lisp,v 1.15 92/12/03 10:27:24 cer Exp $ (in-package :clim-internals) @@ -61,13 +61,12 @@ (defun pixmap-from-menu-item (associated-window menu-item printer presentation-type &optional text-style) (with-menu (menu associated-window) - (setf (stream-text-margin menu) 1000) (let ((record (with-output-recording-options (menu :draw nil :record t) (with-output-to-output-record (menu) (handler-case - (with-text-style (menu text-style) - (if presentation-type - (present menu-item presentation-type :stream menu) + (with-text-style (menu text-style) + (if presentation-type + (present menu-item presentation-type :stream menu) (funcall printer menu-item menu))) (error () (write-string "Error in printer" menu))))))) @@ -77,6 +76,30 @@ (draw-rectangle* stream 0 0 width height :ink +background-ink+ :filled t) (replay-output-record - record stream +everywhere+ - (- (bounding-rectangle-left record)) - (- (bounding-rectangle-top record)))))))) + record stream +everywhere+ + (- (bounding-rectangle-left record)) + (- (bounding-rectangle-top record)))))))) + +;;; This code would be nice to use since it will eliminate the +;;; creation of a whole bunch of pixmaps. However, quite often you get +;;; multiple text output records and presentations. I suppose in +;;; theory this could be handled by making sure that the +;;; text-output-records line up nicely but........ This is tricky and +;;; will be more efficient than creating a pixmap? + +#+ignore +(defun find-single-text-output-record (record) + ;; If the output history contains just one text output record + ;; nested inside presentations and boring types of composite output + ;; records then return it + (loop + (let ((class (class-of record))) + (cond ((or (eq class (find-class 'standard-presentation)) + (eq class (find-class 'standard-sequence-output-record))) + (if (= (output-record-count record) 1) + (setq record (output-record-element record 0)) + (return nil))) + ((eq class (find-class 'standard-text-output-record)) + (return record)) + (t (return nil)))))) + diff --git a/demo/bitmap-editor.lisp b/demo/bitmap-editor.lisp index 00b6efd50e8b00b424623e06205877f51ff7c4a0..bff65c11faf8e4a7c6c10d6b1536c706a434ebea 100644 --- a/demo/bitmap-editor.lisp +++ b/demo/bitmap-editor.lisp @@ -21,7 +21,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: bitmap-editor.lisp,v 1.12 92/12/16 16:47:20 cer Exp $ +;; $fiHeader: bitmap-editor.lisp,v 1.13 93/01/18 13:55:01 cer Exp $ (in-package :clim-demo) @@ -63,30 +63,30 @@ (formatting-item-list (stream :n-columns 2 :x-spacing 30) (formatting-cell (stream) (setf current-color - (position - (accept `((completion ,colors) - :name-key ,#'identity - :printer ,#'display-color) - :view '(radio-box-view - :orientation :vertical - :toggle-button-options (:indicator-type nil)) - :stream stream - :default (nth current-color colors) - :prompt "Colors") - colors))) + (position + (accept `((completion ,colors) + :name-key ,#'identity + :printer ,#'display-color) + :view '(radio-box-view + :orientation :vertical + :toggle-button-options (:indicator-type nil)) + :stream stream + :default (nth current-color colors) + :prompt "Colors") + colors))) (formatting-cell (stream) (formatting-item-list (stream :n-columns 1 :y-spacing 10) (formatting-cell (stream) (accept-values-command-button (stream) - "Add Color" + "Add color" (add-new-color frame))) (formatting-cell (stream) (accept-values-command-button (stream) - "Edit Color" + "Edit Color" (replace-current-color frame))) (formatting-cell (stream) (accept-values-command-button (stream) - "Delete Color" + "Delete Color" (delete-current-color frame))))))))) diff --git a/hpgl/pkg.lisp b/hpgl/pkg.lisp index 71f34c4e2a8ead357f47403063b81939afa6f518..fce1c6e76f9011d833cb1006bf4142461f76fa8a 100644 --- a/hpgl/pkg.lisp +++ b/hpgl/pkg.lisp @@ -1,13 +1,13 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $fiHeader$ +;; $fiHeader: pkg.lisp,v 1.1 93/03/04 08:57:32 cer Exp $ "Copyright (c) 1991 by International Lisp Associates. All rights reserved." "Portions copyright (c) 1992 Franz Inc. All rights reserved" (in-package :common-lisp-user) -(provide :hpglps) +(provide :climhpgl) (defpackage :hpgl-clim (:export #:with-output-to-hpgl-stream) diff --git a/postscript/postscript-port.lisp b/postscript/postscript-port.lisp index 21c7d2af8b272283e9e4b52a8681f43161d5be25..07bba4acf9a49f0d384dacec29729a3dd36bc362 100644 --- a/postscript/postscript-port.lisp +++ b/postscript/postscript-port.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: POSTSCRIPT-CLIM; Base: 10; Lowercase: Yes -*- -;; $fiHeader: postscript-port.lisp,v 1.16 93/03/19 09:44:27 cer Exp $ +;; $fiHeader: postscript-port.lisp,v 1.17 93/03/31 10:39:21 cer Exp $ (in-package :postscript-clim) @@ -750,7 +750,7 @@ end } def (defmethod initialize-instance :after ((port postscript-port) &key) (with-slots (silica::default-palette) port - (setf silica::default-palette (make-instance 'postscript-palette)))) + (setf silica::default-palette (make-palette port)))) (defmethod realize-graft ((port postscript-port) (graft standard-graft)) (with-slots (page-width page-height) port diff --git a/test/hpgl-tests.lisp b/test/hpgl-tests.lisp new file mode 100644 index 0000000000000000000000000000000000000000..a92621fb35204fb95a4c247bbcd7b9f624cebbfc --- /dev/null +++ b/test/hpgl-tests.lisp @@ -0,0 +1,20 @@ +;;; -*- Mode: LISP; Syntax: Common-lisp; Package: hpgl-clim; Base: 10; Lowercase: Yes -*- + +;; $fiHeader: hpgl-tests.lisp,v 1.2 93/03/31 10:39:01 cer Exp $ + +(in-package :clim-user) + +(defmethod invoke-with-output-to-printer-stream ((type (eql :hpgl)) stream continuation) + (hpgl-clim:with-output-to-hpgl-stream (*standard-output* stream) + (funcall continuation))) + +(defmethod invoke-with-pipe-to-printer ((type (eql :hpgl)) continuation) + (with-open-stream + (printer-stream + (excl:run-shell-command (format nil "/usr/tech/cer/3rd/hpgl2ps-v2/hpgl2ps | lpr -P~A" *allegro-printer*) + :input :stream :wait + nil)) + (funcall continuation printer-stream))) + +(defun run-hpgl-tests (&key (output :view)) + (run-printer-tests output :hpgl)) diff --git a/test/postscript-tests.lisp b/test/postscript-tests.lisp index b55827faafeb4d2e23c8b5fe7fa4643dc59144ce..ba8c375f910e3cd5844b2e545cfc62ec39a26c5f 100644 --- a/test/postscript-tests.lisp +++ b/test/postscript-tests.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*- -;; $fiHeader: postscript-tests.lisp,v 1.6 93/03/19 09:46:31 cer Exp $ +;; $fiHeader: postscript-tests.lisp,v 1.7 93/03/31 10:39:42 cer Exp $ (in-package :clim-user) @@ -146,12 +146,12 @@ (defun send-output-to-file (continuation) - (with-open-file - (file-stream "postscript.output" :direction :output :if-exists :supersede) - (invoke-with-output-to-printer-stream - (frame-printer-type *application-frame*) - file-stream - continuation))) + (let ((type (frame-printer-type *application-frame*))) + (with-open-file (file-stream (format nil "~A.output" (string-downcase type)) :direction :output :if-exists :supersede) + (invoke-with-output-to-printer-stream + type + file-stream + continuation)))) (defun send-output-to-printer (continuation) (invoke-with-pipe-to-printer