home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROGS.ZIP / MR.ICN < prev    next >
Encoding:
Text File  |  1993-01-27  |  11.9 KB  |  424 lines
  1. ############################################################################
  2. #
  3. #    File:     mr.icn
  4. #
  5. #    Subject:  Program to read mail
  6. #
  7. #    Author:   Ronald Florence
  8. #
  9. #    Date:     April 29, 1992
  10. #
  11. ###########################################################################
  12. #
  13. #    Version:  1.4
  14. #
  15. ###########################################################################
  16. #
  17. #  With no arguments, mr reads the default mail spool.  Another user,
  18. #  a spool file, or the recipient for outgoing mail can be given as 
  19. #  a command line argument.  Help, including the symbols used to 
  20. #  indicate the status of mail, is available with the H command. 
  21. #
  22. #  Usage:  mr [recipient] [-u user] [-f spool]
  23. #    
  24. #  Configuration:
  25. #
  26. #    Editor    for replies or new mail.
  27. #    Host      optional upstream routing address for outgoing mail;
  28. #        a domained Host is appended to the address, a uucp
  29. #        Host prefixes the address.
  30. #    Mail_cmd      the system mailer (usually sendmail, smail, or mail).
  31. #    print_cmd     command to format and/or spool material for the printer
  32. #        (for OS with pipes).  &null for ms-dos.
  33. #    ignore     a list of headers to hide when paging messages.  The V
  34. #            command views hidden headers.
  35. #
  36. #  Non-UNIX systems only:
  37. #
  38. #    non_unix_mailspool  full path of the default mailspool.
  39. #
  40. ############################################################################
  41. #
  42. #  Links:  iolib, options, tempname
  43.  
  44. link iolib, options, tempname
  45.  
  46. global Host, Editor, Spool, Status, Mail_cmd
  47.  
  48. procedure main(arg)
  49.   local i, opts, cmd, art, mailspool, print_cmd, ignore, non_unix_mailspool
  50.  
  51.                 # configuration 
  52.   Editor := "vi"
  53.   Host := &null
  54.   Mail_cmd := "/usr/lib/sendmail -t"
  55.   print_cmd := "mp -F | lpr"
  56.   ignore := ["From ", "Message-Id", "Received", "Return-path", "\tid", 
  57.          "Path", "Xref", "References", "X-mailer", "Errors-to", 
  58.          "Resent-Message-Id", "Status", "X-lines", "X-VM-Attributes"]
  59.   non_unix_mailspool := &null
  60.  
  61.                 # end of configuration
  62.  
  63.   if not "UNIX" == &features then 
  64.       mailspool := getenv("MAILSPOOL") | \non_unix_mailspool | "DUNNO"
  65.   opts := options(arg, "u:f:h?") 
  66.   \opts["h"] | \opts["?"] | arg[1] == "?" & 
  67.     stop("usage: mr [recipient] [-f spoolfile] [-u user]")
  68.   \arg[1] & { write(); newmail(arg[1]); exit(0) }
  69.   /mailspool := "/usr/spool/mail/" || (\opts["u"] | getenv("LOGNAME"|"USER"))
  70.   \opts["f"] & mailspool := opts["f"] 
  71.   i := readin(mailspool)
  72.   headers(mailspool, i)
  73.   repeat {
  74.     cmd := query("\n[" || i || "/" || *Status || "]: ", " ")
  75.     if integer(cmd) & (cmd > 0) & (cmd <= *Status) then 
  76.     headers(mailspool, i := cmd)
  77.     else case map(!cmd) of {
  78.       " ":  { showart(i, ignore); i := inc(i) }
  79.       "a":  save(query("Append to: "), i, "append")
  80.       "d":  { Status[i] ++:= 'D'; clear_line(); i := inc(i) }
  81.       "f":  forward(query("Forward to: "), i)
  82.       "g":  readin(mailspool, "update") & headers(mailspool, i)
  83.       "l":  headers(mailspool, i)
  84.       "m":  newmail(query("Address: "))
  85.       "p":  print(print_cmd, i)
  86.       "q":  quit(mailspool)
  87.       "r":  reply(i)
  88.       "s":  save(query("Filename: "), i)
  89.       "u":  { Status[i] --:= 'D'; clear_line(); i := inc(i) }
  90.       "v":  showart(i, ignore, "all")
  91.       "x":  upto('yY', query("Are you sure? ")) & exit(1) 
  92.       "|":  pipeto(query("Command: "), i)
  93.       "!":  { system(query("Command: ")) 
  94.           write() & query("Press <return> to continue") }
  95.       "-":  { if (i -:= 1) = 0 then i := *Status; showart(i, ignore) }
  96.       "+"|"n":  showart(i := inc(i), ignore)
  97.       "?"|"h":  help()
  98.       default:  clear_line() & writes("\^g")
  99.     }
  100.   }
  101. end
  102.  
  103.                 # Read the mail spool into a list of
  104.                 # lists and set up a status list.
  105. procedure readin(spoolname, update)
  106.   local sf, i, article
  107.  
  108.   Spool := []
  109.   \update | Status := []
  110.   sf := open(spoolname) | stop("Can't read " || spoolname)
  111.   i := 0
  112.   every !sf ? {
  113.     ="From " & {
  114.       ((i +:= 1) > 1) & put(Spool, article)
  115.       article := []      
  116.       (i > *Status) & put(Status, 'N')
  117.     }
  118.     (i > 0) & put(article, &subject)
  119.   }
  120.   (i > 0) & {
  121.     put(Spool, article)
  122.     i := 1
  123.   }
  124.   close(sf)
  125.   return i
  126. end
  127.  
  128.                 # Parse messages for author & subject,
  129.                 # highlight the current message.
  130. procedure headers(spoolname, art)
  131.   local hlist, i, entry, author, subj
  132.  
  133.   hlist := []
  134.   every i := 1 to *Status do {
  135.     entry := if i = art then getval("md"|"so") else ""
  136.     entry ||:= left(i, 3, " ") || left(Status[i], 4, " ")
  137.     author := ""
  138.     subj := ""
  139.     while (*author = 0) | (*subj = 0) do !Spool[i] ? {
  140.       ="From: " & author := tab(0)
  141.       ="Subject: " & subj := tab(0)
  142.       (*&subject = 0) & break
  143.     }
  144.     entry ||:= " [" || right(*Spool[i], 3, " ") || ":" 
  145.     entry ||:= left(author, 17, " ") || "]  " || left(subj, 45, " ")
  146.     (i = art) & entry ||:= getval("me"|"se")
  147.     put(hlist, entry)
  148.   }
  149.   put(hlist, "")
  150.   more(spoolname, hlist)
  151. end
  152.  
  153.                 # Check if any messages are deleted;
  154.                 # if the spool cannot be written,
  155.                 # write a temporary spool.  Rename
  156.                 # would be convenient, but won't work
  157.                 # across file systems.
  158. procedure quit(spoolname)
  159.   local msave, f, tfn, i
  160.  
  161.   every !Status ? { find("D") & break msave := 1 }
  162.   \msave & {
  163.     readin(spoolname, "update")
  164.     (f := open(spoolname, "w")) | {
  165.       f := open(tfn := tempname(), "w")      
  166.       write("Cannot write " || spoolname || ".  Saving changes to " || tfn)
  167.     }
  168.     every i := 1 to *Status do {
  169.       find("D", Status[i]) | every write(f, !Spool[i])
  170.     }
  171.   }
  172.   exit(0)
  173. end
  174.  
  175.  
  176. procedure save(where, art, append)
  177.   local mode, outf
  178.  
  179.   mode := if \append then "a" else "w"
  180.   outf := open(where, mode) | { write("Can't write ", where) & fail }
  181.   every write(outf, !Spool[art])
  182.   Status[art] ++:= 'S'
  183.   return close(outf)
  184. end
  185.  
  186.  
  187. procedure pipeto(cmd, art)
  188.   static real_pipes
  189.   local p, tfn, status
  190.  
  191.   initial real_pipes := "pipes" == &features
  192.   p := (\real_pipes & open(cmd, "wp")) | open(tfn := tempname(), "w")
  193.   every write(p, !Spool[art])
  194.   if \real_pipes then return close(p) 
  195.   else {
  196.     cmd ||:= " < " || tfn
  197.     status := system(cmd)
  198.     remove(tfn)
  199.     return status
  200.   }
  201. end
  202.  
  203.  
  204. procedure print(cmd, art)
  205.   local p, status
  206.   
  207.   if \cmd then status := pipeto(cmd, art)
  208.   else if not "MS-DOS" == &features then 
  209.       return write("Sorry, not configured to print messages.")
  210.   else {
  211.     p := open("PRN", "w")
  212.     every write (p, !Spool[art])
  213.     status := close(p) 
  214.   }
  215.   \status & { Status[art] ++:= 'P'; clear_line() }
  216. end
  217.  
  218.  
  219.                 # Lots of case-insensitive parsing.
  220. procedure reply(art)
  221.   local tfn, fullname, address, quoter, date, id, subject, newsgroup, refs, r
  222.  
  223.   r := open(tfn := tempname(), "w")
  224.   every !Spool[art] ? {
  225.     tab(match("from: " | "reply-to: ", map(&subject))) & {
  226.       if find("<") then {
  227.     fullname := tab(upto('<'))
  228.     address := (move(1), tab(find(">")))
  229.       }
  230.       else {
  231.     address := trim(tab(upto('(') | 0))
  232.     fullname := (move(1), tab(find(")")))
  233.       }
  234.       while match(" ", \fullname, *fullname) do fullname ?:= tab(-1)
  235.       quoter := if *\fullname > 0 then fullname else address
  236.     }
  237.     tab(match("date: ", map(&subject))) & date := tab(0)
  238.     tab(match("message-id: ", map(&subject))) & id := tab(0)
  239.     match("subject: ", map(&subject)) & subject := tab(0)
  240.     match("newsgroups: ", map(&subject)) & newsgroup := tab(upto(',') | 0)
  241.     match("references: ", map(&subject)) & refs := tab(0)
  242.     (\address & *&subject = 0) & {
  243.       writes(r, "To: " || address)
  244.       write(r, if *\fullname > 0 then " (" || fullname || ")" else "")
  245.       \subject & write(r, subject)
  246.       \newsgroup & write(r, newsgroup)
  247.       \refs & write(r, refs, " ", id)
  248.       write(r, "In-reply-to: ", quoter, "'s message of ", date);
  249.       write(r, "\nIn ", id, ", ", quoter, " writes:\n")
  250.       break
  251.     }
  252.   }
  253.   every write(r, " > ", !Spool[art])
  254.   send(tfn, address) & {
  255.     Status[art] ++:= 'RO'
  256.     Status[art] --:= 'N'
  257.   }
  258. end
  259.  
  260.                 # Put user in an editor with a temp
  261.                 # file, query for confirmation, if
  262.                 # necessary rewrite address, and send.
  263. procedure send(what, where)
  264.   local edstr, mailstr, done
  265.   static console
  266.  
  267.   initial {
  268.     if "UNIX" == &features then console := "/dev/tty"
  269.     else if "MS-DOS" == &features then console := "CON"
  270.     else stop("Please configure `console' in mr.icn.")
  271.   }
  272.   edstr := (getenv("EDITOR") | Editor) || " " || what || " < " || console
  273.   system(edstr)
  274.   upto('nN', query( "Send to " || where || " y/n? ")) & {
  275.     if upto('yY', query("Save your draft y/n? ")) then 
  276.       clear_line() & write("Your draft is saved in " || what || "\n")
  277.     else clear_line() & remove(what)
  278.     fail
  279.   }
  280.   clear_line()
  281.   \Host & not find(map(Host), map(where)) & upto('!@', where) & {
  282.     find("@", where) & where ? {
  283.       name := tab(upto('@'))
  284.       where := (move(1), tab(upto(' ') | 0)) || "!" || name
  285.     }
  286.     if find(".", Host) then where ||:= "@" || Host
  287.     else where := Host || "!" || where
  288.   }
  289.   mailstr := Mail_cmd || " " || where || " < " || what
  290.   done := system(mailstr)
  291.   remove(what)
  292.   return done
  293. end
  294.  
  295.  
  296. procedure forward(who, art)
  297.   local out, tfn
  298.  
  299.   out := open(tfn := tempname(), "w")
  300.   write(out, "To: " || who)
  301.   write(out, "Subject: FYI (forwarded mail)\n")
  302.   write(out, "-----[begin forwarded message]-----")
  303.   every write(out, !Spool[art])
  304.   write(out, "------[end forwarded message]------")
  305.   send(tfn, who) & Status[art] ++:= 'F'
  306. end
  307.  
  308.   
  309. procedure newmail(address)
  310.   local out, tfn
  311.  
  312.   out := open(tfn := tempname(), "w")
  313.   write(out, "To: " || address)
  314.   write(out, "Subject:\n")
  315.   return send(tfn, address)
  316. end
  317.  
  318.  
  319. procedure showart(art, noshow, eoh)
  320.   local out
  321.  
  322.   out := []
  323.   every !Spool[art] ? {
  324.     /eoh := *&subject = 0
  325.     if \eoh | not match(map(!noshow), map(&subject)) then put(out, tab(0))
  326.   }
  327.   more("Message " || art, out, "End of Message " || art)
  328.   Status[art] ++:= 'O'
  329.   Status[art] --:= 'N'
  330. end
  331.       
  332.  
  333. procedure help()
  334.   local hlist, item
  335.   static pr, sts
  336.  
  337.   initial {
  338.     pr := ["Append message to a file",
  339.        "Delete message", 
  340.        "eXit, without saving changes", 
  341.        "Forward message",
  342.        "Get new mail",
  343.        "Help", 
  344.        "List headers",
  345.        "Mail to a new recipient", 
  346.        "Next message", 
  347.        "Print message", 
  348.        "Quit, saving changes", 
  349.        "Reply to message", 
  350.        "Save message", 
  351.        "Undelete message", 
  352.        "View all headers",
  353.        "| pipe message to a command",
  354.        "+ next message",
  355.        "- previous message",
  356.        "! execute command",
  357.        "# make # current message",
  358.        " "]
  359.     sts := ["New", "Old", "Replied-to", "Saved", 
  360.         "Deleted", "Forwarded", "Printed"]
  361.   }
  362.   hlist := []
  363.   every !(pr ||| sts) ? {
  364.     item := "  "
  365.     item ||:= tab(upto(&ucase++'!|+-#') \1) || getval("md"|"so") || 
  366.     move(1) || getval("me"|"se") || tab(0)
  367.     put(hlist, item)
  368.   }
  369.   put(hlist, "")
  370.   more("Commands & Status Symbols", hlist)
  371. end
  372.  
  373.                 # The second parameter specifies a
  374.                 # default response if the user presses
  375.                 # <return>.
  376. procedure query(prompt, def)
  377.   local ans
  378.  
  379.   clear_line()
  380.   writes(prompt)
  381.   ans := read()
  382.   return (*ans = 0 & \def) | ans
  383. end
  384.  
  385.                 # Increment the count, then cycle
  386.                 # through again when user reaches the
  387.                 # end of the list.
  388. procedure inc(art)
  389.  
  390.   if (art +:= 1) > *Status then art := 1
  391.   return art
  392. end
  393.  
  394.  
  395. procedure more(header, what, footer)
  396.   local ans, lines
  397.  
  398.   writes(getval("cl"))
  399.   lines := 0
  400.   \header & {
  401.     write(getval("us") || header || getval("ue"))
  402.     lines +:= 1
  403.   }
  404.   every !what ? {
  405.     write(tab(0))
  406.     ((lines +:= 1 + *&subject/getval("co")) % (getval("li") - 1) = 0) & {
  407.       writes(getval("so") || 
  408.          "-MORE-(", (100 > (lines - 2)*100/*what) | 100, "%)" || 
  409.          getval("se"))
  410.       ans := read() & clear_line()
  411.       upto('nNqQ', ans) & fail
  412.     }
  413.   }
  414.   \footer & {
  415.     writes(getval("so") || footer || getval("se")) 
  416.     read() & clear_line()
  417.   }
  418. end
  419.  
  420. procedure clear_line()
  421.  
  422.   return writes(getval("up") || getval("ce"))
  423. end
  424.