From 0038dbe78969314e4ec0a556498770c9a352a07c Mon Sep 17 00:00:00 2001
From: cer <cer>
Date: Tue, 27 Apr 1993 14:36:16 +0000
Subject: [PATCH] .cvsignore		Ignore extra files Makefile.defs
 	Added hpgl to directory list, Uncommented malloclib stuff
 clim/command.lisp	Implemented ensure-command-in-command-table and :after
 :replace clim/incremental-redisplay.lisp	Setf all-new slot of record to
 NIL after its used climtoys/ib.lisp	Usual hacking
 demo/graphics-editor.lisp	made command-table menu  use :divider
 tk/make-classes.lisp		Map list and scrolling-list to ol-list
 tk/xm-font-list.lisp		Motif 1.2 font list code. tk/xm-funs.lisp
 		Motif 1.2 font list code. tk-silica/ol-gadgets.lisp
 command menu updating and :divider stuff. tk-silica/ol-silica.lisp	ensure
 widget has a window tk-silica/xm-frames.lisp	command table menu :divider
 stuff. utils/packages.lisp		Export stream-redisplaying-p

---
 clim/command.lisp         |  45 +++++++++++++---
 demo/graphics-editor.lisp |  11 +++-
 specs/extensions.tex      | 105 ++++++++++++++++++++++++++++++++++++++
 utils/packages.lisp       |   3 +-
 4 files changed, 153 insertions(+), 11 deletions(-)
 create mode 100644 specs/extensions.tex

diff --git a/clim/command.lisp b/clim/command.lisp
index 23bb6fdf..3c8bcbc5 100644
--- a/clim/command.lisp
+++ b/clim/command.lisp
@@ -1,6 +1,6 @@
-;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
+s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: command.lisp,v 1.21 93/03/19 09:43:18 cer Exp $
+;; $fiHeader: command.lisp,v 1.22 93/04/23 09:17:17 cer Exp $
 
 (in-package :clim-internals)
 
@@ -1196,17 +1196,46 @@
 	     (setf (get ',command-name 'n-required) ,n-required)
 	     (define-command-1 #',parser-name ',command-name)
 	     ,(when command-table
-		`(progn
-		   (remove-command-from-command-table ',command-name ',command-table
-						      :errorp nil)
-		   (add-command-to-command-table ',command-name ',command-table
+		`(ensure-command-in-command-table ',command-name ',command-table
 						 :name ',command-line-name
 						 :menu ',menu-item
-						 :keystroke ',keystroke
-						 :errorp nil)))
+						 :keystroke ',keystroke))
 	     ,@translators))))))
 
 
+(defun ensure-command-in-command-table (command-name command-table &key name menu keystroke)
+  
+  (when menu
+    (let ((menu-options (and (consp menu) (cdr menu)))
+	  (menu-name (if (consp menu) (car menu) menu)))
+
+      (when (eq (getf menu-options :after :replace) :replace)
+	;; Find who to insert it after or whether we need to put it at
+	;; the beginning
+	(with-slots ((menu-vector menu)) (find-command-table command-table)
+	  (let ((position (position (if (eq menu-name t)
+					(or name (command-name-from-symbol command-name))
+				      menu-name)
+				    menu-vector :test #'menu-name-equal :key #'first)))
+	    (cond ((null position)
+		   (setf (getf menu-options :after) :end
+			 menu (cons menu-name menu-options)))
+		  ((zerop position)
+		   (setf (getf menu-options :after) :start
+			 menu (cons menu-name menu-options)))
+		  (t
+		   (setf (getf menu-options :after) (first (aref menu-vector (1- position)))
+			 menu (cons menu-name menu-options)))))))))
+    
+  (remove-command-from-command-table command-name command-table
+				     :errorp nil)
+    
+  (add-command-to-command-table command-name command-table
+				:name name
+				:menu menu
+				:keystroke keystroke
+				:errorp nil))
+
 (defun remove-command (name)
   (maphash #'(lambda (key comtab)
 	       (declare (ignore key))
diff --git a/demo/graphics-editor.lisp b/demo/graphics-editor.lisp
index 263c6f4f..065b6404 100644
--- a/demo/graphics-editor.lisp
+++ b/demo/graphics-editor.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-GRAPHICS-EDITOR; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: graphics-editor.lisp,v 1.16 92/11/19 14:24:11 cer Exp $
+;; $fiHeader: graphics-editor.lisp,v 1.17 93/04/23 09:17:53 cer Exp $
 
 (in-package :clim-graphics-editor)
 
@@ -239,7 +239,14 @@
 ;;; The application itself
 
 (define-command-table graphics-editor-file-commands)
-(define-command-table graphics-editor-edit-commands)
+
+(define-command-table graphics-editor-edit-commands
+    :menu (("Deselect" :command (com-deselect-object))
+	   ("divide1" :divider nil)
+	   ("Clear" :command (com-clear))
+	   ("divide2" :divider nil)
+	   ("Redisplay" :command (com-redisplay))))
+
 (define-command-table graphics-editor-option-commands)
 
 (define-application-frame graphics-editor (selected-object-mixin) 
diff --git a/specs/extensions.tex b/specs/extensions.tex
new file mode 100644
index 00000000..94e17ac4
--- /dev/null
+++ b/specs/extensions.tex
@@ -0,0 +1,105 @@
+% -*- Mode: LaTeX; Package: CLIM-USER -*-
+
+\chapter {Suggested Extensions to CLIM}
+\label {extensions}
+
+This appendix describes some suggested extensions to CLIM.  Conforming CLIM
+implementations need not implement any of these extensions.  However, if a CLIM
+implementation chooses to implement any of this functionality, it is suggested
+that is conform to the suggested API.
+
+All of the symbols documented in this appendix should be accessible as external
+symbols in the \cl{clim} package.
+
+
+\section {Support for PostScript Output}
+
+CLIM implementations may choose to implement a PostScript back-end.  Such a
+back-end must include a medium that supports CLIM's medium protocol, and should
+support CLIM's output stream protocol as well.
+
+\Defmacro {with-output-to-postscript-stream} {(stream-var file-stream
+                                               \key device-type multi-page scale-to-fit 
+                                                    orientation header-comments) 
+                                               \body body} 
+
+Within \arg{body}, \arg{stream-var} is bound to a stream that produces
+PostScript code.  This stream is suitable as a stream or medium argument to any
+CLIM output utility, such as \cl{draw-line*} or \cl{write-string}.  A PostScript
+program describing the output to the \arg{stream-var} stream will be written to
+\arg{file-stream}.  \arg{stream-var} must be a symbol.  \arg{file-stream} is a
+stream.
+
+\arg{device-type} is a symbol that names some sort of PostScript display device.
+Its default value is unspecified, but must be a useful display device type for
+the CLIM implementation.
+
+\arg{multi-page} is a \term{boolean} that specifies whether or not the output
+should be broken into multiple pages if it is larger than one page.  How the
+output is broken into multiple pages, and how these multiple pages should be
+pieced together is unspecified.  The default is \cl{nil}.
+
+\arg{scale-to-fit} is a \term{boolean} that specifies whether or not the output
+should be scaled to fit on a single page if it is larger than one page.  The
+default is \cl{nil}.  It is an error if \arg{multi-page} and \cl{scale-to-fit}
+are both supplied as \term{true}.
+
+\arg{orientation} may be one of \cl{:portrait} (the default) or \cl{:landscape}.
+It specifies how the output should be oriented.
+
+\arg{header-comments} allows the programmer to specify some PostScript header
+comment fields for the resulting PostScript output.  The value of
+\arg{header-comments} is a list consisting of alternating keyword and value
+pairs.  These are the supported keywords:
+
+\begin{itemize}
+\item \cl{:title}---specifies a title for the document, as it will appear in the
+"%%Title:"  header comment.
+
+\item \cl{:for}---specifies who the document is for.  The associated value will
+appear in a "%%For:" document comment.
+\end{itemize}
+
+
+\Defun {new-page} {stream}
+
+Give a PostScript stream \arg{stream}, \cl{new-page} sends all of the currently
+collected output to the related file stream (by emitting a PostScript
+\cl{showpage} command), and resets the PostScript stream to have no output.
+
+
+\section {Support for Reading Bitmap Files}
+
+CLIM implementations may supply some functions that read standard bitmap and
+pixmaps files.  The following is the suggested API for such functionality.
+
+\Defgeneric {read-bitmap-file} {type pathname \key}
+
+Reads a bitmap file of type \arg{type} from the file named by \arg{pathname}.
+\arg{type} is a symbol that indicates what type of bitmap file is to be read.  
+\cl{read-bitmap-file} can \cl{eql}-specialize on \arg{type}.
+
+\cl{read-bitmap-file} may take keyword arguments to provide further information
+to the method decoding the bitmap file.
+
+For example, a CLIM implementation might support an \cl{:x11} type.
+\cl{read-bitmap-file} could take a \arg{format} keyword argument, whose value
+can be either \cl{:bitmap} or \cl{:pixmap}.
+
+\cl{read-bitmap-file} will return two values.  The first is a 2-dimensional
+array of ``pixel'' values.  The second is a sequence of CLIM colors (or \cl{nil}
+if the result is a monochrome image).
+
+
+\Defun {make-pattern-from-bitmap-file} {pathname \key type designs \allow}
+
+Reads the contents of the bitmap file \arg{pathname} and creates a CLIM
+\cl{pattern} object that represents the file.  \arg{type} is as for
+\cl{read-bitmap-file}.
+
+\arg{designs} is a sequence of CLIM designs (typically color objects) that will
+be used as the second argument in a call to \cl{make-pattern}.  \arg{designs}
+must be supplied if no second value will be returned from \cl{read-bitmap-file}.
+
+\cl{make-pattern-from-bitmap-file} will pass any additional keyword arguments
+along to \cl{read-bitmap-file}.
diff --git a/utils/packages.lisp b/utils/packages.lisp
index fd9062be..2cf1764f 100644
--- a/utils/packages.lisp
+++ b/utils/packages.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: packages.lisp,v 1.51 93/03/25 15:41:59 colin Exp $
+;; $fiHeader: packages.lisp,v 1.52 93/04/02 18:41:13 cer Exp $
 
 (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user)
 
@@ -2276,6 +2276,7 @@
     redisplay-output-record
     redisplayable-stream-p
     standard-updating-output-record
+    stream-redisplaying-p
     updating-output
     updating-output-record
     updating-output-record-p
-- 
GitLab