picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

app.l (917B)

      1 # 16nov12abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 # Exit on error
      5 (de *Err
      6    (and trail (println (trail T)))
      7    (prinl *Pid " ! " (stamp) " [" *Adr " " (host *Adr) "] " *Agent)
      8    (show This)
      9    (for "X" '(*Gate *Agent *Host *Port *PRG *Url *SesId *ConId *Tab *Gui *Btn *Get *ID)
     10       (println "X" (val "X")) )
     11    (for "X" (env)
     12       (unless (== (car "X") (cdr "X"))
     13          (println (car "X") (cdr "X")) ) )
     14    (rollback) )
     15 
     16 # User identification
     17 (de user (Pid1 Pid2 Nm To)
     18    (nond
     19       (Pid1 (tell 'user *Pid))
     20       (Pid2
     21          (tell 'user Pid1 *Pid (get *Login 'nm)
     22             (/ (- *Timeout (cadr (assoc -1 *Run))) 60000) ) )
     23       ((<> *Pid Pid1) (println Pid2 Nm To)) ) )
     24 
     25 # Timestamp
     26 (msg *Pid " + " (stamp))
     27 (flush)
     28 
     29 # Extend 'app' function
     30 (conc (last app)
     31    '((msg *Pid " + " (stamp) " [" *Adr " " (host *Adr) "] " *Agent)) )
     32 
     33 # Bye message
     34 (push1 '*Bye '(and *SesId (msg *Pid " - " (stamp))))