File: app.l

package info (click to toggle)
picolisp 3.1.0.7-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 4,100 kB
  • sloc: ansic: 14,205; lisp: 795; makefile: 290; sh: 13
file content (33 lines) | stat: -rw-r--r-- 882 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
# 01apr12abu
# (c) Software Lab. Alexander Burger

# Exit on error
(de *Err
   (prinl *Pid " ! " (stamp) " [" *Adr " " (host *Adr) "] " *Agent)
   (show This)
   (for "X" '(*Gate *Agent *Host *Port *PRG *Url *SesId *ConId *Tab *Gui *Btn *Get *ID)
      (println "X" (val "X")) )
   (for "X" (env)
      (unless (== (car "X") (cdr "X"))
         (println (car "X") (cdr "X")) ) )
   (rollback) )

# User identification
(de user (Pid1 Pid2 Nm To)
   (nond
      (Pid1 (tell 'user *Pid))
      (Pid2
         (tell 'user Pid1 *Pid (get *Login 'nm)
            (/ (- *Timeout (cadr (assoc -1 *Run))) 60000) ) )
      ((<> *Pid Pid1) (println Pid2 Nm To)) ) )

# Timestamp
(msg *Pid " + " (stamp))
(flush)

# Extend 'app' function
(conc (last app)
   '((msg *Pid " + " (stamp) " [" *Adr " " (host *Adr) "] " *Agent)) )

# Bye message
(push1 '*Bye '(and *SesId (msg *Pid " - " (stamp))))