View of /lisp/tools/etc.l

Parent Directory

Revision Log

change to CVS wadalab font project

;;
;; etc.l
;;

(defmacro undeclare (l type)
  (or (memq type
	    '(special redefine fix-result fix-value nogc string-result fixnum 
		      vector string lppeval))
      (funcall err:argument-type type 'declare))
  `(lets ((type ',type))
     (mapc ',l (function (lambda (x) (remprop x type))))))

(defun pr-assumed-special ()
   (do ((l (oblist) (cdr l)) 
	(ret))
       ((atom l) (nreverse ret))
       (cond ((eq (get (car l) 'special) 'assumed)
              (push (car l) ret)))))

(defun delete-all-special ()
  (mapcar (oblist) #'(lambda (x) (remprop x 'special))))

(defun clear-event (display)
  (setf (display-event-queue-head display) nil) 
  (setf (display-event-queue-tail display) nil))