;-*-LISP-*- 

; getsyntax	SUBR 2 args
; 
; 	(getsyntax c s) returns information about the syntax of the character
; c in the readtable.  c can be a fixnum which is the Ascii code for a char,
; or it can be a character object. s is a symbol selecting which information is
; required.
; 	SYNTAX - the syntax bits are returned as a fixnum.
; 	SINGLE - if the syntax of  c  is that for single character objects,
; 		 T is returned; otherwise, NIL.
; 	MACRO  - if  c  is a macro character, the function is returned.
; 	SPLICING - if  c  is a splicing macro character, the function is
; 		 returned.
; 	CHTRAN - returns a character object which is the chtran of  c .
;;;This really should be in MacLISP!

(declare (eval (read)))
(setsyntax '/ 'macro '(lambda () ((lambda (ibase) (read)) 8.)))

(defun getsyntax (c s)
  ((lambda (c syn mac)
	   (setq syn (status syntax (+ c 0)) mac (status macro (+ c 0)))
	   (caseq s
		  (syntax syn)
		  (single (= syn 600500))
		  (macro (and (= 0 (boole 1 40 syn)) mac))
		  (splicing (and (= 40 (boole 1 40 syn)) mac))
		  (chtran (ascii (status chtran (+ c 0))))
		  (T (getsyntax c (error '|Bad option - GETSYNTAX| s 
					 'wrng-type-arg)))))
   (do c c c nil 
       (caseq (typep c)
	      (fixnum (return c))
	      (symbol (return (getcharn c 1)))
	      (T (setq c (error '|Bad character type - GETSYNTAX|
				c 'wrng-type-arg)))))
   nil nil))

(declare (eval (read)))  (setsyntax '/ 'macro nil)