archive/share/trash/fido.lisp

   1 ;;; -*- LISP -*-
   2 ;;; Defines the Macsyma function FIDO
   3 ;;;
   4 ;;; FIDO();                tells who if anyone fido is looking for
   5 ;;; FIDO(FALSE);           turns off a fido
   6 ;;; FIDO(Name1,Name2,...); starts fido looking for those people
   7 ;;;
   8 ;;; Fido can't be made to look for someone if the alarmclock is already
   9 ;;; in use, including if it is already being used by a different fido.
  10
  11 (DECLARE (*EXPR STRIPDOLLAR)
  12          (SPECIAL $FIDOLIST $FIDOTIME))
  13
  14 (COND ((NOT (BOUNDP '$FIDOLIST))
  15        (SETQ $FIDOLIST (NCONS '(MLIST SIMP)))))
  16
  17 (COND ((NOT (BOUNDP '$FIDOTIME))
  18        (SETQ $FIDOTIME 30.)))
  19
  20 (DEFUN $FIDO FEXPR (X)
  21         (COND ((NULL X) $FIDOLIST)
  22               ((EQ (CAR X) '$FALSE)
  23                (SETQ ALARMCLOCK NIL)
  24                (SETQ $FIDOLIST (CONS '(MLIST SIMP) NIL)))
  25               (ALARMCLOCK
  26                (ERROR '|This MACSYMA's Alarm clock already in use.|))
  27               (T
  28                (SETQ ALARMCLOCK 'FIDO-INTERRUPT)
  29                (ALARMCLOCK 'TIME $FIDOTIME)
  30                (SETQ $FIDOLIST (CONS '(MLIST SIMP) X)))))
  31
  32 (DEFUN FIDO-INTERRUPT (())
  33        (DO ((L (CDR $FIDOLIST) (CDR L))
  34             (HERE ())
  35             (TEMP))
  36            ((NULL L)
  37             (COND (HERE
  38                    (CURSORPOS 'A TYO)
  39                    (PRINC '|;From FIDO: Here | TYO)
  40                    (COND ((= (LENGTH HERE) 1.)
  41                           (PRINC '|is | TYO)
  42                           (PRINC (CAR HERE) TYO))
  43                          (T
  44                           (PRINC '|are | TYO)
  45                           (PRINC (CAR HERE) TYO)
  46                           (MAPCAR (FUNCTION
  47                                    (LAMBDA (X)
  48                                            (PRINC '|, | TYO)
  49                                            (PRINC X TYO)))
  50                                   (CDR HERE))))
  51                    (PRINC '/. TYO)
  52                    (TERPRI TYO)
  53                    (COND ((CDR $FIDOLIST) (ALARMCLOCK 'TIME $FIDOTIME))
  54                          (T (SETQ ALARMCLOCK NIL))))
  55                   (T
  56                    (ALARMCLOCK 'TIME $FIDOTIME))))
  57            (COND ((PROBEF `((USR) ,(SETQ TEMP (STRIPDOLLAR (CAR L))) HACTRN))
  58                   (PUSH TEMP HERE)
  59                   (DELETE (CAR L) $FIDOLIST)))))
  60