[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
DNA Hardcopy service
Here is the DNA Hardcopy protocol that I wrote. This version had been
made more site independent by Koenraad De Smedt, who suggested I should
post it.
You need to install the vax side of the COMMAND service as it appears in
Tech. Bulletin Genera 7.2 Issue 1 section 4.1. A printer must be
defined in the namespace and attached the the vax in question.
There are two site-dependent points, as flagged by the text
"site-dependent". The first defines a global for the default vax host.
The second part specializes a flavor for hardcopy. Koenraad's version
is vaxprint-hardcopy-stream which is probably what most people would want:
it uses the standard vax PRINT command, assumes that the printer name is
the same as the name of the print queue. To use this you add this
service to the vax
Service HARDCOPY DNA VAXPRINT
If you want something different, you should (hopefully) only have to
change the definition & method for the flavor vaxprint-hardcopy-stream
to something more appropriate, perhaps renaming it too.
With acknowledgements to Symbolics, Chris Lindblad & Koenraad De Smedt;
Enjoy
Bruce
miller@cam.nist.gov
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: (DNU) -*-
;;;;***************************************************************************
;;; Software developed at NIST - Center for Computing and Applied Mathematics
;;; a part of the U.S. Government; It is therefore not subject to copyright.
;;;
;;; Created by Bruce R. Miller on 10/16/89 13:36:43 at ARTEMIS (a Symbolics
;;; XL400), using Symbolics Common Lisp (System 418.177, Ivory revision 2)
;;; miller@cam.nist.gov
;;;;***************************************************************************
;;; Also contains code adapted from Symbolics & Chris Lindblad (MIT)
;;; Modified by Koenraad De Smedt (NICI) on 20 october 1989
;;;;***************************************************************************
;;;; Utilities & Enhancements using DNA to VAX
;;; Some of these might be duplicated or done better using TCP/IP & NFS.
;;;;***************************************************************************
(PROVIDE "DNA-UTILITIES")
(IN-PACKAGE 'DNU :USE '(SCL))
(export '(DCL-COMMAND))
(defvar *default-dcl-command-host*
(net:parse-host "kunpv1") ;site-dependent!
"The default VMS host for execution of DCL commands.")
(DEFVAR NOTIFY?
T
"Notify the user after completion of print command?")
;;;;***************************************************************************
;;;; User side of service COMMAND on medium DNA protocol DNA-COMMAND-EXECUTE
;;; This allows the symbolics to have a DCL command executed on a Vax.
;;; Sort of a primitive rshell?
;;;;***************************************************************************
;;; This defines how the service is invoked. This is derived from the new
;;; version ala Tech. Bulletin Genera 7.2 Issue 1 section 4.1.
;;; You need the VAX side installed too: SYS$SYSTEM:DCL-COMMAND.COM
;;; Add the namespace entry for the Vax:
;;; Service: COMMAND DNA DNA-COMMAND-EXECUTE
;;;
;;; The following is a modified version of the user (lispm) side.
;;; NOTE: Additional options to INVOKE:
;;; :OUTPUT-DESTINATION provides a stream to which the response is sent.
;;; (the response is echoed to this stream line-by-line which is nice for
;;; something slow like LaTeX)
;;; If not given, the response is collected into a string which is returned.
;;; :NO-LINEFEEDS
;;; A Kludge; We normally assume that each response buffer constitutes
;;; a `Line' and so print them out using :LINE-OUT. Some programs, notably
;;; LaTeX, return buffers which don't constitute whole lines (I don't know why),
;;; they add the returns themselves; so this should be T.
;;; NOTE: It would be nice to handle MULTIPLE commands, ie. multiple lines
;;; which would be executed in one COMMAND invokation.
;;; However, this requires modification to the Vax's .COM proc
(neti:define-protocol :dna-command-execute (:command :byte-stream)
(:desirability .95)
(:invoke-with-stream-and-close ((stream :characters T :ascii-translation t)
command
&key output-destination no-linefeeds)
(flet ((send-command (cmd)
(send stream :string-out cmd)
(send stream :force-output))
(get-response (destination)
(loop do
(multiple-value-bind (line start end)
(send stream :read-input-buffer)
(send stream :advance-input-buffer)
(setq line (substring line start end))
(when (string-equal line "### Command server finished ###")
(return))
(if no-linefeeds ;expect CR's in response
(send destination :string-out line)
(send destination :line-out line))))))
(send-command command)
(prog1 (if output-destination
;; echo the running response to that stream
(get-response output-destination)
;; Otherwise, collect response into a string which we return
(with-output-to-string (response)
(get-response response)))
(send-command "Ok, you can exit now")))))
;;; This `enables' the protocol
(dna:add-dna-contact-id-for-protocol :dna-command-execute "COMMAND")
;;; This disables it, if you ever need to...
; (dna:remove-dna-contact-id-for-protocol :dna-command-execute)
;;; Convenient interface: Just give the command as a string.
(defun DCL-command (command &key (host *default-dcl-command-host*)
(output-destination *standard-output*)
no-linefeeds)
(neti:invoke-service-on-host :command (si:parse-host host) command
:output-destination output-destination
:no-linefeeds no-linefeeds)
(values))
;;;;***************************************************************************
;;;; Hardcopy protocol for DNA
;;; Inspired by LPD-USER from Chris Lindblad
;;;
;;; When hardcopying something, the protocol is invoked which returns a stream.
;;; Whatever is being printed is turned into postscript (or QUIC?) which is
;;; written to that stream as if it were the printer. In this case, we define
;;; a stream (DNA-hardcopy-stream) which opens an internal stream to a
;;; temporary file on the VAX. Whatever is printed to the hardcopy stream is
;;; simply sent to the internal stream. When our stream is closed, we close
;;; the internal stream (the temporary file).
;;; Then we invoke the PRINT command on the vax (using the COMMAND protocol,
;;; defined above) to print the temporary file, and make sure the file will be
;;; deleted after printing
(defflavor DNA-hardcopy-stream
(request ;Title of request (maybe file name)
temp-pathname ;Temp file on the vax
stream ;Stream to that temp file
sap) ;Service access path
()
(:initable-instance-variables sap)
(:required-init-keywords :sap))
;;; Generate a temporary filename in the user's home directory based on NAME
;;; NAME is provided as the TITLE of a hardcopy job.
;;; It might be a string naming a file (from hardcopy file):
;;; eg. "HOST:>DIR...>NAME.TYPE.VER"
;;; or a string naming a buffer with a filename embedded (from hardcopy buffer)
;;; eg. "NAME.TYPE >dir... HOST: (VER)"
;;; or just a random string from various other hardcopy commands.
;;; We want to make a temporary pathname that suggests what the hardcopy title
;;; is, cause then it appears on the banner page & you know what you got!
;;; On the other hand, we must be careful to get a legitimate file name!
(defvar *pathname-bad-chars*
'(#\# #\* #\? #\> #\: #\. #\@ #\! #\$ #\% #\[ #\] #\\)
"Characters which probably shouldn't be in a pathname")
(defun DNA-hardcopy-temp-filename (name host)
;; First attempt to find a plausible pathname in the name
(let ((path (cond
((ignore-errors (fs:parse-pathname-find-colon name))
;; Usual format
(fs:parse-pathname name))
;; Check if Message #xx from hardcopy mail!
((string-SEARCH "Message #" NAME)
(setq name
(substring name 0 (string-search-char #\sp name
:start 9)))
nil)
;; Then check if it is a pathname like the editor prints it
((let* ((c (string-search-char #\: name :from-end t))
(s (and c (string-search-char #\sp name
:from-end t :end c)))
(h (and s (substring name (1+ s)(1+ c)))))
(and h (ignore-errors (fs:parse-pathname-find-colon h))))
(fs:parse-pathname
(substring name 0 (string-search-char #\sp name)))))))
(when path ;extract name & type
(setq name
(format nil "~a~@[-~a~]" (send path :name) (send path :type))))
;; Whatever name we've got now, clean out unsightly characters
;; & replace spaces by dashes.
(setq name (remove-if #'(lambda (char)
(member char *pathname-bad-chars*))
(substitute #\- #\sp (string-trim '(#\sp) name))))
;; Trim result to reasonable length.
(setq name (substring name 0 (min (string-length name) 30)))
;; Now, make sure that the file in user's homedirectory NAME.TYPE
;; is a NEW file, else hack it a bit.
(let ((default (send (fs:user-homedir host)
:new-pathname :type "PS" :version nil)))
(flet ((test (suffix)
(let ((temp (send default
:new-name (format nil "~a~a" name suffix))))
(unless (ignore-errors (fs:probef temp))
;; If the file exist, return the pathname
temp))))
(or (test "") ;Try with no suffix first,
(loop for i from 1 ;Then try suffixes 1,2,...
thereis (test i)))))))
(defmethod (make-instance DNA-hardcopy-stream) (&rest init-options)
(declare (ignore init-options))
;; Open a stream to a temporary file on the vax;
;; we will `print' to this internal stream.
;; Title is the title of the print-job; for hardcopy file, it is the filename
(setq request (getf (second (neti:service-access-path-args sap))
:title)
temp-pathname (DNA-hardcopy-temp-filename
request (neti:service-access-path-host sap))
stream (open temp-pathname
:direction :output :characters t)))
;;; Most methods just pass the command on to STREAM (the open temp-file)
;;; These are defined explicitly since they are used often.
(defmethod (:tyo DNA-hardcopy-stream) (char)
(send stream :tyo char))
(defmethod (:string-out DNA-hardcopy-stream) (string &optional (start 0) end)
(send stream :string-out string start end))
(defmethod (:fresh-line DNA-hardcopy-stream) ()
(send stream :fresh-line))
;;; Any others that we dont know about, pass them on too.
(defmethod (:unclaimed-message DNA-hardcopy-stream) (message &rest args)
(apply stream message args))
;;; When done, have the temporary file printed & then delete it.
;;; Required method : SUBMIT-HARDCOPY-JOB
(defmethod (:close DNA-hardcopy-stream) (abort)
(send stream :close abort) ;Close the stream to the temp file
(unless abort ;and, unless aborting,
(submit-hardcopy-job self))) ;generate the print request
(compile-flavor-methods DNA-hardcopy-stream)
;;;;***************************************************************************
;;;; Postscript patch.
;;; As good a place as any...
;;; Redefine the following method so that it doesn't claim to be
;;; Adobe 1.0 or 0.67 compatible when it really isn't. This keeps the pages
;;; from getting illegitimately reordered.
(record-source-file-name '(flavor:method
:send-header-comments
lgp::postscript-output-stream)
'defun t)
lgp::
(defmethod (:send-header-comments postscript-output-stream) (&rest ignore)
(flet ((conforming-string (string)
(let ((return-idx (string-search #\Return string)))
(if return-idx
(substring string 0 return-idx)
string))))
(format output-stream "%!") ; *** REPLACEMENT LINE ***
; (format output-stream (if (or page-type tray-type)
; "%!PS-Adobe-1.0"
; "%!PS-Adobe-0.67"))
(send self :send-document-fonts-comment)
(format output-stream
"~&%%Title: ~A~@
%%CreationDate: ~A"
(conforming-string (send self :title))
(conforming-string (time:print-universal-time
(time:get-universal-time) nil)))
(send self :send-pages-comment)
(format output-stream
"~&%%EndComments~%")
(when page-type
(format output-stream "userdict //~(~A~) known {~(~A~)} if~%"
page-type page-type))
(when tray-type
(if (symbolp tray-type)
(format output-stream
"statusdict //~(~A~)tray known {statusdict begin ~(~A~)tray end} if~%"
tray-type tray-type)
(format output-stream
"statusdict //setpapertray known {statusdict begin ~A setpapertray end} if~%"
tray-type)))))
;;;;***************************************************************************
;;;; Vaxprint
;;; Define a more specific stream for `Vaxprint': i.e. to get the vax to print
;;; and define the protocol.
;;; :INVOKE just returns a stream to be written to and closed
;;; (the system just treats it like a printer).
;;; The printer (as defined in the namespace) should be given a name
;;; recognized by the PRINT command. For postscript printers we define
;;; the printer as an LGP2 and have it mounted on KUNPV1.
;;; The VAX has the following service triple added:
;;; Service HARDCOPY DNA VAXPRINT
(defflavor vaxprint-hardcopy-stream
()
(DNA-hardcopy-stream))
(defmethod (submit-hardcopy-job vaxprint-hardcopy-stream) ()
(let* ((printer (send
(send (first (neti:service-access-path-args sap)) :name)
:string))
(host (neti:service-access-path-host sap))
;; Now build and send the command and wait for the reply string
(reply (neti:invoke-service-on-host
:command host
;; The following command on the VAX may be site-dependent
;; make sure the file is deleted afterward
(format nil "PRINT/DELETE/QUEUE=~a/FORM=POST ~a"
printer (send temp-pathname :string-for-host)))))
;; But did it really work ?
;; user can read the response and figure it out himself.
(WHEN NOTIFY?
(tv:notify nil "~A" reply))))
(net:define-protocol :vaxprint (:hardcopy :dna)
(:desirability 0.3)
(:invoke (service-access-path)
(make-instance 'vaxprint-hardcopy-stream :sap service-access-path)))
;;;;***************************************************************************
;;; EOF