Skip to content
Snippets Groups Projects
Commit a5d7db8f authored by cer's avatar cer
Browse files

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
parent f435f558
No related branches found
No related tags found
No related merge requests found
;;; -*- 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))))))
......@@ -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)))))))))
......
;;; -*- 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)
......
;;; -*- 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
......
;;; -*- 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))
;;; -*- 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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment