From a5d7db8f4751ef05aceded59a9f396e5c0780f99 Mon Sep 17 00:00:00 2001 From: cer <cer> Date: Fri, 2 Apr 1993 13:36:57 +0000 Subject: [PATCH] Makefile.defs Minor mods and added support for climhpgl.fasl and tests Removed xm-menus,graphics, and ol-graphics.lisp Makefile.generic added support for climhpgl.fasl and tests clim/accept-values.lisp graphic labels in accept-values-command-buttons clim/frames.lisp Added frame-current-panes, fixed problem with command disabling. clim/pixmap-streams.lisp Changed indentation climtoys/ccc.lisp Added com-show-class-generic-functions demo/bitmap-editor.lisp Indentation hpgl/hpgl-port.lisp Made hpgl-port have palette hpgl/pkg.lisp Fixed provide misc/compile-1.lisp Compile hpgl now misc/dev-load-1.lisp load hpgl now misc/train.lisp hpgl training, reporting of test results postscript/postscript-port.lisp calls make-palette sys/sysdcl.lisp removed ol-graphics etc test/postscript-tests.lisp output file name depends on type. test/test-clim.lisp Added etsts test/test-driver.lisp Support for reporting of tests tk/xlib.lisp Added composestatus support tk-silica/ol-gadgets.lisp Menu bar remembers buttons for disabling tk-silica/xm-frames.lisp Menu bar remembers buttons for disabling, accelerators only for pulldown menus tk-silica/xm-gadgets.lisp compose-space buttons with pixmap labels tk-silica/xm-silica.lisp minor mod tk-silica/xt-frames.lisp mapping from command to button to support disabling tk-silica/xt-graphics.lisp added make-medium method for xt-port tk-silica/xt-silica.lisp compose-status support --- clim/pixmap-streams.lisp | 39 ++++++++++++++++++++++++++------- demo/bitmap-editor.lisp | 30 ++++++++++++------------- hpgl/pkg.lisp | 4 ++-- postscript/postscript-port.lisp | 4 ++-- test/hpgl-tests.lisp | 20 +++++++++++++++++ test/postscript-tests.lisp | 14 ++++++------ 6 files changed, 77 insertions(+), 34 deletions(-) create mode 100644 test/hpgl-tests.lisp diff --git a/clim/pixmap-streams.lisp b/clim/pixmap-streams.lisp index 08c8c8c1..f9c2937f 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 00b6efd5..bff65c11 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 71f34c4e..fce1c6e7 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 21c7d2af..07bba4ac 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 00000000..a92621fb --- /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 b55827fa..ba8c375f 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 -- GitLab