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