Repatch (from linux) of OSX IRAF

9 files changed, 1363 insertions, 0 deletions

diff --git a/vendor/x11iraf/ximtool/clients/lib/README b/vendor/x11iraf/ximtool/clients/lib/README
new file mode 100644
index 00000000..f91f44ce
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/lib/README
@@ -0,0 +1,11 @@
+#
+#  ISM LIBRARY UTILITIES -- This directory contains various utility
+#  procedures which may be used by one or more ISM client tasks.
+o
+
+    dsppmmap.x -- Opens a pixel mask associated with an image BPM keyword
+      idxstr.x -- Inverse strdic() function
+         ism.x -- Low-level ISM communications routines
+    wcsgterm.x -- Compute the output FITS CRPIX, CRVAL, and CD arrays from
+		  the # MWCS LTERM and WTERM
+
diff --git a/vendor/x11iraf/ximtool/clients/lib/dspmmap.x b/vendor/x11iraf/ximtool/clients/lib/dspmmap.x
new file mode 100644
index 00000000..621f0372
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/lib/dspmmap.x
@@ -0,0 +1,244 @@
+include	<mach.h>
+include	<ctype.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<pmset.h>
+include	<syserr.h>
+
+
+# DS_PMMAP -- Open a pixel mask READ_ONLY.
+#
+# Open the pixel mask.  If a regular image is specified convert it to
+# a pixel mask.  Match the mask to the reference image based on the
+# physical coordinates.  A null filename is allowed and returns NULL.
+
+pointer procedure ds_pmmap (pmname, refim)
+
+char	pmname[ARB]		#I Pixel mask name
+pointer	refim			#I Reference image pointer
+
+pointer	im
+char	fname[SZ_FNAME]
+int	nowhite(), errcode()
+bool	streq()
+pointer	im_pmmap(), ds_pmimmap()
+errchk	ds_pmimmap, ds_match
+
+begin
+	if (nowhite (pmname, fname, SZ_FNAME) == 0)
+	    return (NULL)
+	if (streq (fname, "EMPTY"))
+	    return (NULL)
+	if (fname[1] == '!') {
+	    iferr (call imgstr (refim, fname[2], fname, SZ_FNAME))
+		fname[1] = EOS
+	} else if (streq (fname, "BPM")) {
+	    iferr (call imgstr (refim, "BPM", fname, SZ_FNAME))
+		return (NULL)
+	}
+
+	iferr (im = im_pmmap (fname, READ_ONLY, NULL)) {
+	    switch (errcode()) {
+	    case SYS_FOPNNEXFIL, SYS_PLBADSAVEF:
+		im = ds_pmimmap (fname, refim)
+	    default:
+		call erract (EA_ERROR)
+	    }
+	}
+
+	iferr (call ds_match (im, refim))
+	    call erract (EA_WARN)
+
+	return (im)
+end
+
+
+# DS_PMIMMAP -- Open a pixel mask from a non-pixel list image.
+# Return error if the image cannot be opened.
+
+pointer procedure ds_pmimmap (pmname, refim)
+
+char	pmname[ARB]		#I Image name
+pointer	refim			#I Reference image pointer
+
+int	i, ndim, npix, val
+pointer	sp, v1, v2, im_in, im_out, pm, mw, data
+
+int	imgnli()
+pointer immap(), pm_newmask(), im_pmmapo(), imgl1i(), mw_openim()
+errchk	immap, mw_openim
+
+begin
+	call smark (sp)
+	call salloc (v1, IM_MAXDIM, TY_LONG)
+	call salloc (v2, IM_MAXDIM, TY_LONG)
+
+	call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	call amovkl (long(1), Meml[v2], IM_MAXDIM)
+
+	im_in = immap (pmname, READ_ONLY, 0)
+	pm = pm_newmask (im_in, 27)
+
+	ndim = IM_NDIM(im_in)
+	npix = IM_LEN(im_in,1)
+
+	while (imgnli (im_in, data, Meml[v1]) != EOF) {
+	    do i = 0, npix-1 {
+		val = Memi[data+i]
+		if (val < 0)
+		   Memi[data+i] = 0
+	    }
+	    call pmplpi (pm, Meml[v2], Memi[data], 0, npix, PIX_SRC)
+	    call amovl (Meml[v1], Meml[v2], ndim)
+	}
+
+	im_out = im_pmmapo (pm, im_in)
+	data = imgl1i (im_out)		# Force I/O to set header
+	mw = mw_openim (im_in)		# Set WCS
+	call mw_saveim (mw, im_out)
+	call mw_close (mw)
+
+	call imunmap (im_in)
+	call sfree (sp)
+	return (im_out)
+end
+
+
+# DS_MATCH -- Set the pixel mask to match the reference image.
+# This matches sizes and physical coordinates and allows the
+# original mask to be smaller or larger than the reference image.
+# Subsequent use of the pixel mask can then work in the logical
+# coordinates of the reference image.  The mask values are the maximum
+# of the mask values which overlap each reference image pixel.
+# A null input returns a null output.
+
+procedure ds_match (im, refim)
+
+pointer	im			#U Pixel mask image pointer
+pointer	refim			#I Reference image pointer
+
+int	i, j, k, l, i1, i2, j1, j2, nc, nl, ncpm, nlpm, nx, val
+double	x1, x2, y1, y2, lt[6], lt1[6], lt2[6]
+long	vold[IM_MAXDIM], vnew[IM_MAXDIM]
+pointer	pm, pmnew, imnew, mw, ctx, cty, bufref, bufpm
+
+int	imstati()
+pointer	pm_open(), mw_openim(), im_pmmapo(), imgl1i(), mw_sctran()
+bool	pm_empty(), pm_linenotempty()
+errchk	pm_open, mw_openim
+
+begin
+	if (im == NULL)
+	    return
+
+	# Set sizes.
+	nc = IM_LEN(refim,1)
+	nl = IM_LEN(refim,2)
+	ncpm = IM_LEN(im,1)
+	nlpm = IM_LEN(im,2)
+
+	# If the mask is empty and the sizes are the same then it does not
+	# matter if the two are actually matched in physical coordinates.
+	pm = imstati (im, IM_PMDES)
+	if (pm_empty(pm) && nc == ncpm && nl == nlpm)
+	    return
+
+	# Compute transformation between reference (logical) coordinates
+	# and mask (physical) coordinates.
+
+	mw = mw_openim (im)
+	call mw_gltermd (mw, lt, lt[5], 2)
+	call mw_close (mw)
+
+	mw = mw_openim (refim)
+	call mw_gltermd (mw, lt2, lt2[5], 2)
+	call mw_close (mw)
+
+	# Combine lterms.
+	call mw_invertd (lt, lt1, 2)
+	call mw_mmuld (lt1, lt2, lt, 2)
+	call mw_vmuld (lt, lt[5], lt[5], 2)
+	lt[5] = lt2[5] - lt[5]
+	lt[6] = lt2[6] - lt[6]
+	do i = 1, 6
+	    lt[i] = nint (1D6 * (lt[i]-int(lt[i]))) / 1D6 + int(lt[i])
+
+	# Check for a rotation.  For now don't allow any rotation.
+	if (lt[2] != 0. || lt[3] != 0.)
+	    call error (1, "Image and mask have a relative rotation")
+	
+	# Check for an exact match.
+	if (lt[1] == 1D0 && lt[4] == 1D0 && lt[5] == 0D0 && lt[6] == 0D0)
+	    return
+
+	# Set reference to mask coordinates.
+	mw = mw_openim (im)
+	call mw_sltermd (mw, lt, lt[5], 2)
+	ctx = mw_sctran (mw, "logical", "physical", 1)
+	cty = mw_sctran (mw, "logical", "physical", 2)
+
+	# Create a new pixel mask of the required size and offset.
+	# Do dummy image I/O to set the header.
+	pmnew = pm_open (NULL)
+	call pm_ssize (pmnew, 2, IM_LEN(refim,1), 27)
+	imnew = im_pmmapo (pmnew, NULL)
+	bufref = imgl1i (imnew)
+
+	# Compute region of mask overlapping the reference image.
+	call mw_ctrand (ctx, 1-0.5D0, x1, 1)
+	call mw_ctrand (ctx, nc+0.5D0, x2, 1)
+	i1 = max (1, nint(min(x1,x2)+1D-5))
+	i2 = min (ncpm, nint(max(x1,x2)-1D-5))
+	call mw_ctrand (cty, 1-0.5D0, y1, 1)
+	call mw_ctrand (cty, nl+0.5D0, y2, 1)
+	j1 = max (1, nint(min(y1,y2)+1D-5))
+	j2 = min (nlpm, nint(max(y1,y2)-1D-5))
+
+	# Set the new mask values to the maximum of all mask values falling
+	# within each reference pixel in the overlap region.
+	if (i1 <= i2 && j1 <= j2) {
+	    nx = i2 - i1 + 1
+	    call malloc (bufpm, nx, TY_INT)
+	    call malloc (bufref, nc, TY_INT)
+	    vold[1] = i1
+	    vnew[1] = 1
+	    do j = 1, nl {
+		call mw_ctrand (cty, j-0.5D0, y1, 1)
+		call mw_ctrand (cty, j+0.5D0, y2, 1)
+		j1 = max (1, nint(min(y1,y2)+1D-5))
+		j2 = min (nlpm, nint(max(y1,y2)-1D-5))
+		if (j2 < j1)
+		    next
+
+		vnew[2] = j
+		call aclri (Memi[bufref], nc)
+		do l = j1, j2 {
+		    vold[2] = l
+		    if (!pm_linenotempty (pm, vold))
+			next
+		    call pmglpi (pm, vold, Memi[bufpm], 0, nx, 0)
+		    do i = 1, nc {
+			call mw_ctrand (ctx, i-0.5D0, x1, 1)
+			call mw_ctrand (ctx, i+0.5D0, x2, 1)
+			i1 = max (1, nint(min(x1,x2)+1D-5))
+			i2 = min (ncpm, nint(max(x1,x2)-1D-5))
+			if (i2 < i1)
+			    next
+			val = Memi[bufref+i-1]
+			do k = i1-vold[1], i2-vold[1]
+			    val = max (val, Memi[bufpm+k])
+			Memi[bufref+i-1] = val
+		    }
+		}
+		call pmplpi (pmnew, vnew, Memi[bufref], 0, nc, PIX_SRC)
+	    }
+	    call mfree (bufref, TY_INT)
+	    call mfree (bufpm, TY_INT)
+	}
+
+	call mw_close (mw)
+	call imunmap (im)
+	im = imnew
+	call imseti (im, IM_PMDES, pmnew)
+end
diff --git a/vendor/x11iraf/ximtool/clients/lib/idxstr.x b/vendor/x11iraf/ximtool/clients/lib/idxstr.x
new file mode 100644
index 00000000..7b055658
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/lib/idxstr.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+
+# IDXSTR -- Search a dictionary string for a given string index number.
+# This is the opposite function of strdic(), that returns the index for
+# given string.  The entries in the dictionary string are separated by
+# a delimiter character which is the first character of the dictionary
+# string.  The index of the string found is returned as the function value.
+# Otherwise, if there is no string for that index, a zero is returned.
+
+int procedure idxstr (index, outstr, maxch, dict)
+
+int	index				#i String index
+char	outstr[ARB]			#o Output string as found in dictionary
+int	maxch				#i Maximum length of output string
+char	dict[ARB]			#i Dictionary string
+
+int	i, len, start, count
+
+int	strlen()
+
+begin
+	# Clear the output string.
+	outstr[1] = EOS
+
+	# Return if the dictionary is not long enough.
+	if (dict[1] == EOS)
+	    return (0)
+
+	# Initialize the counters.
+	count = 1
+	len   = strlen (dict)
+
+	# Search the dictionary string. This loop only terminates
+	# successfully if the index is found. Otherwise the procedure
+	# returns with and error condition.
+	for (start = 2; count < index; start = start + 1) {
+	    if (dict[start] == dict[1])
+		count = count + 1
+	    if (start == len)
+		return (0)
+	}
+
+	# Extract the output string from the dictionary.
+	for (i = start; dict[i] != EOS && dict[i] != dict[1]; i = i + 1) {
+	    if (i - start + 1 > maxch)
+		break
+	    outstr[i - start + 1] = dict[i]
+	}
+	outstr[i - start + 1] = EOS
+
+	# Return index for output string.
+	return (count)
+end
diff --git a/vendor/x11iraf/ximtool/clients/lib/ism.x b/vendor/x11iraf/ximtool/clients/lib/ism.x
new file mode 100644
index 00000000..1d7310cc
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/lib/ism.x
@@ -0,0 +1,432 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <config.h>
+include <mach.h>
+include <xwhen.h>
+
+
+# ISM.X -- Interface routines for client programs to connect to the
+# XImtool ISM port on the local socket
+#
+#	  status = ism_connect  (device, name, mode)
+#		ism_disconnect  (send_quit)
+#	           ism_message  (object, message)
+#	             ism_alert  (text, ok_action, cancel_action)
+#
+#	             ism_write  (message, len)
+#	     nread =  ism_read  (message, len)
+#
+# Client programs should install an exception handler to first disconnect
+# from the device before shutting down.  The procedure ism_zxwhen() is
+# provided for this purpose.
+
+
+define	ISM_DBG		FALSE
+
+define	SZ_MESSAGE	2047
+
+define	ISM_TEXT	1
+define	ISM_BINARY	2
+
+
+# ISM_CONNECT -- Negotiate a connection on the named device.  Once
+# established we can begin sending and reading messages from the server.
+
+int procedure ism_connect (device, name, type)
+
+char	device[ARB]				#I socket to connect on
+char	name[ARB]				#I module name
+char	type[ARB]				#I requested connection mode
+
+pointer	sp, cmsg, dev, buf
+int	msglen
+char	connect[SZ_FNAME]
+
+int	ndopen(), reopen(), strlen()
+int	ism_read()
+bool 	streq()
+
+extern	ism_onerror()
+
+include	"ismfd.com"				# I/O common
+include "ismcom.com" 				# Interrupt handler variables
+
+# Exception handler variables common.
+int     ism_errstat
+data  	ism_errstat /OK/
+common  /ismecom/ ism_errstat
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+	call salloc (cmsg, SZ_LINE, TY_CHAR)
+	call salloc (dev, SZ_FNAME, TY_CHAR)
+
+	# Initialize.
+	call aclrc (Memc[buf], SZ_LINE)
+	call aclrc (Memc[cmsg], SZ_LINE)
+	call aclrc (Memc[dev], SZ_FNAME)
+	call aclrc (buffer, 2*SZ_MESSAGE+1)
+	fdin  = NULL
+	fdout = NULL
+	nbuf  = 0
+	bp  = 0
+	ep  = 0
+
+	# Generate the device name.  We assume the call was made with either
+	# a "unix:" or "inet:" prefix, so just append the type and set the
+	# mode.
+
+	call sprintf (Memc[dev], SZ_FNAME, "%s:%s")
+	    call pargstr (device)
+	    call pargstr (type)
+	if (streq (type, "text"))
+	    mode = ISM_TEXT
+	else
+	    mode = ISM_BINARY
+
+	# Open the initial connection
+        iferr (fdin  = ndopen (Memc[dev], READ_WRITE)) {
+	    call sfree (sp)
+            return (ERR)
+	}
+	fdout = reopen (fdin, READ_WRITE)
+
+	# Send the connect request.
+	call sprintf (Memc[cmsg], SZ_LINE, "connect %s\0")
+	    call pargstr (name)
+	msglen = strlen (Memc[cmsg])
+	call ism_message ("ximtool", Memc[cmsg])
+
+	# Read the acknowledgement.
+	if (ism_read (Memc[buf], msglen) == EOF) {
+	    call sfree (sp)
+	    return (ERR)
+	}
+
+	# Close the original socket.
+	call close (fdout)
+	call close (fdin)
+
+	# Get the new device name.
+	call sprintf (connect, SZ_LINE, "unix:%s:%s\0")
+	    call pargstr (Memc[buf+8])
+	    call pargstr (type)
+
+	# Open the new channel.
+        iferr (fdin = ndopen (connect, READ_WRITE)) {
+	    call sfree (sp)
+            return (ERR)
+	}
+	fdout = reopen (fdin, READ_WRITE)
+
+	if (ISM_DBG) {
+	    call eprintf ("Reconnected on '%s'\n"); call pargstr (connect)
+	}
+
+	# Tell the server we're ready to begin.
+	call sprintf (Memc[cmsg], SZ_LINE, "ready %s\0")
+	    call pargstr (name)
+	msglen = strlen (Memc[cmsg])
+	call ism_message ("ximtool", Memc[cmsg])
+
+
+        # Post the ism_onerror procedure to be executed upon process shutdown
+        # to issue a warning to the server in case we don't close normally.
+
+        call onerror (ism_onerror)
+
+	call sfree (sp)
+	return (OK)
+end
+
+
+# ISM_DISCONNECT -- Disconnect from the currect channel.
+
+procedure ism_disconnect (send_quit)
+
+int	send_quit
+
+include	"ismfd.com"				# I/O common
+
+begin
+	# Send a QUIT message to the server so we shut down the connection.
+	if (send_quit == YES)
+	    call ism_message ("ximtool", "quit")
+
+	call close (fdin) 		# Close the socket connection.
+	call close (fdout)
+	fdin = NULL
+	fdout = NULL
+end
+
+
+# ISM_MESSAGE -- Send a message to an XImtool named object.  If the object
+# is 'ximtool' then just pass the message directly without formatting it.
+
+procedure ism_message (object, message)
+
+char	object[ARB]				#I object name
+char	message[ARB]				#I message to send
+
+pointer	sp, msgbuf
+int	msglen, olen, mlen, ip 
+
+int	strlen()
+bool	streq()
+
+begin
+	# Get the message length plus some extra for the braces and padding.
+	olen = strlen (object)
+	mlen = strlen (message)
+	msglen = olen + mlen + 20
+
+	# Allocate and clear the message buffer.
+	call smark (sp)
+	call salloc (msgbuf, msglen, TY_CHAR)
+	call aclrc (Memc[msgbuf], msglen)
+
+	if (streq (object, "ximtool")) {
+	    # Just send the message.
+	    call strcpy (message, Memc[msgbuf], msglen)
+	} else {
+	    # Format the message.  We can't use a sprintf here since the
+	    # message may be bigger than that allowed by a pargstr().
+	    ip = 0
+	    call amovc ("send ", Memc[msgbuf+ip], 5)   	; ip = ip + 5
+	    call amovc (object,  Memc[msgbuf+ip], olen)	; ip = ip + olen
+	    call amovc (" { ",   Memc[msgbuf+ip], 3)   	; ip = ip + 3
+	    call amovc (message, Memc[msgbuf+ip], mlen)	; ip = ip + mlen
+	    call amovc (" }\0",  Memc[msgbuf+ip], 2)   	; ip = ip + 3
+	}
+	msglen = strlen (Memc[msgbuf])
+
+	# Now send the message.  The write routine does the strpak().
+	call ism_write (Memc[msgbuf], msglen)
+
+	call sfree (sp)
+end
+
+
+# ISM_ALERT -- Send an alert message to XImtool.
+
+procedure ism_alert (text, ok, cancel)
+
+char	text[ARB]				#I warning text
+char	ok[ARB]					#i client OK message
+char	cancel[ARB]				#i client CANCEL message
+
+pointer	sp, msg
+
+begin
+	call smark (sp)
+	call salloc (msg, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[msg], SZ_LINE, "{%s} {%s} {%s}")
+	    call pargstr (text)
+	    call pargstr (ok)
+	    call pargstr (cancel)
+
+	call ism_message ("alert", Memc[msg])
+
+	call sfree (sp)
+end
+
+
+# ISM_WRITE -- Low-level write of a message to the socket.  Writes exactly
+# len bytes to the stream.
+
+procedure ism_write (message, len)
+
+char	message[ARB]				#I message to send
+int	len					#I length of message
+
+int	nleft, n, ip
+char	msgbuf[SZ_MESSAGE]
+int	strlen()
+
+include	"ismfd.com"				# I/O common
+
+errchk	write, flush
+
+begin
+	# Pad message with a NULL to terminate it.
+	len = strlen (message) + 1
+	message[len] = '\0'
+
+	if (mod(len,2) == 1) {
+	    len = len + 1
+	    message[len] = '\0'
+	}
+
+	ip = 1
+	nleft = len
+	while (nleft > 0) {
+	    n = min (nleft, SZ_MESSAGE)
+	    call amovc (message[ip], msgbuf, n)
+	    if (mode == ISM_BINARY) {
+	        call achtcb (msgbuf, msgbuf, n)
+                call write (fdout, msgbuf, n / SZB_CHAR)
+	    } else
+                call write (fdout, msgbuf, n)
+
+	    ip = ip + n
+	    nleft = nleft - n
+	}
+        call flush (fdout)
+
+	if (ISM_DBG) {
+	    call eprintf ("ism_write: '%.45s' len=%d mode=%d\n")
+	        call pargstr (message);call pargi (len); call pargi (mode)
+	}
+end
+
+
+# ISM_READ -- Low-level read from the socket.
+
+int procedure ism_read (message, len)
+
+char	message[ARB]				#O message read
+int	len					#O length of message
+
+int	i, n, nleft, read()
+
+include	"ismfd.com"				# I/O common
+include "ismcom.com" 				# Interrupt handler variables
+
+errchk	read
+
+begin
+	# No data left in the buffer so read from the socket
+	if (nbuf == 0) {
+	    call aclrc (buffer, SZ_MESSAGE)
+	    #call amovkc (EOF, buffer, SZ_MESSAGE)
+	    nbuf = 0
+
+            iferr {
+		n = read (fdin, message, SZ_MESSAGE)
+                if (n < 0) 
+	            return (EOF)
+            } then {
+                if (n < 0) 
+	            return (EOF)
+        	call xer_reset()
+        	call zdojmp (ism_jmp, X_IPC)
+            }
+
+	    if (mode == ISM_BINARY) {
+	        len = n * SZB_CHAR
+	        call achtbc (message, message, len)
+	    } else
+	       len = n
+
+	    # Save the data read to a local buffer.  Remove any extra 
+	    # EOS padding and append an EOF on the string.
+	    call amovc (message, buffer, len)
+	    if (buffer[len] == EOS && buffer[len-1] == EOS)
+		nbuf = len
+	    else 
+	        nbuf = len + 1
+	    buffer[nbuf] = EOF
+	}
+
+	for (i=1; buffer[i] != EOS && buffer[i] != EOF && i <= nbuf; i=i+1)
+	    message[i] = buffer[i]
+	message[i] = '\0'
+	len = i				# length of the current message
+	nleft = nbuf - i		# nchars left in the buffer
+
+	if (buffer[i] == EOS && buffer[i+1] == EOF) {
+	    # That was the last message, force a new read next time we're
+	    # called.
+	    if (i > 1 && nleft > 1)
+	        call amovc (buffer[i+1], buffer, nleft)
+	    nbuf = 0
+	} else {
+	    # More of the message is left in the buffer.
+	    if (nleft > 0)
+	        call amovc (buffer[i+1], buffer, nleft)
+	    nbuf = nleft
+	}
+
+	if (ISM_DBG) {
+	    message[len] = '\0';
+	    call eprintf ("ism_read: len=%d msg='%s'\n")
+		call pargi (len); call pargstr(message)
+	    call eprintf ("ism_read: nbuf=%d nleft=%d buffer='%s'\n")
+		call pargi (nbuf); call pargi(nleft); call pargstr(buffer)
+	}
+
+	return (nleft)
+end
+
+
+# ISM_INTRHANDLER -- User-callable interrupt handler so the ISM client code
+# doesn't need to know about our internals.
+
+int procedure ism_intrhandler()
+
+extern	ism_zxwhen()
+
+include "ismcom.com" 				# Interrupt handler variables
+
+begin
+        call zlocpr (ism_zxwhen, ismepa)
+        call xwhen (X_INT, ismepa, old_onint)
+        call zsvjmp (ism_jmp, ismstat)
+
+	if (ismstat == OK)
+	    return (OK)
+	else
+	    return (ERR)
+end
+
+
+# ISM_ZXWHEN -- Interrupt handler for the ISM client task.  Branches back
+# to ZSVJMP in the user routine to permit shutdown without an error message
+# after first disconnecting from the socket.
+
+procedure ism_zxwhen (vex, next_handler)
+
+int     vex             # virtual exception
+int     next_handler    # not used
+
+include "ismcom.com" 				# Interrupt handler variables
+
+begin
+	call ism_disconnect (YES)
+        call xer_reset()
+        call zdojmp (ism_jmp, vex)
+end
+
+
+# ISM_ONERROR -- Error exit handler for the interface.  If this is a normal exit
+# the shut down quietly, otherwise notify the server.
+
+procedure ism_onerror (status)
+
+int	status					#i not used (req. for ONEXIT)
+
+# Exception handler variables common.
+int     ism_errstat
+common  /ismecom/ ism_errstat
+
+int	code
+char	buf[SZ_LINE], errmsg[SZ_LINE]
+
+int	errget()
+
+include "ismcom.com" 				# Interrupt handler variables
+
+begin
+	if (status != OK) {
+	    code = errget (errmsg, SZ_LINE)
+	    call sprintf (buf, SZ_LINE, "ISM Error, code %d:\n`%s\'")
+	        call pargi (status)
+	        call pargstr (errmsg)
+
+	    call ism_alert (buf, "", "")
+	    call ism_disconnect (YES)
+	}
+end
diff --git a/vendor/x11iraf/ximtool/clients/lib/ismcom.com b/vendor/x11iraf/ximtool/clients/lib/ismcom.com
new file mode 100644
index 00000000..fd2c2939
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/lib/ismcom.com
@@ -0,0 +1,4 @@
+# ISM interrupt handler variables common.
+int     ismepa, ismstat, old_onint, ism_fd, ism_jmp[LEN_JUMPBUF]
+common  /ismcom/ ism_fd, ism_jmp, ismepa, ismstat, old_onint
+
diff --git a/vendor/x11iraf/ximtool/clients/lib/ismfd.com b/vendor/x11iraf/ximtool/clients/lib/ismfd.com
new file mode 100644
index 00000000..ebb94d9a
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/lib/ismfd.com
@@ -0,0 +1,11 @@
+# ISM I/O common.
+int	fdin 					# input descriptor
+int	fdout 					# output descriptor
+int	mode 					# file mode
+int	nbuf 					# no. chars in buffer
+int	bp 					# begin buffer ptr
+int	ep					# end buffer ptr
+char	buffer[2*SZ_MESSAGE+1]			# text buffer
+
+common	/ismfd/ fdin, fdout, mode, nbuf, buffer, bp, ep
+
diff --git a/vendor/x11iraf/ximtool/clients/lib/mkpkg b/vendor/x11iraf/ximtool/clients/lib/mkpkg
new file mode 100644
index 00000000..896134d4
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/lib/mkpkg
@@ -0,0 +1,15 @@
+# Make the ISM Client utility procedures.
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+#	dspmmap.x	<ctype.h> <error.h> <imhdr.h> <imset.h> \
+#			<mach.h> <pmset.h>
+	idxstr.x
+	ism.x		ismfd.com ismcom.com <config.h> <mach.h> <xwhen.h>
+	wcsgfterm.x
+	;
+
diff --git a/vendor/x11iraf/ximtool/clients/lib/wcsgfterm.x b/vendor/x11iraf/ximtool/clients/lib/wcsgfterm.x
new file mode 100644
index 00000000..ea026f89
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/lib/wcsgfterm.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+
+# WCS_GFTERM -- Compute the output FITS CRPIX, CRVAL, and CD arrays from the
+# MWCS LTERM and WTERM. Note that the CD matrix terms are still transposed
+# from the usual Fortran order.
+
+procedure wcs_gfterm (mw, crpix, crval, cd, ndim)
+
+pointer mw              			#i the input mwcs pointer
+double  crpix[ndim]     			#o the output FITS CRPIX array
+double  crval[ndim]     			#o the output FITS CRVAL array
+double  cd[ndim,ndim]   			#o the output FITS CD matrix
+int     ndim            			#i the dimensionality of the wcs
+
+pointer sp, r, wcd, ltv, ltm, iltm
+pointer	alert, errmsg
+int	i, errcode
+
+int	errget()
+
+errchk	mw_gwtermd, mw_gltermd
+
+begin
+	call smark (sp)
+	call salloc (r, ndim, TY_DOUBLE)
+	call salloc (wcd, ndim * ndim, TY_DOUBLE)
+	call salloc (ltv, ndim, TY_DOUBLE)
+	call salloc (ltm, ndim * ndim, TY_DOUBLE)
+	call salloc (iltm, ndim * ndim, TY_DOUBLE)
+
+	iferr {
+	    call mw_gwtermd (mw, Memd[r], crval, Memd[wcd], ndim)
+	    call mw_gltermd (mw, Memd[ltm], Memd[ltv], ndim)
+	    call mwvmuld (Memd[ltm], Memd[r], crpix, ndim)
+	    call aaddd (crpix, Memd[ltv], crpix, ndim)
+	    call mwinvertd (Memd[ltm], Memd[iltm], ndim)
+	    call mwmmuld (Memd[wcd], Memd[iltm], cd, ndim)
+
+	} then {
+	    call salloc (alert, SZ_LINE, TY_CHAR)
+	    call salloc (errmsg, SZ_LINE, TY_CHAR)
+
+	    # Set up a default value.
+	    call aclrd (cd, ndim*ndim)
+	    for (i=1; i <= ndim; i=i+1) {
+	        crpix[i] = 1.0d0
+	        crval[i] = 1.0d0
+	        cd[i,i] = 1.0d0
+	    }
+
+            # Send alert to the GUI.
+	    errcode = errget (Memc[errmsg], SZ_LINE)
+	    call sprintf (Memc[alert], SZ_FNAME, "%s\n\"%s\"")
+		call pargstr ("Error decoding image WCS:")
+		call pargstr (Memc[errmsg])
+            call ism_alert (Memc[alert], "", "")
+	}
+
+	call sfree (sp)
+end
diff --git a/vendor/x11iraf/ximtool/clients/lib/ximtool.x b/vendor/x11iraf/ximtool/clients/lib/ximtool.x
new file mode 100644
index 00000000..108b325e
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/lib/ximtool.x
@@ -0,0 +1,531 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <config.h>
+include <mach.h>
+include <xwhen.h>
+
+
+# XIMTOOL.X -- Interface routines for client programs to connect to 
+# XImtool on the message bus.
+#
+#	  status = xim_connect  (device, name, mode)
+#		xim_disconnect  (send_quit)
+#	           xim_message  (object, message)
+#	             xim_alert  (text, ok_action, cancel_action)
+#
+#	             xim_write  (message, len)
+#	     nread =  xim_read  (message, len)
+#
+# Client programs should install an exception handler to first disconnect
+# from the device before shutting down.  The procedure xim_zxwhen() is
+# provided for this purpose.
+
+
+define	XIM_DBG		FALSE
+
+define	SZ_MESSAGE	2047
+
+define	XIM_TEXT	1
+define	XIM_BINARY	2
+
+
+# XIM_CONNECT -- Negotiate a connection on the named device.  Once
+# established we can begin sending and reading messages from the server.
+
+int procedure xim_connect (device, name, type)
+
+char	device[ARB]				#I socket to connect on
+char	name[ARB]				#I module name
+char	type[ARB]				#I requested connection mode
+
+pointer	sp, cmsg, dev, buf
+int	msglen
+char	connect[SZ_FNAME]
+
+int	ndopen(), reopen(), strlen()
+int	xim_read()
+bool 	streq()
+
+extern	xim_onerror()
+
+# I/O common.
+int	fdin, fdout, mode, nbuf, nsave, nr, nw
+char	buffer[SZ_MESSAGE], bufsave[SZ_MESSAGE]
+common	/ximfd/ fdin, fdout, mode, nbuf, buffer, nsave, bufsave, nr, nw
+
+# Interrupt handler variables common.
+int     ximepa, ximstat, old_onint, xim_fd, xim_jmp[LEN_JUMPBUF]
+common  /ximcom/ xim_fd, xim_jmp, ximepa, ximstat, old_onint
+
+# Exception handler variables common.
+int     xim_errstat
+data  	xim_errstat /OK/
+common  /ximecom/ xim_errstat
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+	call salloc (cmsg, SZ_LINE, TY_CHAR)
+	call salloc (dev, SZ_FNAME, TY_CHAR)
+
+	# Initialize.
+	call aclrc (Memc[buf], SZ_LINE)
+	call aclrc (Memc[cmsg], SZ_LINE)
+	call aclrc (Memc[dev], SZ_FNAME)
+	call aclrc (buffer, SZ_MESSAGE)
+	fdin  = NULL
+	fdout = NULL
+	nbuf  = 0
+	nsave = 0
+	nr    = 0
+	nw    = 0
+
+	# Generate the device name.  We assume the call was made with either
+	# a "unix:" or "inet:" prefix, so just append the type and set the
+	# mode.
+
+	call sprintf (Memc[dev], SZ_FNAME, "%s:%s")
+	    call pargstr (device)
+	    call pargstr (type)
+	if (streq (type, "text"))
+	    mode = XIM_TEXT
+	else
+	    mode = XIM_BINARY
+
+	# Open the initial connection
+        iferr (fdin  = ndopen (Memc[dev], READ_WRITE)) {
+	    call sfree (sp)
+            return (ERR)
+	}
+	fdout = reopen (fdin, READ_WRITE)
+
+	# Send the connect request.
+	call sprintf (Memc[cmsg], SZ_LINE, "connect %s\0")
+	    call pargstr (name)
+	msglen = strlen (Memc[cmsg])
+	call xim_message ("ximtool", Memc[cmsg])
+
+	# Read the acknowledgement.
+	if (xim_read (Memc[buf], msglen) == EOF) {
+	    call sfree (sp)
+	    return (ERR)
+	}
+
+	# Close the original socket.
+	call close (fdout)
+	call close (fdin)
+
+	# Get the new device name.
+	call sprintf (connect, SZ_LINE, "unix:%s:%s\0")
+	    call pargstr (Memc[buf+8])
+	    call pargstr (type)
+
+	# Open the new channel.
+        iferr (fdin = ndopen (connect, READ_WRITE)) {
+	    call sfree (sp)
+            return (ERR)
+	}
+	fdout = reopen (fdin, READ_WRITE)
+
+	if (XIM_DBG) {
+	    call eprintf ("Reconnected on '%s'\n"); call pargstr (connect)
+	}
+
+	# Tell the server we're ready to begin.
+	call sprintf (Memc[cmsg], SZ_LINE, "ready %s\0")
+	    call pargstr (name)
+	msglen = strlen (Memc[cmsg])
+	call xim_message ("ximtool", Memc[cmsg])
+
+
+        # Post the xim_onerror procedure to be executed upon process shutdown
+        # to issue a warning to the server in case we don't close normally.
+
+        call onerror (xim_onerror)
+
+	call sfree (sp)
+	return (OK)
+end
+
+
+# XIM_DISCONNECT -- Disconnect from the currect channel.
+
+procedure xim_disconnect (send_quit)
+
+int	send_quit
+
+# I/O common.
+int	fdin, fdout, mode, nbuf, nsave, nr, nw
+char	buffer[SZ_MESSAGE], bufsave[SZ_MESSAGE]
+common	/ximfd/ fdin, fdout, mode, nbuf, buffer, nsave, bufsave, nr, nw
+
+begin
+	# Send a QUIT message to the server so we shut down the connection.
+	if (send_quit == YES)
+	    call xim_message ("ximtool", "quit")
+
+	call flush (fdout) 		# Close the socket connection.
+	call close (fdin)
+	call close (fdout)
+	fdin = NULL
+	fdout = NULL
+end
+
+
+# XIM_MESSAGE -- Send a message to an XImtool named object.  If the object
+# is 'ximtool' then just pass the message directly without formatting it.
+
+procedure xim_message (object, message)
+
+char	object[ARB]				#I object name
+char	message[ARB]				#I message to send
+
+pointer	sp, msgbuf
+int	msglen, olen, mlen, ip 
+
+int	strlen()
+bool	streq()
+
+begin
+	# Get the message length plus some extra for the braces and padding.
+	olen = strlen (object)
+	mlen = strlen (message)
+	msglen = olen + mlen + 20
+
+	# Allocate and clear the message buffer.
+	call smark (sp)
+	call salloc (msgbuf, msglen, TY_CHAR)
+	call aclrc (Memc[msgbuf], msglen)
+
+	if (streq (object, "ximtool")) {
+	    # Just send the message.
+	    call strcpy (message, Memc[msgbuf], msglen)
+	} else {
+	    # Format the message.  We can't use a sprintf here since the
+	    # message may be bigger than that allowed by a pargstr().
+	    ip = 0
+	    call amovc ("send ", Memc[msgbuf+ip], 5)   	; ip = ip + 5
+	    call amovc (object,  Memc[msgbuf+ip], olen)	; ip = ip + olen
+	    call amovc (" { ",   Memc[msgbuf+ip], 3)   	; ip = ip + 3
+	    call amovc (message, Memc[msgbuf+ip], mlen)	; ip = ip + mlen
+	    call amovc (" }\0",  Memc[msgbuf+ip], 2)   	; ip = ip + 3
+	}
+	msglen = strlen (Memc[msgbuf])
+
+	# Now send the message.  The write routine does the strpak().
+	call xim_write (Memc[msgbuf], msglen)
+
+	call sfree (sp)
+end
+
+
+# XIM_ALERT -- Send an alert message to XImtool.
+
+procedure xim_alert (text, ok, cancel)
+
+char	text[ARB]				#I warning text
+char	ok[ARB]					#i client OK message
+char	cancel[ARB]				#i client CANCEL message
+
+pointer	sp, msg
+
+begin
+	call smark (sp)
+	call salloc (msg, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[msg], SZ_LINE, "{%s} {%s} {%s}")
+	    call pargstr (text)
+	    call pargstr (ok)
+	    call pargstr (cancel)
+
+	call xim_message ("alert", Memc[msg])
+
+	call sfree (sp)
+end
+
+
+# XIM_WRITE -- Low-level write of a message to the socket.  Writes exactly
+# len bytes to the stream.
+
+procedure xim_write (message, len)
+
+char	message[ARB]				#I message to send
+int	len					#I length of message
+
+int	nleft, n, ip
+char	msgbuf[SZ_MESSAGE]
+int	strlen()
+
+# I/O common.
+int	fdin, fdout, mode, nbuf, nsave, nr, nw
+char	buffer[SZ_MESSAGE], bufsave[SZ_MESSAGE]
+common	/ximfd/ fdin, fdout, mode, nbuf, buffer, nsave, bufsave, nr, nw
+
+errchk	write, flush
+
+begin
+	# Pad message with a NULL to terminate it.
+	len = strlen (message) + 1
+	message[len] = '\0'
+
+	if (mod(len,2) == 1) {
+	    len = len + 1
+	    message[len] = '\0'
+	}
+
+	ip = 1
+	nleft = len
+	while (nleft > 0) {
+	    n = min (nleft, SZ_MESSAGE)
+	    call amovc (message[ip], msgbuf, n)
+	    if (mode == XIM_BINARY) {
+	        call achtcb (msgbuf, msgbuf, n)
+                call write (fdout, msgbuf, n / SZB_CHAR)
+	    } else
+                call write (fdout, msgbuf, n)
+
+	    ip = ip + n
+	    nleft = nleft - n
+	}
+	nw = nw + len
+        call flush (fdout)
+
+	if (XIM_DBG) {
+	    call eprintf ("xim_write: '%.45s' len=%d mode=%d tot=%d\n")
+	        call pargstr (message);call pargi (len)
+		call pargi (mode); call pargi (nw)
+	}
+end
+
+
+# XIM_READ -- Low-level read from the socket.
+
+int procedure xim_read2 (message, len)
+
+char	message[ARB]				#O message read
+int	len					#O length of message
+
+int	i, n, nleft, read()
+
+# I/O common.
+int	fdin, fdout, mode, nbuf, nsave, nr, nw
+char	buffer[SZ_MESSAGE], bufsave[SZ_MESSAGE]
+common	/ximfd/ fdin, fdout, mode, nbuf, buffer, nsave, bufsave, nr, nw
+
+# Interrupt handler variables common.
+int     ximepa, ximstat, old_onint, xim_fd, xim_jmp[LEN_JUMPBUF]
+common  /ximcom/ xim_fd, xim_jmp, ximepa, ximstat, old_onint
+
+errchk	read
+
+begin
+	if (nbuf == 0) {
+	    clear the message buffer
+	    n = read (fdin, message, SZ_MESSAGE)
+            if (n < 0) 
+	        return (EOF)
+
+	    if (mode == XIM_BINARY)
+		msglen = N * SZ_CHAR
+	        unpack binary data
+	    } else
+		msglen = N
+
+	    if (message[msglen] != EOS)
+		# Incomplete message so save the partial to a local buffer.
+		for (i=msglen; message[i] != EOS && i > 0; i=i-1) {
+		    ;
+		nsave =  msglen - i + 1
+		call strcpy (message[i+1], bufsave)	# save partial
+		call aclrc (message[i+1], nsave)	# clear partial
+		nbuf = i
+	    } else {
+		# Complete message.
+		nbuf = msglen
+		nsave = 0
+		call aclrc (bufsave, SZ_MESSAGE)
+	    }
+	}
+
+	# Pull out a null-terminated message from the buffer.
+	for (i=1; buffer[i] != EOS && buffer[i] != EOF && i <= nbuf; i=i+1)
+	    message[i] = buffer[i]
+	message[i] = '\0'
+	len = i				# length of the current message
+	nleft = nbuf - i		# nchars left in the buffer
+	nr = nr + len
+
+	if (buffer[i] == EOS && buffer[i+1] == EOF) {
+	    # That was the last message, force a new read next time we're
+	    # called.
+	    if (i > 1 && nleft > 1)
+	        call amovc (buffer[i+1], buffer, nleft)
+	    nbuf = 0
+	} else {
+	    # More of the message is left in the buffer.
+	    if (nleft > 0)
+	        call amovc (buffer[i+1], buffer, nleft)
+	    nbuf = nleft
+	}
+end
+
+
+# XIM_READ -- Low-level read from the socket.
+
+int procedure xim_read (message, len)
+
+char	message[ARB]				#O message read
+int	len					#O length of message
+
+int	i, n, nleft, read()
+
+# I/O common.
+int	fdin, fdout, mode, nbuf, nsave, nr, nw
+char	buffer[SZ_MESSAGE], bufsave[SZ_MESSAGE]
+common	/ximfd/ fdin, fdout, mode, nbuf, buffer, nsave, bufsave, nr, nw
+
+# Interrupt handler variables common.
+int     ximepa, ximstat, old_onint, xim_fd, xim_jmp[LEN_JUMPBUF]
+common  /ximcom/ xim_fd, xim_jmp, ximepa, ximstat, old_onint
+
+errchk	read
+
+begin
+	# No data left in the buffer so read from the socket
+	if (nbuf == 0) {
+	    call aclrc (buffer, SZ_MESSAGE)
+	    #call amovkc (EOF, buffer, SZ_MESSAGE)
+	    nbuf = 0
+
+            iferr {
+		n = read (fdin, message, SZ_MESSAGE)
+                if (n < 0) 
+	            return (EOF)
+            } then {
+        	call xer_reset()
+        	call zdojmp (xim_jmp, X_IPC)
+            }
+
+	    if (mode == XIM_BINARY) {
+	        len = n * SZB_CHAR
+	        call achtbc (message, message, len)
+	    } else
+	       len = n
+
+	    # Save the data read to a local buffer.  Remove any extra 
+	    # EOS padding and append an EOF on the string.
+	    call amovc (message, buffer, len)
+	    if (buffer[len] == EOS && buffer[len-1] == EOS)
+		nbuf = len
+	    else 
+	        nbuf = len + 1
+	    buffer[nbuf] = EOF
+	}
+
+	for (i=1; buffer[i] != EOS && buffer[i] != EOF && i <= nbuf; i=i+1)
+	    message[i] = buffer[i]
+	message[i] = '\0'
+	len = i				# length of the current message
+	nleft = nbuf - i		# nchars left in the buffer
+	nr = nr + len
+
+	if (buffer[i] == EOS && buffer[i+1] == EOF) {
+	    # That was the last message, force a new read next time we're
+	    # called.
+	    if (i > 1 && nleft > 1)
+	        call amovc (buffer[i+1], buffer, nleft)
+	    nbuf = 0
+	} else {
+	    # More of the message is left in the buffer.
+	    if (nleft > 0)
+	        call amovc (buffer[i+1], buffer, nleft)
+	    nbuf = nleft
+	}
+
+	if (XIM_DBG) {
+	    call eprintf ("xim_read: tot=%d len=%d msg='%s'\n")
+	        call pargi(nr); call pargi (len);
+		call pargstr(message)
+	    call eprintf ("xim_read: nbuf=%d nleft=%d buffer='%s'\n")
+		call pargi (nbuf); call pargi(nleft); call pargstr(buffer)
+	}
+
+	return (len)
+end
+
+
+# XIM_INTRHANDLER -- User-callable interrupt handler so the ISM client code
+# doesn't need to know about our internals.
+
+int procedure xim_intrhandler()
+
+extern	xim_zxwhen()
+
+# Interrupt handler variables common.
+int     ximepa, ximstat, old_onint, xim_fd, xim_jmp[LEN_JUMPBUF]
+common  /ximcom/ xim_fd, xim_jmp, ximepa, ximstat, old_onint
+
+begin
+        call zlocpr (xim_zxwhen, ximepa)
+        call xwhen (X_INT, ximepa, old_onint)
+        call zsvjmp (xim_jmp, ximstat)
+
+	if (ximstat == OK)
+	    return (OK)
+	else
+	    return (ERR)
+end
+
+
+# XIM_ZXWHEN -- Interrupt handler for the Ximtool client task.  Branches back
+# to ZSVJMP in the user routine to permit shutdown without an error message
+# after first disconnecting from the socket.
+
+procedure xim_zxwhen (vex, next_handler)
+
+int     vex             # virtual exception
+int     next_handler    # not used
+
+# Interrupt handler variables common.
+int     ximepa, ximstat, old_onint, xim_fd, xim_jmp[LEN_JUMPBUF]
+common  /ximcom/ xim_fd, xim_jmp, ximepa, ximstat, old_onint
+
+begin
+	call xim_disconnect (YES)
+        call xer_reset()
+        call zdojmp (xim_jmp, vex)
+end
+
+
+# XIM_ONERROR -- Error exit handler for the interface.  If this is a normal exit
+# the shut down quietly, otherwise notify the server.
+
+procedure xim_onerror (status)
+
+int	status					#i not used (req. for ONEXIT)
+
+# Exception handler variables common.
+int     xim_errstat
+common  /ximecom/ xim_errstat
+
+int	code
+char	buf[SZ_LINE], errmsg[SZ_LINE]
+
+int	errget()
+
+# Interrupt handler variables common.
+int     ximepa, ximstat, old_onint, xim_fd, xim_jmp[LEN_JUMPBUF]
+common  /ximcom/ xim_fd, xim_jmp, ximepa, ximstat, old_onint
+
+begin
+	if (status != OK) {
+	    code = errget (errmsg, SZ_LINE)
+	    call sprintf (buf, SZ_LINE, "ISM Error, code %d:\n`%s\'")
+	        call pargi (status)
+	        call pargstr (errmsg)
+
+	    call xim_alert (buf, NULL, NULL)
+	    call xim_disconnect (YES)
+	}
+end