#| -*- Mode:LISP; Package:(INTERLISP global); Fonts:(cptfontb); Base:10 -*- |#

;;;
;;; Definitions for InterLisp compatibility
;;;

(DEFUN INSERT (L-OBJ L-LIST FUNC &OPTIONAL DUPS-P)
"(INSERT l-obj l-list func dups-p)
  Insert 'l-obj' destructively into 'l-list' at the place
  determined by 'func'. The function-spec 'func' should
  expect 2 arguments, the 'l-obj' and an element of 'l-list'.
  'func' is called recursively on 'l-obj' and the head of 'l-list';
  if and when 'func' returns a non-NIL value, 'l-obj' is spliced
  into the list ahead of the current element of 'l-list'.  For
  example:

    (setq foo '(1 2 5 8 10)) => (1 2 5 8 10)
    (insert 6 foo 'lessp)    => (6 8 10)
    foo                      => (1 2 5 6 8 10)

  The flag 'dups-p' can be included as the last argument to
  indicate that if a duplicate value is encountered before
  'l-obj' is spliced in, don't insert the duplicate.
  For example:

    (insert 5 foo 'lessp)    => (5 6 8 10)
    foo                      => (1 2 5 5 6 8 10)
    (insert 5 foo 'lessp t)  => NIL
    foo                      => (1 2 5 5 6 8 1))"

  (COND ((NULL L-LIST) NIL)
        ((AND DUPS-P (EQUAL L-OBJ (CAR L-LIST))) NIL)
        ((FUNCALL FUNC L-OBJ (CAR L-LIST))
         (PSL:PUSH-IP L-OBJ L-LIST))
        (T (INSERT L-OBJ (CDR L-LIST) FUNC DUPS-P))))