home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / mail / pine / imap-3.0 / MM-D / mm < prev    next >
Encoding:
Text File  |  1988-12-24  |  121.0 KB  |  2,120 lines
  1. (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
  2. (FILECREATED "15-Jun-88 15:42:36" {SAFE}</B/MRC>MM.;168 121301 
  3.  
  4.       changes to%:  (FILES TABLEBROWSERDECLS)
  5.                     (VARS MMCOMS)
  6.                     (FNS MM.MAILBOXWINDOW MM.NEWMAILBOX MM.TOGGLE.SELECTED 
  7.                          MM.REPLACE.TABLEITEMS MM.COMPOSEMENUITEMS MM.REMOVE)
  8.  
  9.       previous date%: " 7-Jun-88 13:15:28" {SAFE}</B/MRC>MM.;167)
  10.  
  11.  
  12. (PRETTYCOMPRINT MMCOMS)
  13.  
  14. (RPAQQ MMCOMS 
  15.        (                                       (* ; 
  16.                                 "MM-D Electronic Mailsystem  -- Mark Crispin")
  17.                                                (* ; "Primary mail menu setup")
  18.         (FNS MM MM.PRIMARYMAILMENU MM.ADDNEWMAILBOX MM.SEARCHFORMAILBOXES)
  19.                                                (* ; 
  20.                                              "Message selection menu setup")
  21.         (FNS MM.CREATEMAILBOXWINDOW MM.MAILBOXWINDOW MM.FLAGMENU 
  22.              MM.MAILBOXWINDOWTITLE MM.CREATEMAILBOXTB MM.MAILBOXMENU 
  23.              MM.COMMANDMENUITEMS MM.MAILBOXMENUITEMS MM.TBPRINTFN MM.TABLEITEM
  24.              MM.UPDATE MM.TBPROP MM.HEADERLINE MM.CLOSEMAILBOXWINDOW 
  25.              MM.FIND.TABLEITEM)
  26.                                                (* ; 
  27.                                              "Primary mail menu functions")
  28.         (FNS MM.NEWMAILBOX MM.SELECTMESSAGES MM.DOSELECTION MM.SELECTMENUITEMS
  29.              MM.SELECT MM.HARDCOPY MM.QUIT MM.EXIT MM.CHECKMAILBOX 
  30.              MM.CHECKENTIREMAILBOX MM.EXPUNGEMAILBOX MM.TOGGLE.SELECTED 
  31.              MM.TOGGLED.SELECTEDFN MM.REPLACE.TABLEITEMS)
  32.                                                (* ; 
  33.                                              "Message reading functions")
  34.         (FNS MM.READMESSAGE MM.TEDITMESSAGE MM.READMENUITEMS 
  35.              MM.READCOMMANDMENUITEMS MM.READCLOSE MM.SETFLAG MM.CLEARFLAG 
  36.              MM.REPLYMESSAGE MM.HARDCOPYMESSAGE MM.COPYMESSAGE MM.MOVEMESSAGE 
  37.              MM.NEXTMESSAGE MM.PREVIOUSMESSAGE MM.KILLMESSAGE MM.MOVETOMESSAGE)
  38.         (FUNCTIONS MM.MSGNO)
  39.                                                (* ; 
  40.                                              "Message composition functions")
  41.         (FNS MM.COMPOSEMESSAGE MM.REPLY MM.FROMADDRESS MM.REPLY.ADDRESS 
  42.              MM.COMPOSEMENUITEMS MM.ADD.RECIPIENT MM.REMOVE MM.SUBJECT 
  43.              MM.REPAINT.ENVELOPE MM.SENDMESSAGE MM.COMPOSEQUIT)
  44.                                                (* ; "Utility functions")
  45.         (FNS MM.SERVICEHOST MM.PROMPTFORMAILBOX MM.PROMPTFORLINE MM.MAILBOX 
  46.              MM.MENU MM.ICONFN MM.GET.WINDOW.REGION MM.FLAGMENUITEMS 
  47.              MM.DOSEQUENCE MM.ADDNEWMESSAGES MM.EXISTS MM.EXPUNGED MM.SEARCHED
  48.              MM.LOCK MM.UNLOCK MM.YCOORD.FROM.ITEM)
  49.                                                (* ; 
  50.                                          "TEdit plain text utility functions")
  51.         (FNS MM.TEDIT.FIXUP MM.TEDIT.STRIPEOLS)
  52.                                                (* ; 
  53.                                              "User-settable parameters")
  54.         (INITVARS MM.SERVICEHOSTS              (* ; "Known IMAP servers")
  55.                MM.PERSONALNAME
  56.                                                (* ; "Personal name string")
  57.                (MM.PRIMARYMAILMENUFONT '(GACHA 10))
  58.                                                (* ; 
  59.                                              "Font used in primary mail menu")
  60.                (MM.ICONFONT '(HELVETICA 8))
  61.                                                (* ; "Font used in icons")
  62.                (MM.MAXIMUMDISPLAYEDMESSAGES 40)
  63.                                                (* ; 
  64.                                              "Maximum messages in browser")
  65.                (MM.MINIMUMDISPLAYEDMESSAGES 20)
  66.                                                (* ; 
  67.                                              "Minimum messages in browser")
  68.                (MM.MAXFROMLENGTH 20)
  69.                                                (* ; 
  70.                                             "Length of displayed From string")
  71.                (MM.MAXSUBJECTLENGTH 35)
  72.                                                (* ; 
  73.                                              "Length of displayed Subject")
  74.                (MM.READWINDOWSIZE (CREATEPOSITION 80 24))
  75.                (MM.COMPOSEWINDOWSIZE (CREATEPOSITION 78 24))
  76.                                                (* ; 
  77.                                              "Dimensions of a 24x80 screen")
  78.                MM.DEFAULT.CC
  79.                                                (* ; "Default CC list")
  80.                MM.DEFAULT.BCC
  81.                                                (* ; "Default BCC list")
  82.                (MM.LIST.CONSECUTIVE.INDEX T)
  83.                                                (* ; 
  84.                        "T to have listings show consecutive sequence numbers")
  85.                MM.LIST.ON.SEPARATE.PAGES
  86.                                                (* ; 
  87.                                        "T to list messages on separate pages")
  88.                MM.LIST.INCLUDE.HEADERS
  89.                                                (* ; 
  90.                                    "T to have a header listing on first page")
  91.                MM.LIST.HOST
  92.                                                (* ; 
  93.                                              "Host for SEND.FILE.TO.PRINTER")
  94.                (MM.DEFAULT.SEARCH.PATTERN "*.TXT")
  95.                                                (* ; 
  96.                                            "Pattern for Search for Mailboxes")
  97.                (MM.REMEMBER.POSITIONS T)
  98.                                                (* ; 
  99.                            "Flag to turn on/off remembering window positions")
  100.                MM.WINDOW
  101.                                                (* ; "Window of primary menu")
  102.                MM.MAILBOXES
  103.                                                (* ; 
  104.                                         "List of mailboxes used by this user")
  105.                (MM.SYSTEM.FLAGS '(\Flagged \Deleted \Answered \Seen \XXXX \YYYY
  106.                                         ))
  107.                                                (* ; "System-reserved flags")
  108.                MM.TEDIT.MENU
  109.                                                (* ; 
  110.                                            "Extended TEDIT menu for composer")
  111.                (MM.TEDIT.TABWIDTH 8)
  112.                                                (* ; 
  113.                                "Assumed width of a tabstop for line breaking")
  114.                (MM.TEDIT.FIXUPFLG T)
  115.                                                (* ; 
  116.                              "Flag to turn on or off automatic line breaking")
  117.                )
  118.                                                (* ; "Declare all globals")
  119.                                                (* ; 
  120.             "Maximum header line length --- See MM.HEADERLINE for the fields")
  121.         [VARS (MM.MAXIMUMHEADERLINELENGTH (PLUS (NCHARS "NUFAD 10-Jan ")
  122.                                                 MM.MAXFROMLENGTH 1 
  123.                                                 MM.MAXSUBJECTLENGTH
  124.                                                 (NCHARS " (9999999 chars)"]
  125.         (GLOBALVARS MM.SERVICEHOSTS MM.PERSONALNAME MM.PRIMARYMAILMENUFONT 
  126.                MM.ICONFONT MM.MAXIMUMDISPLAYEDMESSAGES 
  127.                MM.MINIMUMDISPLAYEDMESSAGES MM.MAXFROMLENGTH MM.MAXSUBJECTLENGTH
  128.                MM.READWINDOWSIZE MM.COMPOSEWINDOWSIZE MM.DEFAULT.CC 
  129.                MM.DEFAULT.BCC MM.LIST.CONSECUTIVE.INDEX 
  130.                MM.LIST.ON.SEPARATE.PAGES MM.LIST.INCLUDE.HEADERS MM.LIST.HOST 
  131.                MM.DEFAULT.SEARCH.PATTERN MM.REMEMBER.POSITIONS MM.WINDOW 
  132.                MM.MAILBOXES MM.SYSTEM.FLAGS MM.TEDIT.MENU MM.TEDIT.TABWIDTH 
  133.                MM.TEDIT.FIXUPFLG MM.COMPOSEMENUITEMS MM.MAXIMUMHEADERLINELENGTH
  134.                )
  135.                                                (* ; "Records")
  136.         (RECORDS MM.CACHE MM.MESSAGE MM.ADDRESS MM.ZOOMDATA)
  137.                                                (* ; 
  138.                                              "Other mailsystem globals")
  139.         (GLOBALVARS MAP.LOOKAHEAD)
  140.                                                (* ; "System globals")
  141.         (GLOBALVARS PROMPTWINDOW LOGINHOST/DIR TEDIT.DEFAULT.MENU)
  142.                                                (* ; 
  143.      "At compile time, also need EXPORTS.ALL for records such as TITLEDICON.")
  144.         (DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE (FILES TABLEBROWSERDECLS
  145.                                                               ))
  146.                                                (* ; "Auxillary modules")
  147.         (FILES IMAP2 SMTP MMICONS)))
  148.  
  149.  
  150.  
  151. (* ; "MM-D Electronic Mailsystem  -- Mark Crispin")
  152.  
  153.  
  154.  
  155.  
  156. (* ; "Primary mail menu setup")
  157.  
  158. (DEFINEQ
  159.  
  160. (MM
  161.   [LAMBDA (MAILBOX POSITION)                             (* ; "Edited 26-May-88 11:18 by cdl")
  162.                                                              (* ; 
  163.                                                       "Puts up a new primary mail menu at POSITION")
  164.     (LET (POSITIONS ICONWINDOW)
  165.          (if MM.WINDOW
  166.              then [if MM.REMEMBER.POSITIONS
  167.                           then (SETQ POSITIONS (WINDOWPROP MM.WINDOW 'MM.POSITIONS))
  168.                                 (if (NULL POSITION)
  169.                                     then (SETQ POSITION (with REGION (WINDOWPROP MM.WINDOW
  170.                                                                                     'REGION)
  171.                                                                    (CREATEPOSITION LEFT BOTTOM]
  172.                    (SETQ ICONWINDOW (WINDOWPROP MM.WINDOW 'ICONWINDOW))
  173.                    (CLOSEW MM.WINDOW))
  174.          [if (NULL MM.MAILBOXES)
  175.              then (MM.SERVICEHOST)                   (* ; "Make sure at least one there")
  176.                    (for host inside MM.SERVICEHOSTS do (pushnew MM.MAILBOXES
  177.                                                                           (PACKFILENAME 'HOST host
  178.                                                                                  'NAME
  179.                                                                                  'INBOX]
  180.          (if MAILBOX
  181.              then (pushnew MM.MAILBOXES MAILBOX))
  182.          (SETQ MM.WINDOW (MENUWINDOW (create
  183.                                       MENU
  184.                                       TITLE _ "MM Mailboxes"
  185.                                       ITEMS _ [for ITEM in MM.MAILBOXES
  186.                                                  collect
  187.                                                  `(,ITEM (OPEN ,ITEM)
  188.                                                          "Open this mailbox"
  189.                                                          (SUBITEMS ("Remove From Menu"
  190.                                                                     (REMOVE ,ITEM)
  191.                                                                     "Remove this mailbox from menu"]
  192.                                       WHENSELECTEDFN _ (FUNCTION MM.PRIMARYMAILMENU))
  193.                                 T))
  194.          (ATTACHMENU [create MENU
  195.                             TITLE _ "Primary Mail Menu"
  196.                             MENUCOLUMNS _ 1
  197.                             ITEMS _ '(("Compose Message" (MM.COMPOSEMESSAGE)
  198.                                              "Compose a new message")
  199.                                       ("Open New Mailbox" (MM.ADDNEWMAILBOX)
  200.                                              "Select a new mailbox not listed in the mailboxes menu"
  201.                                              (SUBITEMS ("Search For Mailboxes" (
  202.                                                                               MM.SEARCHFORMAILBOXES
  203.                                                                                 )
  204.                                                               
  205.                                                         "Search for mailbox names based on a pattern"
  206.                                                               ]
  207.                 MM.WINDOW
  208.                 'TOP)
  209.          (WINDOWPROP MM.WINDOW 'ICON (OR ICONWINDOW MM.ZMAILICON))
  210.          (WINDOWPROP MM.WINDOW 'MM.POSITIONS POSITIONS)
  211.          [MOVEW MM.WINDOW (OR POSITION (with POSITION (MINATTACHEDWINDOWEXTENT MM.WINDOW)
  212.                                               (GETBOXPOSITION XCOORD YCOORD NIL NIL NIL 
  213.                                                      "Specify the position of the primary mail menu"]
  214.          (OPENW MM.WINDOW])
  215.  
  216. (MM.PRIMARYMAILMENU
  217.   [LAMBDA (MAILBOX MENU KEY)                             (* ; "Edited 29-Mar-88 15:05 by cdl")
  218.                                                              (* ; 
  219.                                           "Reacts to clicking a selection in the primary mail menu")
  220.     (if MAILBOX
  221.         then (LET (OPERATION ITEM)
  222.                       (if (LISTP MAILBOX)
  223.                           then (SETQ ITEM (CADR MAILBOX))
  224.                                 (SETQ OPERATION (CAR ITEM))
  225.                                 (SETQ MAILBOX (CADR ITEM)))
  226.                       (SELECTQ KEY
  227.                           (MIDDLE (BKSYSBUF MAILBOX T))
  228.                           (SELECTQ OPERATION
  229.                               (REMOVE (SETQ MM.MAILBOXES (DREMOVE MAILBOX MM.MAILBOXES))
  230.                                       (with REGION (WINDOWPROP MM.WINDOW 'REGION)
  231.                                              (MM NIL (CREATEPOSITION LEFT BOTTOM))))
  232.                               (PROGN (ALLOW.BUTTON.EVENTS)
  233.                                      (if (AND (MM.CREATEMAILBOXWINDOW MAILBOX (MAP.OPEN
  234.                                                                                        MAILBOX))
  235.                                                   (NOT (MEMB MAILBOX MM.MAILBOXES)))
  236.                                          then (with REGION (WINDOWPROP MM.WINDOW 'REGION)
  237.                                                          (MM MAILBOX (CREATEPOSITION LEFT BOTTOM])
  238.  
  239. (MM.ADDNEWMAILBOX
  240.   [LAMBDA NIL                                            (* ; "Edited 29-Mar-88 14:46 by cdl")
  241.                                                              (* ; 
  242.                                                        "Add a new mailbox to the Primary Mail Menu")
  243.     (LET (MAILBOX)
  244.          (printout PROMPTWINDOW T)
  245.          (if (SETQ MAILBOX (PROMPTFORWORD "New mailbox name:" NIL NIL PROMPTWINDOW NIL
  246.                                       'TTY))
  247.              then (MM.PRIMARYMAILMENU (PACKFILENAME 'BODY MAILBOX 'NAME 'INBOX 'HOST
  248.                                                      (FILENAMEFIELD (DIRECTORYNAME T)
  249.                                                             'HOST])
  250.  
  251. (MM.SEARCHFORMAILBOXES
  252.   [LAMBDA NIL                                            (* ; "Edited 29-Apr-88 16:02 by MRC")
  253.                                                              (* ; 
  254.                                          "Search for a new mailbox to add to the Primary Mail Menu")
  255.     (LET (PATTERN FILES)
  256.          (printout PROMPTWINDOW T)
  257.          (if (SETQ PATTERN (PROMPTFORWORD "Mailbox pattern:" MM.DEFAULT.SEARCH.PATTERN NIL 
  258.                                       PROMPTWINDOW NIL 'TTY))
  259.              then (if (SETQ FILES (DIRECTORY PATTERN))
  260.                           then (for FILE in (DREVERSE FILES)
  261.                                       do (pushnew MM.MAILBOXES (PACKFILENAME 'DEVICE NIL
  262.                                                                               'VERSION NIL
  263.                                                                               'BODY FILE)))
  264.                                 (with REGION (WINDOWPROP MM.WINDOW 'REGION)
  265.                                        (MM NIL (CREATEPOSITION LEFT BOTTOM)))
  266.                         else (printout PROMPTWINDOW T "No files matching pattern" %,
  267.                                         (PACKFILENAME 'BODY PATTERN 'DIRECTORY (DIRECTORYNAME T))
  268.                                         %, "found."])
  269. )
  270.  
  271.  
  272.  
  273. (* ; "Message selection menu setup")
  274.  
  275. (DEFINEQ
  276.  
  277. (MM.CREATEMAILBOXWINDOW
  278.   [LAMBDA (MAILBOX STREAM)                               (* ; "Edited 28-Apr-88 14:53 by cdl")
  279.                                                              (* ; 
  280.                                          "Create a message selection menu for the selected mailbox")
  281.     (if STREAM
  282.         then (LET ((RECENT (GETSTREAMPROP STREAM 'RECENT))
  283.                        (CHOPOFFPREVENTIONFUZZ 2)
  284.                        NDISPLAYEDMESSAGES REGION POSITION WINDOW)
  285.                       [with REGION
  286.                              [SETQ REGION
  287.                               (CREATEREGION NIL NIL (WIDTHIFWINDOW (PLUS (TIMES 
  288.                                                                            MM.MAXIMUMHEADERLINELENGTH
  289.                                                                                 (CHARWIDTH
  290.                                                                                  (CHARCODE A)
  291.                                                                                  
  292.                                                                                MM.PRIMARYMAILMENUFONT
  293.                                                                                  ))
  294.                                                                          TB.LEFT.MARGIN))
  295.                                      (PLUS CHOPOFFPREVENTIONFUZZ
  296.                                            (HEIGHTIFWINDOW (TIMES (SETQ NDISPLAYEDMESSAGES
  297.                                                                    (IMIN MM.MAXIMUMDISPLAYEDMESSAGES
  298.                                                                          (if RECENT
  299.                                                                              then (IMAX 
  300.                                                                           MM.MINIMUMDISPLAYEDMESSAGES
  301.                                                                                             RECENT)
  302.                                                                            else 
  303.                                                                           MM.MINIMUMDISPLAYEDMESSAGES
  304.                                                                                 )))
  305.                                                                   (FONTHEIGHT MM.PRIMARYMAILMENUFONT)
  306.                                                                   )
  307.                                                   T]
  308.                              (if [AND MM.REMEMBER.POSITIONS (SETQ POSITION
  309.                                                                  (ASSOC 'BROWSER (WINDOWPROP
  310.                                                                                   MM.WINDOW
  311.                                                                                   'MM.POSITIONS]
  312.                                  then (WINDOWDELPROP MM.WINDOW 'MM.POSITIONS POSITION)
  313.                                        (with POSITION (CDR POSITION)
  314.                                               (SETQ LEFT XCOORD)
  315.                                               (SETQ BOTTOM YCOORD))
  316.                                else (SETQ REGION (GETBOXREGION WIDTH HEIGHT NIL NIL NIL 
  317.                                                      "Specify position of the message selection menu"
  318.                                                             ]
  319.                       [SETQ WINDOW (CREATEW REGION (MM.MAILBOXWINDOWTITLE MAILBOX
  320.                                                           (GETSTREAMPROP STREAM 'NMSGS]
  321.                       (WINDOWPROP WINDOW 'CLOSEFN (FUNCTION MM.CLOSEMAILBOXWINDOW))
  322.                       (WINDOWPROP WINDOW 'ICON MM.MAILBOXICON)
  323.                       (WINDOWPROP WINDOW 'ICONFN (FUNCTION MM.ICONFN))
  324.                       (MM.MAILBOXWINDOW WINDOW STREAM MAILBOX NDISPLAYEDMESSAGES)
  325.                       (MM.ADDNEWMESSAGES WINDOW)
  326.                       WINDOW])
  327.  
  328. (MM.MAILBOXWINDOW
  329.   [LAMBDA (WINDOW STREAM MAILBOX NDISPLAYEDMESSAGES)
  330.                                          (* ; "Edited 15-Jun-88 15:35 by MRC")
  331.                                                (* ; 
  332.                                              "Stuff a window with a mailbox")
  333.     (LET ((NMSGS (GETSTREAMPROP STREAM 'NMSGS))
  334.           (FLAGLST (GETSTREAMPROP STREAM 'FLAGLST))
  335.           MESSAGEARRAY)
  336.          (PUTSTREAMPROP STREAM 'TWINDOW WINDOW)
  337.          (PUTSTREAMPROP STREAM 'MESSAGEARRAY (SETQ MESSAGEARRAY
  338.                                               (CL:MAKE-ARRAY NMSGS
  339.                                                      ':ADJUSTABLE T)))
  340.          (WINDOWPROP WINDOW 'TITLE (MM.MAILBOXWINDOWTITLE MAILBOX NMSGS))
  341.          (WINDOWPROP WINDOW 'TSTREAM STREAM)
  342.          (WINDOWPROP WINDOW 'MAILBOXNAME MAILBOX)
  343.          (WINDOWPROP WINDOW 'FLAGLST FLAGLST)
  344.          (WINDOWPROP WINDOW 'FLAGMENU (MM.FLAGMENU FLAGLST))
  345.          (WINDOWPROP WINDOW 'MESSAGEARRAY MESSAGEARRAY)
  346.          (WINDOWPROP WINDOW 'NMSGS NMSGS)
  347.          (MM.CREATEMAILBOXTB WINDOW MM.PRIMARYMAILMENUFONT STREAM NMSGS 
  348.                 MESSAGEARRAY NDISPLAYEDMESSAGES)
  349.          (ATTACHMENU (create MENU
  350.                             ITEMS _ (MM.MAILBOXMENUITEMS WINDOW)
  351.                             TITLE _ "Messages"
  352.                             WHENSELECTEDFN _ (FUNCTION MM.MAILBOXMENU)
  353.                             MENUOUTLINESIZE _ 1)
  354.                 WINDOW
  355.                 'RIGHT
  356.                 'TOP)
  357.          (ATTACHMENU (create MENU
  358.                             ITEMS _ (MM.COMMANDMENUITEMS WINDOW)
  359.                             MENUROWS _ 1
  360.                             CENTERFLG _ T)
  361.                 WINDOW
  362.                 'BOTTOM])
  363.  
  364. (MM.FLAGMENU
  365.   [LAMBDA (FLAGLST)                                      (* ; "Edited 28-Mar-88 08:15 by cdl")
  366.                                                              (* ; "Return a flagmenu")
  367.     (LET ((FLAGITEMS (for FLAG in FLAGLST unless (FMEMB FLAG MM.SYSTEM.FLAGS)
  368.                         collect FLAG)))
  369.          (if FLAGITEMS
  370.              then (create MENU
  371.                              ITEMS _ FLAGITEMS
  372.                              TITLE _ "Keywords"])
  373.  
  374. (MM.MAILBOXWINDOWTITLE
  375.   [LAMBDA (NAME NMSGS)                                   (* ; "Edited  6-Jul-87 15:30 by MRC")
  376.                                                              (* ; 
  377.                                                       "Make a title for a message selection window")
  378.     (CONCAT NAME " Message Selection Menu of " NMSGS " Messages"])
  379.  
  380. (MM.CREATEMAILBOXTB
  381.   [LAMBDA (WINDOW BFONT STREAM NMSGS MESSAGEARRAY NDISPLAYEDMSGS)
  382.                                          (* ; "Edited  7-Jun-88 13:00 by MRC")
  383.                                                (* ; 
  384.           "Create TableBrowser for given messagearray and number of messages")
  385.     (LET ([BROWSER (TB.MAKE.BROWSER NIL WINDOW
  386.                           `(FONT %, BFONT COLUMNS 5 PRINTFN MM.TBPRINTFN]
  387.           [FIRSTVISIBLEITEM (ADD1 (DIFFERENCE NMSGS (IMIN NMSGS NDISPLAYEDMSGS]
  388.           TABLEITEM)
  389.          (WINDOWPROP WINDOW 'SHOW NIL)         (* ; 
  390.                                             "Tell MM.TBPRINTFN to do nothing")
  391.          [if (GREATERP FIRSTVISIBLEITEM 1)
  392.              then [for MSGNO from 1
  393.                          to (SUB1 FIRSTVISIBLEITEM)
  394.                          do (TB.INSERT.ITEM BROWSER
  395.                                        (SETQ TABLEITEM
  396.                                         (MM.TABLEITEM STREAM MESSAGEARRAY 
  397.                                                MSGNO]
  398.                    (with REGION (DSPCLIPPINGREGION NIL WINDOW)
  399.                           (SCROLLBYREPAINTFN WINDOW 0
  400.                                  (PLUS BOTTOM HEIGHT
  401.                                        (MINUS (MM.YCOORD.FROM.ITEM BROWSER
  402.                                                      TABLEITEM]
  403.          (WINDOWPROP WINDOW 'SHOW T)
  404.          (for MSGNO from FIRSTVISIBLEITEM to NMSGS
  405.             do (TB.INSERT.ITEM BROWSER (MM.TABLEITEM STREAM 
  406.                                                   MESSAGEARRAY MSGNO)))
  407.          (MM.SELECT WINDOW 'NEW)           (* ; 
  408.                                              "Auto-select new messages")
  409.          BROWSER])
  410.  
  411. (MM.MAILBOXMENU
  412.   [LAMBDA (ITEM MENU BUTTON)                             (* ; "Edited  6-Apr-88 17:41 by MRC")
  413.                                                              (* ; 
  414.                                                   "Reacts to selecting a primary mailbox menu item")
  415.     (LET ((WINDOW (MAINWINDOW (WFROMMENU MENU)))
  416.           STREAM SEQUENCE)
  417.          (DECLARE (SPECVARS SEQUENCE))
  418.          (if (AND (SETQ STREAM (WINDOWPROP WINDOW 'TSTREAM))
  419.                       (MM.LOCK STREAM))
  420.              then (ALLOW.BUTTON.EVENTS)
  421.                    (if (EQLENGTH (SETQ SEQUENCE (for NEXTITEM
  422.                                                        in (TB.COLLECT.ITEMS (WINDOWPROP
  423.                                                                                  WINDOW
  424.                                                                                  'TABLEBROWSER))
  425.                                                        collect (MM.TBPROP NEXTITEM
  426.                                                                           'MSGNO)
  427.                                                        when (fetch (TABLEITEM TISELECTED)
  428.                                                                    of NEXTITEM)))
  429.                                   1)
  430.                        then (SETQ SEQUENCE (CAR SEQUENCE)))
  431.                    (ERRORSET (CADR ITEM))
  432.                    (MM.ADDNEWMESSAGES WINDOW)
  433.                    (MM.UNLOCK STREAM])
  434.  
  435. (MM.COMMANDMENUITEMS
  436.   [LAMBDA (WINDOW)                                       (* ; "Edited 25-Apr-88 11:25 by cdl")
  437.                                                              (* ; "Return a command menu")
  438.     `((Quit (MM.QUIT ,WINDOW)
  439.             "Quits out of this mailbox")
  440.       (Exit (MM.EXIT ,WINDOW)
  441.             "Expunges mailbox then quits")
  442.       ("New Mailbox" (MM.NEWMAILBOX ,WINDOW)
  443.              "Get a new mailbox")
  444.       (Compose (MM.COMPOSEMESSAGE)
  445.              "Compose a new message")
  446.       (Zoom (MM.TOGGLE.SELECTED ,WINDOW)
  447.             "Toggle between showing only selected messages and showing all messages")
  448.       (Expunge (MM.EXPUNGEMAILBOX ,WINDOW)
  449.              "Expunges (erases) deleted messages from the mailbox")
  450.       (Check (MM.CHECKMAILBOX ,WINDOW)
  451.              "Checks mailbox to see if there are any new messages"
  452.              (SUBITEMS ("Check New Messages" (MM.CHECKMAILBOX ,WINDOW)
  453.                               "Checks mailbox to see if there are any new messages")
  454.                     ("Check Entire Mailbox" (MM.CHECKENTIREMAILBOX ,WINDOW)
  455.                            "Re-checks the entire mailbox to see if any flags, etc. have changed"])
  456.  
  457. (MM.MAILBOXMENUITEMS
  458.   [LAMBDA (WINDOW)                                       (* ; "Edited 28-Mar-88 08:56 by cdl")
  459.                                                              (* ; "Return a primary menu")
  460.     `((Read (MM.READMESSAGE ,WINDOW SEQUENCE)
  461.             "Reads the selected messages")
  462.       [Select (MM.SELECTMESSAGES ,WINDOW)
  463.              "Select a set of messages by a particular characteristic"
  464.              (SUBITEMS ,@(MM.SELECTMENUITEMS WINDOW]
  465.       (Answer (MM.REPLY ,WINDOW SEQUENCE)
  466.              "Compose a reply (to the sender only) to each of the selected messages"
  467.              (SUBITEMS ("Answer to Sender only" (MM.REPLY ,WINDOW SEQUENCE)
  468.                               
  469.                       "Send answer only to the sender or reply address of the message being answered"
  470.                               )
  471.                     ("Answer to All" (MM.REPLY ,WINDOW SEQUENCE T)
  472.                            
  473.                   "Send answer to the reply address and all recipients of the message being answered"
  474.                            )))
  475.       (File (MM.DOSEQUENCE ,WINDOW SEQUENCE 'MAP.COPYMESSAGE (MM.PROMPTFORMAILBOX
  476.                                                                   ,WINDOW))
  477.             "Copy the selected messages into another mailbox"
  478.             (SUBITEMS (Copy (MM.DOSEQUENCE ,WINDOW SEQUENCE 'MAP.COPYMESSAGE (
  479.                                                                                 MM.PROMPTFORMAILBOX
  480.                                                                                   ,WINDOW))
  481.                             "Copy the selected messages into another mailbox")
  482.                    (Move (MM.DOSEQUENCE ,WINDOW SEQUENCE 'MAP.MOVEMESSAGE (MM.PROMPTFORMAILBOX
  483.                                                                                ,WINDOW))
  484.                          
  485.                       "Move selected messages into another mailbox and delete them from this mailbox"
  486.                          )))
  487.       (Hardcopy (MM.HARDCOPY ,WINDOW SEQUENCE)
  488.              "Send the selected messages to the default printer")
  489.       [Keyword [MM.DOSEQUENCE ,WINDOW SEQUENCE 'MAP.SETFLAG (MM.MENU (WINDOWPROP ,WINDOW
  490.                                                                                     'FLAGMENU]
  491.              "Set a keyword in the selected messages"
  492.              (SUBITEMS [Set [MM.DOSEQUENCE ,WINDOW SEQUENCE 'MAP.SETFLAG
  493.                                    (MM.MENU (WINDOWPROP ,WINDOW 'FLAGMENU]
  494.                             "Set a keyword in the selected messages"
  495.                             ,(MM.FLAGMENUITEMS WINDOW 'MM.DOSEQUENCE ''MAP.SETFLAG]
  496.                     (Clear [MM.DOSEQUENCE ,WINDOW SEQUENCE 'MAP.CLEARFLAG
  497.                                   (MM.MENU (WINDOWPROP ,WINDOW 'FLAGMENU]
  498.                            "Clear a keyword in the selected messages"
  499.                            ,(MM.FLAGMENUITEMS WINDOW 'MM.DOSEQUENCE ''MAP.CLEARFLAG]
  500.       (Flag (MM.DOSEQUENCE ,WINDOW SEQUENCE 'MAP.SETFLAG '\Flagged)
  501.             "Flag the selected messages as requiring special attention"
  502.             (SUBITEMS (Unflag (MM.DOSEQUENCE ,WINDOW SEQUENCE 'MAP.CLEARFLAG '\Flagged)
  503.                              "Clear the flagged status of the selected messages")))
  504.       (Delete (MM.DOSEQUENCE ,WINDOW SEQUENCE 'MAP.SETFLAG '\Deleted)
  505.              "Mark the selected messages for deletion"
  506.              (SUBITEMS (Undelete (MM.DOSEQUENCE ,WINDOW SEQUENCE 'MAP.CLEARFLAG '\Deleted)
  507.                               "Clear the deleted status of the selected messages"])
  508.  
  509. (MM.TBPRINTFN
  510.   [LAMBDA (BROWSER ITEM WINDOW)                          (* ; "Edited 26-May-88 10:28 by cdl")
  511.                                                              (* ; 
  512.                                                            "Display headerline for selected item")
  513.     (if (WINDOWPROP WINDOW 'SHOW)
  514.         then (LET ((STREAM (MM.TBPROP ITEM 'STREAM))
  515.                        (MESSAGEARRAY (MM.TBPROP ITEM 'MESSAGEARRAY))
  516.                        (MSGNO (MM.TBPROP ITEM 'MSGNO))
  517.                        (DELETED (fetch (TABLEITEM TIDELETED) of ITEM))
  518.                        MSGFLAGS FONT)
  519.                       (if (MAP.LOCKED? STREAM)
  520.                           then                           (* ; "The stream is locked, so note that it has to be done later -- save ITEM not MSGNO since that may change ")
  521.                                 (UNINTERRUPTABLY
  522.                                     (WINDOWADDPROP WINDOW 'REDISPLAYMSGS ITEM))
  523.                                 (SPACES MM.MAXIMUMHEADERLINELENGTH WINDOW)
  524.                         else (SETQ MSGFLAGS (fetch (MM.CACHE Flags) of (MAP.ELT 
  525.                                                                                          MESSAGEARRAY
  526.                                                                                           MSGNO)))
  527.                               (SETQ FONT (if (MEMB '\Flagged MSGFLAGS)
  528.                                              then (FONTCOPY MM.PRIMARYMAILMENUFONT 'WEIGHT
  529.                                                              'BOLD)
  530.                                            else MM.PRIMARYMAILMENUFONT))
  531.                               (RESETLST
  532.                                   [RESETSAVE NIL `(DSPFONT ,(DSPFONT FONT WINDOW)
  533.                                                          ,WINDOW]
  534.                                   (MM.HEADERLINE STREAM MESSAGEARRAY MSGNO WINDOW))
  535.                               (if (MEMB '\Deleted MSGFLAGS)
  536.                                   then (if (NOT DELETED)
  537.                                                then (TB.DELETE.ITEM BROWSER ITEM))
  538.                                 else (if DELETED
  539.                                              then (TB.UNDELETE.ITEM BROWSER ITEM])
  540.  
  541. (MM.TABLEITEM
  542.   [LAMBDA (STREAM MESSAGEARRAY MSGNO SELECTED)           (* ; "Edited 23-Mar-88 11:45 by cdl")
  543.                                                              (* ; "Create a message tableitem")
  544.     (create TABLEITEM
  545.            TI# _ 1
  546.            TISELECTED _ SELECTED
  547.            TIDATA _ `(STREAM ,STREAM MESSAGEARRAY ,MESSAGEARRAY MSGNO ,MSGNO])
  548.  
  549. (MM.UPDATE
  550.   [LAMBDA (WINDOW MSGNO)                                 (* ; "Edited 29-Apr-88 16:06 by MRC")
  551.                                                              (* ; 
  552.                                                    "Updates Primary Mail Menu with new information")
  553.     (LET ((BROWSER (WINDOWPROP WINDOW 'TABLEBROWSER))
  554.           ITEM)
  555.          (if BROWSER
  556.              then (SETQ ITEM (MM.FIND.TABLEITEM BROWSER MSGNO))
  557.                    (TB.REDISPLAY.ITEMS BROWSER ITEM ITEM])
  558.  
  559. (MM.TBPROP
  560.   [LAMBDA (TBITEM PROP)                                  (* ; "Edited  6-Jul-87 15:32 by MRC")
  561.                                                              (* ; 
  562.                                       "Returns a property to the table browser item's TIDATA field")
  563.     (LISTGET (fetch (TABLEITEM TIDATA) of TBITEM)
  564.            PROP])
  565.  
  566. (MM.HEADERLINE
  567.   [LAMBDA (STREAM MESSAGEARRAY MSGNO WINDOW)             (* ; "Edited 20-May-88 12:49 by MRC")
  568.                                                              (* ; 
  569.                         "Writes a menu header line in window for message MSGNO in the messagearray")
  570.     (LET ((STRING (ALLOCSTRING MM.MAXIMUMHEADERLINELENGTH (CHARCODE SPACE)))
  571.           HEADER FLAGLST SUBJECTSTRING FLAGLENGTH)
  572.          (if (MAP.FETCHENVELOPE STREAM MESSAGEARRAY MSGNO)
  573.              then (with MM.CACHE (MAP.ELT MESSAGEARRAY MSGNO)
  574.                              (printout (SETQ HEADER (OPENSTRINGSTREAM STRING 'OUTPUT))
  575.                                     (if (MEMB '\Recent (SETQ FLAGLST (APPEND Flags)))
  576.                                         then (SETQ FLAGLST (DREMOVE '\Recent FLAGLST))
  577.                                               (if (MEMB '\Seen FLAGLST)
  578.                                                   then (SETQ FLAGLST (DREMOVE '\Seen FLAGLST))
  579.                                                         "R "
  580.                                                 else "N ")
  581.                                       else (if (MEMB '\Seen FLAGLST)
  582.                                                    then (SETQ FLAGLST (DREMOVE '\Seen FLAGLST))
  583.                                                          "  "
  584.                                                  else " U"))
  585.                                     (if (MEMB '\Flagged FLAGLST)
  586.                                         then (SETQ FLAGLST (DREMOVE '\Flagged FLAGLST))
  587.                                               "F"
  588.                                       else " ")
  589.                                     (if (MEMB '\Answered FLAGLST)
  590.                                         then (SETQ FLAGLST (DREMOVE '\Answered FLAGLST))
  591.                                               "A"
  592.                                       else " ")
  593.                                     (if (MEMB '\Deleted FLAGLST)
  594.                                         then (SETQ FLAGLST (DREMOVE '\Deleted FLAGLST))
  595.                                               "D"
  596.                                       else " ")
  597.                                     %,
  598.                                     (SUBSTRING InternalDate 1 6)
  599.                                     %,
  600.                                     (OR FromText (MAP.FETCHFROMSTRING STREAM MESSAGEARRAY MSGNO 
  601.                                                         MM.MAXFROMLENGTH))
  602.                                     %,)
  603.                              (SETQ SUBJECTSTRING (OR SubjectText (MAP.FETCHSUBJECT STREAM 
  604.                                                                         MESSAGEARRAY MSGNO 
  605.                                                                         MM.MAXSUBJECTLENGTH)))
  606.                              [if FLAGLST
  607.                                  then (printout HEADER "{" [SUBSTRING (SETQ FLAGLST (MKSTRING
  608.                                                                                          FLAGLST))
  609.                                                                       2
  610.                                                                       (SUB1 (SETQ FLAGLENGTH
  611.                                                                              (NCHARS FLAGLST]
  612.                                                  "} ")
  613.                                        (if (GREATERP (PLUS (NCHARS SUBJECTSTRING)
  614.                                                                (add FLAGLENGTH 1))
  615.                                                       MM.MAXSUBJECTLENGTH)
  616.                                            then (SETQ SUBJECTSTRING (SUBSTRING SUBJECTSTRING 1
  617.                                                                                (DIFFERENCE 
  618.                                                                                   MM.MAXSUBJECTLENGTH
  619.                                                                                       FLAGLENGTH]
  620.                              (printout HEADER SUBJECTSTRING " (" RFC822.Size " chars)")))
  621.          (if WINDOW
  622.              then (printout WINDOW STRING))              (* ; 
  623.          "Trim trailing spaces, not strictly necessary but gets around bug in TITLEDICONW later on")
  624.          (while (EQ (CHARCODE SPACE)
  625.                         (NTHCHARCODE STRING -1)) do (GLC STRING))
  626.          STRING])
  627.  
  628. (MM.CLOSEMAILBOXWINDOW
  629.   [LAMBDA (WINDOW)                                       (* ; "Edited 28-Apr-88 14:53 by cdl")
  630.                                                              (* ; 
  631.                                                       "React to closing the message selection menu")
  632.     (PROG ((STREAM (WINDOWPROP WINDOW 'TSTREAM NIL)))
  633.           (if STREAM
  634.               then (if (MM.LOCK STREAM)
  635.                            then (MM.UNLOCK STREAM)
  636.                          else (RETURN 'DON'T))
  637.                     (MAP.CLOSE STREAM)
  638.                     (PUTSTREAMPROP STREAM 'TWINDOW NIL))
  639.           (for WINDOW in (ATTACHEDWINDOWS WINDOW)
  640.              do                                          (* ; 
  641.                                               "Since menu items have pointers to window in them...")
  642.                    (for MENU in (WINDOWPROP WINDOW 'MENU) do (DELETEMENU MENU NIL WINDOW)
  643.                           ))
  644.           (WINDOWPROP WINDOW 'FLAGLST NIL)
  645.           (WINDOWPROP WINDOW 'MESSAGEARRAY NIL)
  646.           (WINDOWPROP WINDOW 'FLAGMENU NIL)
  647.           (WINDOWPROP WINDOW 'ZOOMDATA NIL)
  648.           (if MM.REMEMBER.POSITIONS
  649.               then (WINDOWADDPROP MM.WINDOW 'MM.POSITIONS (CONS 'BROWSER
  650.                                                                     (with REGION
  651.                                                                            (WINDOWPROP WINDOW
  652.                                                                                   'REGION)
  653.                                                                            (CREATEPOSITION LEFT 
  654.                                                                                   BOTTOM])
  655.  
  656. (MM.FIND.TABLEITEM
  657.   [LAMBDA (BROWSER MSGNO)                                (* ; "Edited 29-Apr-88 16:07 by MRC")
  658.     (DECLARE (SPECVARS MSGNO))                           (* ; 
  659.                                                            "Replaces TB.NTH.ITEM when zooming")
  660.     (TB.FIND.ITEM BROWSER (FUNCTION (LAMBDA (BROWSER ITEM)
  661.                                       (DECLARE (USEDFREE MSGNO))
  662.                                       (EQUAL MSGNO (MM.TBPROP ITEM 'MSGNO])
  663. )
  664.  
  665.  
  666.  
  667. (* ; "Primary mail menu functions")
  668.  
  669. (DEFINEQ
  670.  
  671. (MM.NEWMAILBOX
  672.   [LAMBDA (WINDOW)                   (* ; "Edited 15-Jun-88 15:37 by MRC")
  673.                                                (* ; "Get a new mailbox")
  674.     (LET ((STREAM (WINDOWPROP WINDOW 'TSTREAM))
  675.           MAILBOX RECENT)
  676.          (if (AND (MM.LOCK STREAM)
  677.                       (SETQ MAILBOX (MM.MAILBOX)))
  678.              then (DETACHALLWINDOWS WINDOW)
  679.                    (WINDOWDELPROP WINDOW 'CLOSEFN 'TB.CLOSEFN)
  680.                    (MM.UNLOCK STREAM)      (* ; 
  681.          "MAP.OPEN may make a new stream, so we can't count use locking here")
  682.                    (until (SETQ STREAM (MAP.OPEN MAILBOX STREAM))
  683.                       do (SETQ MAILBOX (MM.MAILBOX)))
  684.                    (MM.LOCK STREAM)
  685.                    (MM.MAILBOXWINDOW
  686.                     WINDOW STREAM MAILBOX
  687.                     (IMIN MM.MAXIMUMDISPLAYEDMESSAGES
  688.                           (if (SETQ RECENT (GETSTREAMPROP STREAM
  689.                                                       'RECENT))
  690.                               then (IMAX MM.MINIMUMDISPLAYEDMESSAGES RECENT
  691.                                              )
  692.                             else MM.MINIMUMDISPLAYEDMESSAGES)))
  693.                    (MM.ADDNEWMESSAGES WINDOW)
  694.                    (MM.UNLOCK STREAM)
  695.            else (MM.UNLOCK STREAM])
  696.  
  697. (MM.SELECTMESSAGES
  698.   [LAMBDA (WINDOW)                                       (* ; "Edited 28-Mar-88 18:34 by cdl")
  699.                                                              (* ; 
  700.                                                 "Prompt for selection criteria and select messages")
  701.     (LET (ITEM SELECTMENU SELECTION)
  702.          (if (WINDOWPROP WINDOW 'SELECTMENUWINDOW)
  703.              then (printout (GETPROMPTWINDOW WINDOW)
  704.                              T "Selection already in progress")
  705.            else [SETQ SELECTMENU (OR (WINDOWPROP WINDOW 'SELECTMENU)
  706.                                          (create MENU
  707.                                                 TITLE _ "Selection Menu"
  708.                                                 ITEMS _ (APPEND (MM.SELECTMENUITEMS WINDOW T)
  709.                                                                `(("Do Selection" (MM.DOSELECTION
  710.                                                                                   ,WINDOW)
  711.                                                                         "Do the selection now"]
  712.                  (WINDOWPROP WINDOW 'SELECTMENU SELECTMENU)
  713.                  (WINDOWPROP WINDOW 'SELECTMENUWINDOW (ADDMENU SELECTMENU))
  714.                  (WINDOWPROP WINDOW 'SELECTION NIL])
  715.  
  716. (MM.DOSELECTION
  717.   [LAMBDA (WINDOW)                                       (* ; "Edited 29-Mar-88 18:16 by cdl")
  718.                                                              (* ; "Do accumulated selection")
  719.     (bind (BROWSER _ (WINDOWPROP WINDOW 'TABLEBROWSER))
  720.            ITEM while (SETQ ITEM (TB.FIND.SELECTED.ITEM BROWSER))
  721.        do (TB.DESELECTRANGE BROWSER ITEM ITEM)
  722.              (TB.SHOW.SELECTION BROWSER ITEM 'ERASE))
  723.     (DELETEMENU (WINDOWPROP WINDOW 'SELECTMENU)
  724.            T
  725.            (WINDOWPROP WINDOW 'SELECTMENUWINDOW NIL))
  726.     (MAP.SELECT (WINDOWPROP WINDOW 'TSTREAM)
  727.            (WINDOWPROP WINDOW 'SELECTION])
  728.  
  729. (MM.SELECTMENUITEMS
  730.   [LAMBDA (WINDOW FLG)                                   (* ; "Edited 19-Apr-88 17:28 by MRC")
  731.                                                              (* ; "Return a selection menu")
  732.     (LET ([ITEMS `((Text (MM.SELECT ,WINDOW 'TEXT ,FLG)
  733.                          "Select messages which contain the specified text"
  734.                          (SUBITEMS ("Entire message" (MM.SELECT ,WINDOW 'TEXT ,FLG)
  735.                                           
  736.                      "Select messages which contain the specified text in the message header or body"
  737.                                           )
  738.                                 ("Message body only" (MM.SELECT ,WINDOW 'BODY ,FLG)
  739.                                        
  740.                                "Select messages which contain the specified text in the message body"
  741.                                        )))
  742.                    (Subject (MM.SELECT ,WINDOW 'SUBJECT ,FLG)
  743.                           "Select messages which contain the specified text in the subject")
  744.                    (From (MM.SELECT ,WINDOW 'FROM ,FLG)
  745.                          "Select messages which contain the specified From address")
  746.                    (To (MM.SELECT ,WINDOW 'TO ,FLG)
  747.                        "Select messages which contain the specified To address"
  748.                        (SUBITEMS (To (MM.SELECT ,WINDOW 'TO ,FLG)
  749.                                      "Select messages which contain the specified To address")
  750.                               (cc (MM.SELECT ,WINDOW 'CC ,FLG)
  751.                                   "Select messages which contain the specified cc address")
  752.                               (bcc (MM.SELECT ,WINDOW 'BCC ,FLG)
  753.                                    "Select messages which contain the specified bcc address")))
  754.                    (New (MM.SELECT ,WINDOW 'NEW ,FLG)
  755.                         "Select messages which are RECENT and UNSEEN")
  756.                    (Recent (MM.SELECT ,WINDOW 'RECENT ,FLG)
  757.                           "Select messages which arrived since the last time you read your mail")
  758.                    (Old (MM.SELECT ,WINDOW 'OLD ,FLG)
  759.                         "Select messages which had already arrived the last time you read your mail")
  760.                    (Date (MM.SELECT ,WINDOW 'ON ,FLG)
  761.                          "Select messages which arrived on a particular date"
  762.                          (SUBITEMS ("On Date" (MM.SELECT ,WINDOW 'ON ,FLG)
  763.                                           "Select messages which arrived on a particular date")
  764.                                 ("Before Date" (MM.SELECT ,WINDOW 'BEFORE ,FLG)
  765.                                        "Select messages which arrived before a particular date")
  766.                                 ("Since Date" (MM.SELECT ,WINDOW 'SINCE ,FLG)
  767.                                        "Select messages which arrived since a particular date")))
  768.                    (Seen (MM.SELECT ,WINDOW 'SEEN ,FLG)
  769.                          "Select messsages which have been read previously"
  770.                          (SUBITEMS (Unseen (MM.SELECT ,WINDOW 'UNSEEN ,FLG)
  771.                                           "Select messages which have not yet been read")))
  772.                    (Flagged (MM.SELECT ,WINDOW 'FLAGGED ,FLG)
  773.                           "Select messages which are flagged"
  774.                           (SUBITEMS (Unflagged (MM.SELECT ,WINDOW 'UNFLAGGED ,FLG)
  775.                                            "Select messages which are not flagged")))
  776.                    (Deleted (MM.SELECT ,WINDOW 'DELETED ,FLG)
  777.                           "Select messages which are deleted"
  778.                           (SUBITEMS (Undeleted (MM.SELECT ,WINDOW 'UNDELETED ,FLG)
  779.                                            "Select messages which are not deleted")))
  780.                    (Answered (MM.SELECT ,WINDOW 'ANSWERED ,FLG)
  781.                           "Select messages which have been answered"
  782.                           (SUBITEMS (Unanswered (MM.SELECT ,WINDOW 'UNANSWERED ,FLG)
  783.                                            "Select Messages which have not yet been answered"]
  784.           (SUBITEMS (MM.FLAGMENUITEMS WINDOW 'KEYWORD FLG)))
  785.          [if (CDR SUBITEMS)
  786.              then (SETQ ITEMS (APPEND ITEMS `((Keyworded (MM.SELECT ,WINDOW 'KEYWORD
  787.                                                                     ,FLG)
  788.                                                          
  789.                                                      "Select messages which have a specified keyword"
  790.                                                          ,SUBITEMS)
  791.                                                   (Unkeyworded (MM.SELECT ,WINDOW 'UNKEYWORD
  792.                                                                       ,FLG)
  793.                                                          
  794.                                               "Select messages which do not have a specified keyword"
  795.                                                          ,SUBITEMS]
  796.          ITEMS])
  797.  
  798. (MM.SELECT
  799.   [LAMBDA (WINDOW CRITERIA DON'TSELECTFLG)               (* ; "Edited 19-Apr-88 17:33 by MRC")
  800.                                                              (* ; 
  801.                                                     "Select messages based upon the given criteria")
  802.     (LET ((SELECTION (SELECTQ CRITERIA
  803.                          ((TEXT BODY SUBJECT) 
  804.                               (MM.PROMPTFORLINE "Text: " NIL WINDOW))
  805.                          ((FROM TO CC BCC) 
  806.                               (MM.PROMPTFORLINE "Address: " NIL WINDOW))
  807.                          ((KEYWORD UNKEYWORD) 
  808.                               (MM.MENU (WINDOWPROP WINDOW 'FLAGMENU)))
  809.                          ((ON SINCE BEFORE) 
  810.                               (MM.PROMPTFORLINE "Date: " NIL WINDOW))
  811.                          CRITERIA)))
  812.          (if SELECTION
  813.              then [if (FMEMB CRITERIA
  814.                                      '(TEXT BODY SUBJECT FROM TO CC BCC KEYWORD UNKEYWORD ON SINCE 
  815.                                             BEFORE))
  816.                           then (SETQ SELECTION (LIST CRITERIA (if (LISTP SELECTION)
  817.                                                                       then (CAR SELECTION)
  818.                                                                     else SELECTION]
  819.                    (if DON'TSELECTFLG
  820.                        then [LET [(CURRENT (WINDOWPROP WINDOW 'SELECTION]
  821.                                      [SETQ CURRENT (if (MEMB SELECTION CURRENT)
  822.                                                        then (DREMOVE SELECTION CURRENT)
  823.                                                      else (NCONC CURRENT (MKLIST SELECTION]
  824.                                      (WINDOWPROP WINDOW 'SELECTION CURRENT)
  825.                                      (printout (GETPROMPTWINDOW WINDOW)
  826.                                             T "Current selection: " CURRENT)
  827.                                      (TOTOPW (WINDOWPROP WINDOW 'SELECTMENUWINDOW]
  828.                      else (MAP.SELECT (WINDOWPROP WINDOW 'TSTREAM)
  829.                                      SELECTION])
  830.  
  831. (MM.HARDCOPY
  832.   [LAMBDA (WINDOW SEQUENCE)                              (* ; "Edited 30-Mar-88 10:17 by cdl")
  833.                                                              (* ; "Hardcopy a message sequence")
  834.     (LET ((STREAM (WINDOWPROP WINDOW 'TSTREAM))
  835.           (MESSAGEARRAY (WINDOWPROP WINDOW 'MESSAGEARRAY))
  836.           [LISTFILE (OPENSTREAM '{NODIRCORE} 'BOTH NIL '((EOL CRLF]
  837.           (INDEX 0)
  838.           MESSAGESTREAM)
  839.          (LINELENGTH MAX.SMALLP LISTFILE)                    (* ; 
  840.                                       "Arbitrarily long length to prevent Lisp from folding lines ")
  841.          (if (MOUSECONFIRM "Hardcopy message(s) to" (OR MM.LIST.HOST (DEFAULTPRINTER))
  842.                         (GETPROMPTWINDOW WINDOW))
  843.              then (if MM.LIST.INCLUDE.HEADERS
  844.                           then (printout LISTFILE "-- Messages from mailbox: "
  845.                                           (WINDOWPROP WINDOW 'MAILBOXNAME)
  846.                                           " --" T "   " (DATE (DATEFORMAT NO.LEADING.SPACES TIME.ZONE
  847.                                                                      DAY.OF.WEEK))
  848.                                           T T)
  849.                                 (for MSGNO inside SEQUENCE
  850.                                    do (printout LISTFILE .FR 6 (if MM.LIST.CONSECUTIVE.INDEX
  851.                                                                        then (add INDEX 1)
  852.                                                                      else MSGNO)
  853.                                                  ") ")
  854.                                          (MM.HEADERLINE STREAM MESSAGEARRAY MSGNO LISTFILE)
  855.                                          (printout LISTFILE T))
  856.                                 (SETQ INDEX 0))
  857.                    (for MSGNO inside SEQUENCE
  858.                       do (if MM.LIST.ON.SEPARATE.PAGES
  859.                                  then (printout LISTFILE .PAGE))
  860.                             (printout LISTFILE "Message " (if MM.LIST.CONSECUTIVE.INDEX
  861.                                                               then (add INDEX 1)
  862.                                                             else MSGNO)
  863.                                    " -- ************************" T)
  864.                             (if (SETQ MESSAGESTREAM (MAP.FETCHMESSAGE STREAM MESSAGEARRAY MSGNO))
  865.                                 then (if (OPENP MESSAGESTREAM)
  866.                                              then (CLOSEF MESSAGESTREAM))
  867.                                       [OPENSTREAM MESSAGESTREAM 'INPUT NIL '((EOL CRLF]
  868.                                       (COPYBYTES MESSAGESTREAM LISTFILE)
  869.                               else (printout LISTFILE "Message inaccessible" T)))
  870.                    (SETFILEPTR LISTFILE 0)
  871.                    (SEND.FILE.TO.PRINTER LISTFILE MM.LIST.HOST '(DOCUMENT.NAME "MM-D Listing"))
  872.                    (printout (GETPROMPTWINDOW WINDOW)
  873.                           T "Hardcopy complete"])
  874.  
  875. (MM.QUIT
  876.   [LAMBDA (WINDOW)                                       (* ; "Edited 25-Apr-88 08:10 by cdl")
  877.                                                              (* ; "Quits out of MM")
  878.                                                              (* ; 
  879.                                                     "MM.CLOSEMAILBOXWINDOW does the MM.LOCK action")
  880.     (CLOSEW WINDOW])
  881.  
  882. (MM.EXIT
  883.   [LAMBDA (WINDOW)                                       (* ; "Edited  6-Apr-88 18:16 by MRC")
  884.                                                              (* ; "Expunges mailbox then quits")
  885.                                                              (* ; 
  886.                   "Note that these functions do the MM.LOCK action, so we don't need to do it here")
  887.     (MM.EXPUNGEMAILBOX WINDOW)
  888.     (MM.QUIT WINDOW])
  889.  
  890. (MM.CHECKMAILBOX
  891.   [LAMBDA (WINDOW)                                       (* ; "Edited  6-Apr-88 18:20 by MRC")
  892.                                                              (* ; "Check for new messages")
  893.     (LET [(STREAM (WINDOWPROP WINDOW 'TSTREAM]
  894.          (if (MM.LOCK STREAM)
  895.              then (MAP.CHECKMAILBOX STREAM)
  896.                    (MM.ADDNEWMESSAGES WINDOW)
  897.                    (MM.UNLOCK STREAM])
  898.  
  899. (MM.CHECKENTIREMAILBOX
  900.   [LAMBDA (WINDOW)                                       (* ; "Edited  6-Apr-88 18:22 by MRC")
  901.                                                              (* ; "Re-check entire mailbox")
  902.     (LET [(STREAM (WINDOWPROP WINDOW 'TSTREAM]
  903.          (MM.CHECKMAILBOX WINDOW)
  904.          (if (MM.LOCK STREAM)
  905.              then (MM.UNLOCK STREAM)
  906.                    (MAP.FETCHFLAGS STREAM 1 (WINDOWPROP WINDOW 'NMSGS))
  907.                    (REDISPLAYW WINDOW])
  908.  
  909. (MM.EXPUNGEMAILBOX
  910.   [LAMBDA (WINDOW)                                       (* ; "Edited  6-Apr-88 18:18 by MRC")
  911.                                                              (* ; "Expunges the mailbox")
  912.     (LET [(STREAM (WINDOWPROP WINDOW 'TSTREAM]
  913.          (if (MM.LOCK STREAM)
  914.              then (MAP.EXPUNGEMAILBOX STREAM)
  915.                    (MM.ADDNEWMESSAGES WINDOW)
  916.                    [WINDOWPROP WINDOW 'TITLE (MM.MAILBOXWINDOWTITLE (WINDOWPROP WINDOW
  917.                                                                                'MAILBOXNAME)
  918.                                                     (WINDOWPROP WINDOW 'NMSGS]
  919.                    (MM.UNLOCK STREAM])
  920.  
  921. (MM.TOGGLE.SELECTED
  922.   [LAMBDA (WINDOW)                   (* ; "Edited 15-Jun-88 15:32 by MRC")
  923.                                                (* ; 
  924.                                              "Zoom in on selected messages")
  925.     (LET
  926.      ((BROWSER (WINDOWPROP WINDOW 'TABLEBROWSER))
  927.       (ZOOMDATA (WINDOWPROP WINDOW 'ZOOMDATA NIL))
  928.       (PROMPTSTREAM (GETPROMPTWINDOW WINDOW))
  929.       MENU MENUITEM ITEMS)
  930.      [for WINDOW in (ATTACHEDWINDOWS WINDOW)
  931.         thereis (SETQ MENU (for MENU in (WINDOWPROP WINDOW
  932.                                                            'MENU)
  933.                                   thereis (SETQ MENUITEM
  934.                                                (ASSOC 'Zoom
  935.                                                       (with MENU MENU ITEMS
  936.                                                              ]
  937.      (SETQ ITEMS (TB.COLLECT.ITEMS BROWSER))
  938.      (if ZOOMDATA
  939.          then [with MM.ZOOMDATA ZOOMDATA
  940.                          (if (SETQ ITEMS (for ITEM in ITEMS
  941.                                                 unless (MEMB ITEM NewItems)
  942.                                                 collect ITEM))
  943.                              then          (* ; 
  944.       "Add new messages that showed up while we were in 'selected only' mode")
  945.                                    (SETQ OldItems (NCONC OldItems ITEMS]
  946.                (MM.REPLACE.TABLEITEMS BROWSER ZOOMDATA)
  947.                (SHADEITEM MENUITEM MENU WHITESHADE)
  948.                (with MENU MENU (SETQ WHENSELECTEDFN (FUNCTION 
  949.                                                        BACKGROUNDWHENSELECTEDFN
  950.                                                          )))
  951.        else (PRINTOUT PROMPTSTREAM T "Collecting selected messagess...")
  952.              [SETQ ZOOMDATA
  953.               (create MM.ZOOMDATA
  954.                      NewItems _
  955.                      (bind (STREAM _ (WINDOWPROP WINDOW 'TSTREAM))
  956.                             (MESSAGEARRAY _ (WINDOWPROP WINDOW
  957.                                                    'MESSAGEARRAY))
  958.                         declare (SPECVARS (STREAM MESSAGEARRAY ITEM))
  959.                         for ITEM in ITEMS
  960.                         when (with TABLEITEM ITEM TISELECTED)
  961.                         collect (PROGN     (* ; 
  962.                        "Turn off look ahead when picking out random messages")
  963.                                            [RESETVAR MAP.LOOKAHEAD NIL
  964.                                             (MAP.FETCHENVELOPE
  965.                                              STREAM MESSAGEARRAY
  966.                                              (MM.TBPROP ITEM 'MSGNO]
  967.                                            ITEM]
  968.              (if (with MM.ZOOMDATA ZOOMDATA NewItems)
  969.                  then (with MM.ZOOMDATA ZOOMDATA (SETQ OldItems ITEMS)
  970.                                  [SETQ FirstVisibleItem
  971.                                   (TB.NTH.ITEM BROWSER
  972.                                          (TB.FIRST.VISIBLE.ITEM#
  973.                                           BROWSER
  974.                                           (DSPCLIPPINGREGION NIL WINDOW]
  975.                                  (TB.REPLACE.ITEMS BROWSER (APPEND NewItems)))
  976.                        (WINDOWPROP WINDOW 'ZOOMDATA ZOOMDATA)
  977.                        (with MENU MENU (SETQ WHENSELECTEDFN
  978.                                             (FUNCTION MM.TOGGLED.SELECTEDFN)))
  979.                        (SHADEITEM MENUITEM MENU GRAYSHADE)
  980.                        (PRINTOUT PROMPTSTREAM T)
  981.                else (PRINTOUT PROMPTSTREAM T "No messages selected!"])
  982.  
  983. (MM.TOGGLED.SELECTEDFN
  984.   [LAMBDA (ITEM FROMMENU BUTTON)                         (* ; "Edited 29-Apr-88 16:23 by MRC")
  985.                                                              (* ; "Bottom menu buttoneventfn")
  986.     (PROG [(WINDOW (MAINWINDOW (WFROMMENU FROMMENU]
  987.           (if (EQ (CAR ITEM)
  988.                       'Expunge)
  989.               then (PRINTOUT (GETPROMPTWINDOW WINDOW)
  990.                               T "You must UnZoom in order to Expunge!")
  991.                     (RETURN)
  992.             elseif (EQUAL (CAR ITEM)
  993.                               "New Mailbox")
  994.               then (PRINTOUT (GETPROMPTWINDOW WINDOW)
  995.                               T "Leaving Zoom mode...")
  996.                     (MM.TOGGLE.SELECTED WINDOW))
  997.           (RETURN (BACKGROUNDWHENSELECTEDFN ITEM FROMMENU BUTTON])
  998.  
  999. (MM.REPLACE.TABLEITEMS
  1000.   [LAMBDA (BROWSER ZOOMDATA)         (* ; "Edited 15-Jun-88 15:31 by MRC")
  1001.                                                (* ; 
  1002.                                 "Put the indicated items back in the browser")
  1003.     (LET ((%#ITEMS 0)
  1004.           (WINDOW (fetch (TABLEBROWSER TBWINDOW) of BROWSER))
  1005.           (YPOS (MM.YCOORD.FROM.ITEM BROWSER
  1006.                        (with MM.ZOOMDATA ZOOMDATA FirstVisibleItem)))
  1007.           REGION FIRSTSEL)
  1008.          (with TABLEBROWSER BROWSER
  1009.                 [with MM.ZOOMDATA ZOOMDATA
  1010.                        [for ITEM in OldItems
  1011.                           do (with TABLEITEM ITEM (SETQ TI#
  1012.                                                            (add %#ITEMS 1]
  1013.                        (SETQ TBITEMS OldItems)
  1014.                        (SETQ TB#ITEMS %#ITEMS)
  1015.                        (SETQ TB#DELETED (for ITEM in OldItems
  1016.                                            count (with TABLEITEM ITEM 
  1017.                                                             TIDELETED]
  1018.                 (if (SETQ FIRSTSEL (TB.FIND.SELECTED.ITEM BROWSER 1 %#ITEMS
  1019.                                               ))
  1020.                     then (SETQ TBFIRSTSELECTEDITEM FIRSTSEL)
  1021.                           (SETQ TBLASTSELECTEDITEM (TB.REV.FIND.SELECTED.ITEM
  1022.                                                     BROWSER FIRSTSEL %#ITEMS))
  1023.                   else (SETQ TBFIRSTSELECTEDITEM (ADD1 %#ITEMS))
  1024.                         (SETQ TBLASTSELECTEDITEM 0)))
  1025.          (TB.SET.FONT BROWSER)
  1026.          (SCROLLBYREPAINTFN WINDOW 0
  1027.                 (DIFFERENCE (PLUS (fetch (REGION TOP)
  1028.                                      of (SETQ REGION (DSPCLIPPINGREGION
  1029.                                                           NIL WINDOW)))
  1030.                                   (FONTPROP (with TABLEBROWSER BROWSER 
  1031.                                                    TBFONT)
  1032.                                          'DESCENT))
  1033.                        YPOS))
  1034.          (TB.DISPLAY.LINES BROWSER (TB.FIRST.VISIBLE.ITEM# BROWSER REGION)
  1035.                 (TB.LAST.VISIBLE.ITEM# BROWSER REGION])
  1036. )
  1037.  
  1038.  
  1039.  
  1040. (* ; "Message reading functions")
  1041.  
  1042. (DEFINEQ
  1043.  
  1044. (MM.READMESSAGE
  1045.   [LAMBDA (WINDOW SEQUENCE)                              (* ; "Edited 26-Feb-88 15:03 by MRC")
  1046.                                                              (* ; "Read a particular message")
  1047.     (LET ((STREAM (WINDOWPROP WINDOW 'TSTREAM))
  1048.           (MESSAGEARRAY (WINDOWPROP WINDOW 'MESSAGEARRAY))
  1049.           (MSGNO (if (LISTP SEQUENCE)
  1050.                      then (CAR SEQUENCE)
  1051.                    else SEQUENCE))
  1052.           MESSAGE)
  1053.          (if (AND MSGNO (SETQ MESSAGE (MAP.FETCHMESSAGE STREAM MESSAGEARRAY MSGNO)))
  1054.              then (MM.TEDITMESSAGE STREAM MESSAGEARRAY SEQUENCE WINDOW MSGNO MESSAGE])
  1055.  
  1056. (MM.TEDITMESSAGE
  1057.   [LAMBDA (STREAM MESSAGEARRAY SEQUENCE PRIMARYWINDOW MSGNO MESSAGE OLDWINDOW)
  1058.                                                              (* ; "Edited 28-Apr-88 15:08 by cdl")
  1059.                                                              (* ; 
  1060.                                                           "Invoke TEdit on this message and window")
  1061.     (LET (WINDOW)
  1062.          (if (SETQ WINDOW OLDWINDOW)
  1063.              then (WINDOWPROP WINDOW 'TITLE (MM.HEADERLINE STREAM MESSAGEARRAY MSGNO))
  1064.            else (SETQ WINDOW (CREATEW (MM.GET.WINDOW.REGION MM.READWINDOWSIZE 'READ 
  1065.                                                  PRIMARYWINDOW)
  1066.                                         (MM.HEADERLINE STREAM MESSAGEARRAY MSGNO)))
  1067.                  (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION MM.READCLOSE))
  1068.                  (WINDOWPROP WINDOW 'ICONFN (FUNCTION MM.ICONFN))
  1069.                  (WINDOWPROP WINDOW 'PRIMARYWINDOW PRIMARYWINDOW)
  1070.                  (WINDOWPROP WINDOW 'FLAGMENU (WINDOWPROP PRIMARYWINDOW 'FLAGMENU))
  1071.                  (WINDOWPROP WINDOW 'FLAGLST (WINDOWPROP PRIMARYWINDOW 'FLAGLST))
  1072.                  (WINDOWPROP WINDOW 'MESSAGEARRAY MESSAGEARRAY)
  1073.                  (WINDOWPROP WINDOW 'MAILBOXNAME (WINDOWPROP PRIMARYWINDOW 'MAILBOXNAME))
  1074.                  (WINDOWPROP WINDOW 'SEQUENCE SEQUENCE)
  1075.                  (WINDOWPROP WINDOW 'TSTREAM STREAM)
  1076.                  (ATTACHMENU (create MENU
  1077.                                     TITLE _ "Read Menu"
  1078.                                     ITEMS _ (MM.READMENUITEMS WINDOW)
  1079.                                     MENUOUTLINESIZE _ 1)
  1080.                         WINDOW
  1081.                         'RIGHT
  1082.                         'TOP)
  1083.                  (ATTACHMENU (create MENU
  1084.                                     ITEMS _ (MM.READCOMMANDMENUITEMS WINDOW)
  1085.                                     CENTERFLG _ T)
  1086.                         WINDOW
  1087.                         'BOTTOM))
  1088.          (WINDOWPROP WINDOW 'MESSAGERECORD (MAP.ELT MESSAGEARRAY MSGNO))
  1089.          [OPENTEXTSTREAM MESSAGE WINDOW NIL NIL
  1090.                 `(PROMPTWINDOW DON'T PARALOOKS (TABS (,(TIMES MM.TEDIT.TABWIDTH
  1091.                                                               (CHARWIDTH (CHARCODE A)
  1092.                                                                      (DSPFONT NIL WINDOW]
  1093.          (MM.UPDATE PRIMARYWINDOW MSGNO)
  1094.          (TOTOPW WINDOW])
  1095.  
  1096. (MM.READMENUITEMS
  1097.   [LAMBDA (WINDOW)                                       (* ; "Edited 25-Mar-88 16:46 by cdl")
  1098.                                                              (* ; "Return a read menu")
  1099.     `((Reply (MM.REPLYMESSAGE ,WINDOW)
  1100.              "Compose a reply (to the sender only) to this message"
  1101.              (SUBITEMS ("Reply to Sender only" (MM.REPLYMESSAGE ,WINDOW)
  1102.                               "Send answer only to the sender or reply address of this message")
  1103.                     ("Reply to All" (MM.REPLYMESSAGE ,WINDOW T)
  1104.                            "Reply to the reply address and all recipients of this message")))
  1105.       (File (MM.COPYMESSAGE ,WINDOW)
  1106.             "Copy this message into another mailbox"
  1107.             (SUBITEMS (Copy (MM.COPYMESSAGE ,WINDOW)
  1108.                             "Copy this message into another mailbox")
  1109.                    (Move (MM.MOVEMESSAGE ,WINDOW)
  1110.                          "Move this message into another mailbox and delete it from this mailbox")))
  1111.       (Hardcopy (MM.HARDCOPYMESSAGE ,WINDOW)
  1112.              "Sends this message to the default printer")
  1113.       [Keyword (MM.SETFLAG ,WINDOW)
  1114.              "Set a keyword on this message"
  1115.              (SUBITEMS [Set (MM.SETFLAG ,WINDOW)
  1116.                             "Set a keyword on this message"
  1117.                             ,(MM.FLAGMENUITEMS WINDOW 'MM.SETFLAG]
  1118.                     (Clear (MM.CLEARFLAG ,WINDOW)
  1119.                            "Clear a keyword on this message"
  1120.                            ,(MM.FLAGMENUITEMS WINDOW 'MM.CLEARFLAG]
  1121.       (Flag (MM.SETFLAG ,WINDOW '\Flagged)
  1122.             "Flag this message for special attention"
  1123.             (SUBITEMS (Unflag (MM.CLEARFLAG ,WINDOW '\Flagged)
  1124.                              "Clear the flagged status of this message")))
  1125.       (Delete (MM.SETFLAG ,WINDOW '\Deleted)
  1126.              "Mark this message for deletion"
  1127.              (SUBITEMS (Undelete (MM.CLEARFLAG ,WINDOW '\Deleted)
  1128.                               "Clear the deleted status of this message"])
  1129.  
  1130. (MM.READCOMMANDMENUITEMS
  1131.   [LAMBDA (WINDOW)                                       (* ; "Edited 24-Feb-88 18:24 by MRC")
  1132.                                                              (* ; "Return a read command menu")
  1133.     `((Quit (CLOSEW ,WINDOW)
  1134.             "Quits reading this message and closes its window")
  1135.       (Previous (MM.PREVIOUSMESSAGE ,WINDOW)
  1136.              "Read the previous message")
  1137.       (Kill (MM.KILLMESSAGE ,WINDOW)
  1138.             "Delete the current message and read the next message")
  1139.       (Next (MM.NEXTMESSAGE ,WINDOW)
  1140.             "Read the next message"])
  1141.  
  1142. (MM.READCLOSE
  1143.   [LAMBDA (WINDOW)                                       (* ; "Edited 28-Apr-88 15:03 by cdl")
  1144.                                                              (* ; 
  1145.                                    "Break the menu/window circularity so it gets garbage collected")
  1146.     (PROG [(STREAM (WINDOWPROP WINDOW 'TSTREAM]
  1147.           [if (AND STREAM (OPENP STREAM)
  1148.                        (NOT (EOFP STREAM)))
  1149.               then (if (MM.LOCK STREAM)
  1150.                            then (MM.UNLOCK STREAM)
  1151.                          else (RETURN 'DON'T]
  1152.           (for WINDOW in (ATTACHEDWINDOWS WINDOW)
  1153.              do                                          (* ; 
  1154.                                               "Since menu items have pointers to window in them...")
  1155.                    (for MENU in (WINDOWPROP WINDOW 'MENU) do (DELETEMENU MENU NIL WINDOW)
  1156.                           ))
  1157.           (WINDOWPROP WINDOW 'MESSAGEARRAY NIL)
  1158.           (WINDOWPROP WINDOW 'TSTREAM NIL)
  1159.           (WINDOWPROP WINDOW 'MESSAGERECORD NIL)
  1160.           [if MM.REMEMBER.POSITIONS
  1161.               then (WINDOWADDPROP (WINDOWPROP WINDOW 'PRIMARYWINDOW)
  1162.                               'MM.POSITIONS
  1163.                               (CONS 'READ (with REGION (WINDOWPROP WINDOW 'REGION)
  1164.                                                  (CREATEPOSITION LEFT BOTTOM]
  1165.           (WINDOWPROP WINDOW 'PRIMARYWINDOW NIL])
  1166.  
  1167. (MM.SETFLAG
  1168.   [LAMBDA (WINDOW FLAG)                                  (* ; "Edited  6-Apr-88 18:38 by MRC")
  1169.                                                              (* ; 
  1170.                                                       "Prompts for flag and sets it in the message")
  1171.     (LET ((STREAM (WINDOWPROP WINDOW 'TSTREAM))
  1172.           (MSGNO (MM.MSGNO WINDOW)))
  1173.          (if (AND STREAM MSGNO (MM.LOCK STREAM))
  1174.              then [MAP.SETFLAG STREAM MSGNO (OR FLAG (MM.MENU (WINDOWPROP WINDOW 'FLAGMENU]
  1175.                    (MM.UPDATE (WINDOWPROP WINDOW 'PRIMARYWINDOW)
  1176.                           MSGNO)
  1177.                    (WINDOWPROP WINDOW 'TITLE (MM.HEADERLINE STREAM (WINDOWPROP WINDOW
  1178.                                                                               'MESSAGEARRAY)
  1179.                                                     MSGNO))
  1180.                    (MM.UNLOCK STREAM])
  1181.  
  1182. (MM.CLEARFLAG
  1183.   [LAMBDA (WINDOW FLAG)                                  (* ; "Edited  6-Apr-88 18:38 by MRC")
  1184.                                                              (* ; 
  1185.                                                     "Prompts for flag and clears it in the message")
  1186.     (LET ((STREAM (WINDOWPROP WINDOW 'TSTREAM))
  1187.           (MSGNO (MM.MSGNO WINDOW)))
  1188.          (if (AND STREAM MSGNO (MM.LOCK STREAM))
  1189.              then [MAP.CLEARFLAG STREAM MSGNO (OR FLAG (MM.MENU (WINDOWPROP WINDOW
  1190.                                                                                'FLAGMENU]
  1191.                    (MM.UPDATE (WINDOWPROP WINDOW 'PRIMARYWINDOW)
  1192.                           MSGNO)
  1193.                    (WINDOWPROP WINDOW 'TITLE (MM.HEADERLINE STREAM (WINDOWPROP WINDOW
  1194.                                                                               'MESSAGEARRAY)
  1195.                                                     MSGNO))
  1196.                    (MM.UNLOCK STREAM])
  1197.  
  1198. (MM.REPLYMESSAGE
  1199.   [LAMBDA (WINDOW ALL)                                   (* ; "Edited  6-Apr-88 18:29 by MRC")
  1200.                                                              (* ; "Reply to the current message")
  1201.     (LET [(MSGNO (MM.MSGNO WINDOW))
  1202.           (STREAM (WINDOWPROP WINDOW 'TSTREAM]
  1203.          (if (AND MSGNO (MM.LOCK STREAM))
  1204.              then (MM.REPLY WINDOW MSGNO ALL)
  1205.                    (MM.UNLOCK STREAM])
  1206.  
  1207. (MM.HARDCOPYMESSAGE
  1208.   [LAMBDA (WINDOW)                                       (* ; "Edited  6-Apr-88 18:35 by MRC")
  1209.                                                              (* ; "Hardcopy the current message")
  1210.     (LET [(MSGNO (MM.MSGNO WINDOW))
  1211.           (STREAM (WINDOWPROP WINDOW 'TSTREAM]
  1212.          (if (AND MSGNO (MM.LOCK STREAM))
  1213.              then (MM.HARDCOPY WINDOW MSGNO)
  1214.                    (MM.UNLOCK STREAM])
  1215.  
  1216. (MM.COPYMESSAGE
  1217.   [LAMBDA (WINDOW)                                       (* ; "Edited 25-Apr-88 08:35 by cdl")
  1218.                                                              (* ; "Copy message to another mailbox")
  1219.     (LET ((MSGNO (MM.MSGNO WINDOW))
  1220.           (STREAM (WINDOWPROP WINDOW 'TSTREAM))
  1221.           MAILBOX)
  1222.          (if (AND MSGNO (SETQ MAILBOX (MM.PROMPTFORMAILBOX WINDOW))
  1223.                       (MM.LOCK STREAM))
  1224.              then (MAP.COPYMESSAGE (WINDOWPROP WINDOW 'TSTREAM)
  1225.                              MSGNO MAILBOX)
  1226.                    (MM.UNLOCK STREAM])
  1227.  
  1228. (MM.MOVEMESSAGE
  1229.   [LAMBDA (WINDOW)                                       (* ; "Edited 25-Apr-88 08:35 by cdl")
  1230.                                                              (* ; "Move message to another mailbox")
  1231.     (LET ((MSGNO (MM.MSGNO WINDOW))
  1232.           (STREAM (WINDOWPROP WINDOW 'TSTREAM))
  1233.           MAILBOX)
  1234.          (if (AND MSGNO (SETQ MAILBOX (MM.PROMPTFORMAILBOX WINDOW))
  1235.                       (MM.LOCK STREAM))
  1236.              then (if (MAP.MOVEMESSAGE STREAM MSGNO MAILBOX)
  1237.                           then (printout (GETPROMPTWINDOW WINDOW)
  1238.                                           T "Move completed"))
  1239.                    (MM.UPDATE (WINDOWPROP WINDOW 'PRIMARYWINDOW)
  1240.                           MSGNO)
  1241.                    (MM.UNLOCK STREAM])
  1242.  
  1243. (MM.NEXTMESSAGE
  1244.   [LAMBDA (WINDOW)                                       (* ; "Edited 25-Apr-88 16:10 by cdl")
  1245.                                                              (* ; "Move to next message")
  1246.     (LET ((MESSAGEARRAY (WINDOWPROP WINDOW 'MESSAGEARRAY))
  1247.           (SEQUENCE (WINDOWPROP WINDOW 'SEQUENCE))
  1248.           (MSGNO (MM.MSGNO WINDOW))
  1249.           (BROWSER (WINDOWPROP (WINDOWPROP WINDOW 'PRIMARYWINDOW)
  1250.                           'TABLEBROWSER))
  1251.           NEWMESSAGENO TABLEITEMS)
  1252.          (if [AND MSGNO [SETQ NEWMESSAGENO (if (LISTP SEQUENCE)
  1253.                                                    then (CADR (FMEMB MSGNO SEQUENCE))
  1254.                                                  elseif [SETQ TABLEITEMS
  1255.                                                              (CDR (FMEMB (MM.FIND.TABLEITEM
  1256.                                                                           BROWSER MSGNO)
  1257.                                                                          (TB.COLLECT.ITEMS BROWSER]
  1258.                                                    then (MM.TBPROP (CAR TABLEITEMS)
  1259.                                                                    'MSGNO]
  1260.                       (LEQ NEWMESSAGENO (WINDOWPROP (WINDOWPROP WINDOW 'PRIMARYWINDOW)
  1261.                                                'NMSGS]
  1262.              then (MM.MOVETOMESSAGE WINDOW (WINDOWPROP WINDOW 'TSTREAM)
  1263.                              MESSAGEARRAY NEWMESSAGENO)
  1264.                    (printout (GETPROMPTWINDOW WINDOW)
  1265.                           T)
  1266.                    T
  1267.            else (printout (GETPROMPTWINDOW WINDOW)
  1268.                            T "No further messages to read")
  1269.                  NIL])
  1270.  
  1271. (MM.PREVIOUSMESSAGE
  1272.   [LAMBDA (WINDOW)                                       (* ; "Edited 25-Apr-88 16:11 by cdl")
  1273.                                                              (* ; "Move to previous message")
  1274.     (LET ((SEQUENCE (WINDOWPROP WINDOW 'SEQUENCE))
  1275.           (MSGNO (MM.MSGNO WINDOW))
  1276.           (BROWSER (WINDOWPROP (WINDOWPROP WINDOW 'PRIMARYWINDOW)
  1277.                           'TABLEBROWSER))
  1278.           NEWMESSAGENO TABLEITEMS)
  1279.          (if (AND MSGNO [SETQ NEWMESSAGENO (if (LISTP SEQUENCE)
  1280.                                                    then (CADR (FMEMB MSGNO (REVERSE SEQUENCE)))
  1281.                                                  elseif [SETQ TABLEITEMS
  1282.                                                              (CDR (FMEMB (MM.FIND.TABLEITEM
  1283.                                                                           BROWSER MSGNO)
  1284.                                                                          (DREVERSE (TB.COLLECT.ITEMS
  1285.                                                                                     BROWSER]
  1286.                                                    then (MM.TBPROP (CAR TABLEITEMS)
  1287.                                                                    'MSGNO]
  1288.                       (NOT (ZEROP NEWMESSAGENO)))
  1289.              then (MM.MOVETOMESSAGE WINDOW (WINDOWPROP WINDOW 'TSTREAM)
  1290.                              (WINDOWPROP WINDOW 'MESSAGEARRAY)
  1291.                              NEWMESSAGENO)
  1292.                    (printout (GETPROMPTWINDOW WINDOW)
  1293.                           T)
  1294.                    T
  1295.            else (printout (GETPROMPTWINDOW WINDOW)
  1296.                            T "No previous message to read")
  1297.                  NIL])
  1298.  
  1299. (MM.KILLMESSAGE
  1300.   [LAMBDA (WINDOW)                                       (* ; "Edited  6-Apr-88 18:41 by MRC")
  1301.                                                              (* ; 
  1302.                                                  "Delete the current message, move to next message")
  1303.     (LET [(STREAM (WINDOWPROP WINDOW 'TSTREAM]
  1304.          (if (MM.LOCK STREAM)
  1305.              then (MM.UNLOCK STREAM)
  1306.                    (MM.SETFLAG WINDOW '\Deleted)
  1307.                    (if (NOT (MM.NEXTMESSAGE WINDOW))
  1308.                        then (CLOSEW WINDOW])
  1309.  
  1310. (MM.MOVETOMESSAGE
  1311.   [LAMBDA (WINDOW STREAM MESSAGEARRAY MSGNO)             (* ; "Edited  6-Apr-88 18:40 by MRC")
  1312.                                                              (* ; 
  1313.                                                "Move message in window to specified message number")
  1314.     (if (MM.LOCK STREAM)
  1315.         then (LET ((MESSAGE (MAP.FETCHMESSAGE STREAM MESSAGEARRAY MSGNO)))
  1316.                       (if MESSAGE
  1317.                           then (MM.TEDITMESSAGE STREAM MESSAGEARRAY (WINDOWPROP WINDOW
  1318.                                                                                    'SEQUENCE)
  1319.                                           (WINDOWPROP WINDOW 'PRIMARYWINDOW)
  1320.                                           MSGNO MESSAGE WINDOW)))
  1321.               (MM.UNLOCK STREAM])
  1322. )
  1323.  
  1324. (DEFMACRO MM.MSGNO (W)                     (* ; 
  1325.                                           "Get message number of this window")
  1326.    `(fetch (MM.CACHE Msg#) of (WINDOWPROP ,W 'MESSAGERECORD)))
  1327.  
  1328.  
  1329.  
  1330. (* ; "Message composition functions")
  1331.  
  1332. (DEFINEQ
  1333.  
  1334. (MM.COMPOSEMESSAGE
  1335.   [LAMBDA (MESSAGE REPLYRECORD REPLYWINDOW TITLE)        (* ; "Edited 28-Apr-88 15:45 by cdl")
  1336.                                                              (* ; "Compose a new message")
  1337.     (DECLARE (GLOBALVARS TEDIT.DEFAULT.MENU))
  1338.     (LET (WINDOW ENVELOPEWINDOW)
  1339.          (SETQ WINDOW (CREATEW (MM.GET.WINDOW.REGION MM.COMPOSEWINDOWSIZE 'COMPOSE
  1340.                                       (OR REPLYWINDOW MM.WINDOW))
  1341.                              (OR TITLE "Message Composition Window")))
  1342.          (WINDOWPROP WINDOW 'ENVELOPEWINDOW (SETQ ENVELOPEWINDOW (GETPROMPTWINDOW WINDOW 5)))
  1343.          (if (NULL MESSAGE)
  1344.              then (SETQ MESSAGE (create MM.MESSAGE
  1345.                                            From _ (MM.FROMADDRESS)))
  1346.                    (MTP.ENVELOPE ENVELOPEWINDOW MESSAGE))
  1347.          (with MM.MESSAGE MESSAGE (SETQ cc (APPEND cc MM.DEFAULT.CC))
  1348.                 (SETQ bcc (APPEND bcc MM.DEFAULT.BCC)))      (* ; 
  1349.                                                    "Too bad NCONC won't work if it's initially NIL")
  1350.          (WINDOWPROP WINDOW 'MESSAGE MESSAGE)
  1351.          (WINDOWPROP WINDOW 'REPLYWINDOW REPLYWINDOW)
  1352.          (WINDOWPROP WINDOW 'REPLYRECORD REPLYRECORD)
  1353.          (WINDOWPROP ENVELOPEWINDOW 'MESSAGE MESSAGE)
  1354.          (WINDOWPROP ENVELOPEWINDOW 'REPAINTFN (FUNCTION MM.REPAINT.ENVELOPE))
  1355.                                                              (* ; 
  1356.                                           "Allow envelope window to redisplay itself independently")
  1357.          [WINDOWPROP ENVELOPEWINDOW 'PASSTOMAINCOMS (DREMOVE 'REDISPLAYW (WINDOWPROP ENVELOPEWINDOW
  1358.                                                                                 'PASSTOMAINCOMS]
  1359.          (REDISPLAYW ENVELOPEWINDOW)
  1360.          (ATTACHMENU (create MENU
  1361.                             ITEMS _ (MM.COMPOSEMENUITEMS WINDOW)
  1362.                             CENTERFLG _ T)
  1363.                 WINDOW
  1364.                 'BOTTOM)
  1365.          [if [OR (NULL MM.TEDIT.MENU)
  1366.                      (NOT (EQUAL (with MENU TEDIT.DEFAULT.MENU ITEMS)
  1367.                                  (with MENU MM.TEDIT.MENU (CDR ITEMS]
  1368.              then (SETQ MM.TEDIT.MENU (with MENU TEDIT.DEFAULT.MENU
  1369.                                                  (create MENU
  1370.                                                         ITEMS _ `((Compress (MM.TEDIT.STRIPEOLS
  1371.                                                                              TEXTOBJ)
  1372.                                                                          "Convert EOLS to spaces.")
  1373.                                                                   ,@ITEMS)
  1374.                                                         IMAGE _ NIL
  1375.                                                         MENUROWS _ NIL using TEDIT.DEFAULT.MENU]
  1376.          (WINDOWPROP WINDOW 'ICON MM.ENVELOPEICON)
  1377.          (WINDOWPROP WINDOW 'ICONFN (FUNCTION MM.ICONFN))
  1378.          (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION MM.COMPOSEQUIT))
  1379.          (TEDIT NIL WINDOW NIL `(MENU ,MM.TEDIT.MENU PARALOOKS
  1380.                                       [TABS (,(TIMES MM.TEDIT.TABWIDTH (CHARWIDTH (CHARCODE A)
  1381.                                                                               (DSPFONT NIL WINDOW]
  1382.                                       AFTERQUITFN MM.COMPOSEQUIT])
  1383.  
  1384. (MM.REPLY
  1385.   [LAMBDA (WINDOW SEQUENCE ALL)                          (* ; "Edited 28-Apr-88 15:40 by cdl")
  1386.                                                              (* ; "Reply to a message sequence")
  1387.     (LET ((STREAM (WINDOWPROP WINDOW 'TSTREAM))
  1388.           (MESSAGEARRAY (WINDOWPROP WINDOW 'MESSAGEARRAY))
  1389.           ENVELOPEWINDOW ENVELOPE SUBJECT)
  1390.          (for MSGNO inside SEQUENCE
  1391.             do (if (SETQ ENVELOPE (OR (fetch (MM.CACHE Envelope) of (MAP.ELT 
  1392.                                                                                          MESSAGEARRAY
  1393.                                                                                            MSGNO))
  1394.                                               (MAP.FETCHENVELOPE STREAM MESSAGEARRAY MSGNO)))
  1395.                        then (if (SETQ SUBJECT (fetch (MM.MESSAGE Subject) of ENVELOPE
  1396.                                                              ))
  1397.                                     then                 (* ; 
  1398.                               "Insert a %"Re:%" in front of the subject if one isn't there already")
  1399.                                           (OR (STRING-EQUAL (SUBSTRING SUBJECT 1 3)
  1400.                                                      "re:")
  1401.                                               (SETQ SUBJECT (CONCAT "Re: " SUBJECT))) 
  1402.                                                              (* ; 
  1403.                                      "Can't use STRPOS since  a case-independent compare is needed")
  1404.                                   else (SETQ SUBJECT "(reply to message)"))
  1405.                              (MM.COMPOSEMESSAGE
  1406.                               [create MM.MESSAGE
  1407.                                      From _ (MM.FROMADDRESS)
  1408.                                      To _ (MM.REPLY.ADDRESS (fetch (MM.MESSAGE Reply-To)
  1409.                                                                    of ENVELOPE))
  1410.                                      cc _ [if ALL
  1411.                                               then (MM.REPLY.ADDRESS
  1412.                                                         (APPEND (fetch (MM.MESSAGE To)
  1413.                                                                    of ENVELOPE)
  1414.                                                                (fetch (MM.MESSAGE cc)
  1415.                                                                   of ENVELOPE)
  1416.                                                                (fetch (MM.MESSAGE bcc)
  1417.                                                                   of ENVELOPE]
  1418.                                      Subject _ SUBJECT
  1419.                                      In-Reply-To _ (OR (fetch (MM.MESSAGE Message-ID)
  1420.                                                           of ENVELOPE)
  1421.                                                        (CONCAT "Message from "
  1422.                                                               (RFC822.MAILBOX
  1423.                                                                (CAR (fetch (MM.MESSAGE From)
  1424.                                                                        of ENVELOPE)))
  1425.                                                               " of "
  1426.                                                               (fetch (MM.MESSAGE Date)
  1427.                                                                  of ENVELOPE]
  1428.                               (MAP.ELT MESSAGEARRAY MSGNO)
  1429.                               (OR (WINDOWPROP WINDOW 'PRIMARYWINDOW)
  1430.                                   WINDOW)
  1431.                               "Message Reply Window")
  1432.                      else (printout (GETPROMPTWINDOW WINDOW)
  1433.                                      T "No envelope for message " MSGNO])
  1434.  
  1435. (MM.FROMADDRESS
  1436.   [LAMBDA NIL                                            (* ; "Edited 23-Mar-88 18:07 by cdl")
  1437.                                                              (* ; 
  1438.                                          "Return a From address block for a message being composed")
  1439.     (LET ((HOST (MM.SERVICEHOST)))
  1440.          `(,(create MM.ADDRESS
  1441.                    PersonalName _ MM.PERSONALNAME
  1442.                    Mailbox _ (CAR (\INTERNAL/GETPASSWORD HOST))
  1443.                    Host _ HOST])
  1444.  
  1445. (MM.REPLY.ADDRESS
  1446.   [LAMBDA (ADDRESS)                                      (* ; "Edited 14-Apr-88 11:38 by MRC")
  1447.                                                              (* ; 
  1448.                                        "Convert an envelope address record to an MM.ADDRESS record")
  1449.     (for addr in ADDRESS collect (create MM.ADDRESS
  1450.                                                     PersonalName _ (fetch (MM.ADDRESS 
  1451.                                                                                      PersonalName)
  1452.                                                                       of addr)
  1453.                                                     RouteList _ (fetch (MM.ADDRESS RouteList)
  1454.                                                                    of addr)
  1455.                                                     Mailbox _ (fetch (MM.ADDRESS Mailbox)
  1456.                                                                  of addr)
  1457.                                                     Host _ (fetch (MM.ADDRESS Host) of addr])
  1458.  
  1459. (MM.COMPOSEMENUITEMS
  1460.   [LAMBDA (WINDOW)                   (* ; "Edited 15-Jun-88 15:41 by MRC")
  1461.                                                (* ; "Return a compose menu")
  1462.     `((Abort (CLOSEW ,WINDOW)
  1463.              "Abort (cancel) composition of this message")
  1464.       (Remove (MM.REMOVE (GETPROMPTWINDOW ,WINDOW))
  1465.              "Remove a recipient in any category")
  1466.       (Subject (MM.SUBJECT (GETPROMPTWINDOW ,WINDOW))
  1467.              "Change the subject of the message")
  1468.       ("Add bcc" (MM.ADD.RECIPIENT (GETPROMPTWINDOW ,WINDOW)
  1469.                         'bcc)
  1470.              "Add a new blind carbon copy recipient")
  1471.       ("Add cc" (MM.ADD.RECIPIENT (GETPROMPTWINDOW ,WINDOW)
  1472.                        'cc)
  1473.              "Add a new carbon copy recipient")
  1474.       ("Add To" (MM.ADD.RECIPIENT (GETPROMPTWINDOW ,WINDOW)
  1475.                        'To)
  1476.              "Add a new primary recipient")
  1477.       (Send (MM.SENDMESSAGE ,WINDOW)
  1478.             "Queue this message for delivery"
  1479.             (SUBITEMS ("Add Line Breaks" (RESETVAR MM.TEDIT.FIXUPFLG T
  1480.                                           (MM.SENDMESSAGE ,WINDOW))
  1481.                              "Add line breaks before sending")
  1482.                    ("Send As Is" (RESETVAR MM.TEDIT.FIXUPFLG NIL
  1483.                                   (MM.SENDMESSAGE ,WINDOW))
  1484.                           "Send the text as is"])
  1485.  
  1486. (MM.ADD.RECIPIENT
  1487.   [LAMBDA (WINDOW LIST)                                  (* ; "Edited 19-Feb-88 12:40 by MRC")
  1488.                                                              (* ; 
  1489.                                                            "Add recipient to a recipient list")
  1490.     (RESETFORM (TTYDISPLAYSTREAM WINDOW)
  1491.            (TTY.PROCESS (THIS.PROCESS))
  1492.            (printout WINDOW T)
  1493.            (MTP.ENVELOPE.TOLIST WINDOW (WINDOWPROP WINDOW 'MESSAGE)
  1494.                   LIST)
  1495.            (REDISPLAYW WINDOW])
  1496.  
  1497. (MM.REMOVE
  1498.   [LAMBDA (WINDOW)                   (* ; "Edited 15-Jun-88 15:33 by MRC")
  1499.                                                (* ; 
  1500.                                           "Prompt for and remove a recipient")
  1501.     (LET
  1502.      ((MESSAGE (WINDOWPROP WINDOW 'MESSAGE))
  1503.       RECIPIENT)
  1504.      (with
  1505.       MM.MESSAGE MESSAGE
  1506.       (if [SETQ RECIPIENT
  1507.                (MENU (create
  1508.                       MENU
  1509.                       TITLE _ "Which Recipient?"
  1510.                       ITEMS _ (for ADDRESS in (APPEND To cc bcc)
  1511.                                  collect
  1512.                                  `(,(RFC822.MAILBOX ADDRESS)
  1513.                                    ,(KWOTE ADDRESS)
  1514.                                    "Select this address to remove"]
  1515.           then                             (* ; 
  1516.                           "The SETQ is necessary in case DREMOVE returns NIL")
  1517.           (SETQ cc (DREMOVE RECIPIENT cc))
  1518.           (SETQ bcc (DREMOVE RECIPIENT bcc))
  1519.           [if (NULL (SETQ To (DREMOVE RECIPIENT To)))
  1520.               then (if cc
  1521.                            then (SETQ To cc)
  1522.                                  (SETQ cc NIL)
  1523.                          else (RESETFORM (TTYDISPLAYSTREAM WINDOW)
  1524.                                          (TTY.PROCESS (THIS.PROCESS))
  1525.                                          (printout WINDOW T)
  1526.                                          (while (NULL To)
  1527.                                             do (MTP.ENVELOPE.TOLIST
  1528.                                                     WINDOW MESSAGE 'To]
  1529.           (REDISPLAYW WINDOW])
  1530.  
  1531. (MM.SUBJECT
  1532.   [LAMBDA (WINDOW)                                       (* ; "Edited 19-Feb-88 12:39 by MRC")
  1533.                                                              (* ; 
  1534.                                                            "Change the subject of this message")
  1535.     (RESETFORM (TTYDISPLAYSTREAM WINDOW)
  1536.            (TTY.PROCESS (THIS.PROCESS))
  1537.            (printout WINDOW T)
  1538.            (MTP.ENVELOPE.SUBJECT WINDOW (WINDOWPROP WINDOW 'MESSAGE))
  1539.            (REDISPLAYW WINDOW])
  1540.  
  1541. (MM.REPAINT.ENVELOPE
  1542.   [LAMBDA (WINDOW REGION)                                (* ; "Edited  6-Jul-87 15:38 by MRC")
  1543.                                                              (* ; "Repaint the envelope window")
  1544.     (MOVETOUPPERLEFT WINDOW REGION)
  1545.     (printout WINDOW (MTP.DISPLAY.ENVELOPE (WINDOWPROP WINDOW 'MESSAGE])
  1546.  
  1547. (MM.SENDMESSAGE
  1548.   [LAMBDA (WINDOW)                                       (* ; "Edited 13-Apr-88 18:21 by MRC")
  1549.                                                              (* ; 
  1550.                                                          "Deliver message and close compose window")
  1551.     (LET
  1552.      ((MESSAGE (WINDOWPROP WINDOW 'MESSAGE))
  1553.       (REPLYRECORD (WINDOWPROP WINDOW 'REPLYRECORD))
  1554.       (PROMPTSTREAM (GETPROMPTWINDOW WINDOW))
  1555.       [TSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH NIL '((EOL CRLF]
  1556.       (SSTREAM (CL:MAKE-STRING-OUTPUT-STREAM))
  1557.       REPLYWINDOW REPLYSTREAM MSGNO)
  1558.      (if MM.TEDIT.FIXUPFLG
  1559.          then (PRINTOUT PROMPTSTREAM T "Checking for long lines...") 
  1560.                                                              (* ; 
  1561.                                                            "Warning, assumes fixed pitch font")
  1562.                (MM.TEDIT.FIXUP (TEXTSTREAM WINDOW))
  1563.                (PRINTOUT PROMPTSTREAM " done." T))
  1564.      (COPYCHARS (COERCETEXTOBJ (TEXTSTREAM WINDOW)
  1565.                        'STREAM)
  1566.             TSTREAM)
  1567.      (SETFILEPTR TSTREAM 0)
  1568.      (COPYBYTES TSTREAM SSTREAM)
  1569.      (WINDOWPROP WINDOW 'ICON MM.ALIENMAILCARRIERICON)
  1570.      (WINDOWPROP WINDOW 'ICONWINDOW NIL)
  1571.      (SHRINKW WINDOW)
  1572.      (with
  1573.       MM.MESSAGE MESSAGE (SETQ Body (CL:GET-OUTPUT-STREAM-STRING SSTREAM))
  1574.       (SHRINKW WINDOW)
  1575.       (for host inside MM.SERVICEHOSTS
  1576.          do
  1577.          (if (MTP.MAIL PROMPTWINDOW MESSAGE host)
  1578.              then (if [AND REPLYRECORD (SETQ MSGNO (fetch (MM.CACHE Msg#) of 
  1579.                                                                                           REPLYRECORD
  1580.                                                                   ))
  1581.                                    [OPENWP (SETQ REPLYWINDOW (WINDOWPROP WINDOW 'REPLYWINDOW]
  1582.                                    (OPENP (SETQ REPLYSTREAM (WINDOWPROP REPLYWINDOW 'TSTREAM]
  1583.                           then (MAP.SETFLAG REPLYSTREAM MSGNO '\Answered)
  1584.                                 (MM.UPDATE REPLYWINDOW MSGNO))
  1585.                    (TEDIT.KILL WINDOW)
  1586.                    (CLOSEW WINDOW)
  1587.                    (RETURN)
  1588.            else (if Error
  1589.                         then (printout PROMPTWINDOW T "Queue to " host " failed: " Error)
  1590.                       else                               (* ; 
  1591.                                 "The strange-looking LIST is because they are fields of MM.MESSAGE")
  1592.                             [for FIELD in (LIST To cc bcc)
  1593.                                do (for ITEM in FIELD
  1594.                                          do (with MM.ADDRESS ITEM
  1595.                                                        (if RcptError
  1596.                                                            then (printout PROMPTSTREAM T 
  1597.                                                                            "Recipient " (SMTP.MAILBOX
  1598.                                                                                          ITEM)
  1599.                                                                            " failed: " RcptError)
  1600.                                                                  (SETQ RcptError NIL]
  1601.                             (WINDOWPROP WINDOW 'ICON MM.ENVELOPEICON)
  1602.                             (WINDOWPROP WINDOW 'ICONWINDOW NIL)
  1603.                             (EXPANDW WINDOW)
  1604.                             (RETURN])
  1605.  
  1606. (MM.COMPOSEQUIT
  1607.   [LAMBDA (WINDOW)                                       (* ; "Edited 28-Apr-88 15:32 by cdl")
  1608.                                                              (* ; 
  1609.                                           "Break window circularities so it gets garbage collected")
  1610.     [if MM.REMEMBER.POSITIONS
  1611.         then (WINDOWADDPROP (OR (WINDOWPROP WINDOW 'REPLYWINDOW)
  1612.                                     MM.WINDOW)
  1613.                         'MM.POSITIONS
  1614.                         (CONS 'COMPOSE (with REGION (WINDOWPROP WINDOW 'REGION)
  1615.                                               (CREATEPOSITION LEFT BOTTOM]
  1616.     (WINDOWPROP WINDOW 'MESSAGE NIL)
  1617.     (WINDOWPROP WINDOW 'ENVELOPEWINDOW NIL)
  1618.     (WINDOWPROP WINDOW 'REPLYRECORD NIL)
  1619.     (WINDOWPROP WINDOW 'REPLYWINDOW NIL)
  1620.     (DETACHALLWINDOWS WINDOW)
  1621.     (WINDOWPROP WINDOW 'ATTACHEDWINDOWS NIL])
  1622. )
  1623.  
  1624.  
  1625.  
  1626. (* ; "Utility functions")
  1627.  
  1628. (DEFINEQ
  1629.  
  1630. (MM.SERVICEHOST
  1631.   [LAMBDA NIL                                            (* ; "Edited 23-Mar-88 12:39 by cdl")
  1632.                                                              (* ; "Returns name of service host")
  1633.     (DECLARE (GLOBALVARS LOGINHOST/DIR))
  1634.     (if (LISTP MM.SERVICEHOSTS)
  1635.         then (CAR MM.SERVICEHOSTS)
  1636.       else (OR MM.SERVICEHOSTS (SETQ MM.SERVICEHOSTS (MKATOM (DOMAIN.LOOKUP.NAME
  1637.                                                                   (DOMAIN.HOSTP (FILENAMEFIELD
  1638.                                                                                  LOGINHOST/DIR
  1639.                                                                                  'HOST])
  1640.  
  1641. (MM.PROMPTFORMAILBOX
  1642.   [LAMBDA (WINDOW)                                       (* ; "Edited 25-Apr-88 08:48 by cdl")
  1643.                                                              (* ; 
  1644.                                                            "Prompt for a destination mailbox")
  1645.     (LET ((MAILBOX (MM.PROMPTFORLINE "Destination mailbox on this repository: " 'INBOX WINDOW))
  1646.           (MAILBOXHOST (FILENAMEFIELD (WINDOWPROP WINDOW 'MAILBOXNAME)
  1647.                               'HOST))
  1648.           HOST)
  1649.          (if MAILBOX
  1650.              then (SETQ HOST (FILENAMEFIELD MAILBOX 'HOST))
  1651.                    (if (OR (NULL HOST)
  1652.                                (EQUAL HOST MAILBOXHOST)
  1653.                                (EQUAL (DODIP.HOSTP HOST)
  1654.                                       (DODIP.HOSTP MAILBOXHOST))
  1655.                                (MOUSECONFIRM NIL 
  1656.                "Copying between servers not implemented; Left to copy to this server, right to abort"
  1657.                                       (GETPROMPTWINDOW WINDOW)))
  1658.                        then (PACKFILENAME 'HOST NIL 'BODY MAILBOX])
  1659.  
  1660. (MM.PROMPTFORLINE
  1661.   [LAMBDA (PROMPT DEFAULT MAINWINDOW)                    (* ; "Edited 28-Mar-88 15:16 by cdl")
  1662.                                                              (* ; 
  1663.                                                      "Prompts for a text line in the prompt window")
  1664.     (LET ((WINDOW (GETPROMPTWINDOW MAINWINDOW)))
  1665.          (printout WINDOW T)
  1666.          (OR (RESETLST
  1667.                  (RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
  1668.                  (RESETSAVE (TTYDISPLAYSTREAM WINDOW))
  1669.                  (TTYIN PROMPT NIL NIL '(STRING NORAISE)))
  1670.              DEFAULT])
  1671.  
  1672. (MM.MAILBOX
  1673.   [LAMBDA NIL                                            (* ; "Edited 23-Mar-88 17:36 by cdl")
  1674.                                                              (* ; "Return a mailbox name")
  1675.     (MENU (create MENU
  1676.                  TITLE _ "Which mailbox?"
  1677.                  ITEMS _ MM.MAILBOXES])
  1678.  
  1679. (MM.MENU
  1680.   [LAMBDA (MENU)                                         (* ; "Edited 10-Mar-88 12:13 by MRC")
  1681.                                                              (* ; 
  1682.              "Jacket into MENU function, handles case of NIL menu and a selection that returns NIL")
  1683.     (if MENU
  1684.         then (LIST (MENU MENU])
  1685.  
  1686. (MM.ICONFN
  1687.   [LAMBDA (WINDOW)                                       (* ; "Edited  6-May-88 15:05 by MRC")
  1688.                                                              (* ; 
  1689.                                                            "Put up an icon when window is shrunk")
  1690.     (OR (WINDOWPROP WINDOW 'ICONWINDOW)
  1691.         (LET [(ICON (WINDOWPROP WINDOW 'ICON]
  1692.              (if (OR (NULL ICON)
  1693.                          (with TITLEDICON ICON TITLEREG))
  1694.                  then (TITLEDICONW ICON (WINDOWPROP WINDOW 'TITLE)
  1695.                                  MM.ICONFONT NIL T)
  1696.                else (with TITLEDICON ICON (ICONW ICON MASK (with REGION
  1697.                                                                           (WINDOWPROP WINDOW
  1698.                                                                                  'REGION)
  1699.                                                                           (CREATEPOSITION LEFT BOTTOM
  1700.                                                                                  ))
  1701.                                                          T])
  1702.  
  1703. (MM.GET.WINDOW.REGION
  1704.   [LAMBDA (SIZE TYPE WINDOW)                             (* ; "Edited 29-Apr-88 17:01 by MRC")
  1705.                                                              (* ; "Get a region for a window")
  1706.     (DECLARE (GLOBALVARS DEFAULTFONT))
  1707.     (LET (REGION POSITION)
  1708.          (with REGION [SETQ REGION (with
  1709.                                         POSITION SIZE
  1710.                                         (CREATEREGION NIL NIL
  1711.                                                [WIDTHIFWINDOW
  1712.                                                 (ADD1 (PLUS (TIMES XCOORD (CHARWIDTH (CHARCODE A)
  1713.                                                                                  DEFAULTFONT))
  1714.                                                             (PROGN 
  1715.                                                              (* ; "Add in TEdit's cursor margins")
  1716.                                                                    16]
  1717.                                                (HEIGHTIFWINDOW (TIMES YCOORD (FONTPROP DEFAULTFONT
  1718.                                                                                     'HEIGHT))
  1719.                                                       T]
  1720.                 (if [AND MM.REMEMBER.POSITIONS (SETQ POSITION (ASSOC TYPE (WINDOWPROP
  1721.                                                                                WINDOW
  1722.                                                                                'MM.POSITIONS]
  1723.                     then (WINDOWDELPROP WINDOW 'MM.POSITIONS POSITION)
  1724.                           (with POSITION (CDR POSITION)
  1725.                                  (SETQ LEFT XCOORD)
  1726.                                  (SETQ BOTTOM YCOORD))
  1727.                           REGION
  1728.                   else (GETBOXREGION WIDTH HEIGHT])
  1729.  
  1730. (MM.FLAGMENUITEMS
  1731.   [LAMBDA (WINDOW FUNCTION FUNARG)                       (* ; "Edited 28-Mar-88 16:02 by cdl")
  1732.                                                              (* ; 
  1733.                                                         "Return a flag item list for flag submenu.")
  1734.  
  1735.     (* ;; "   FUNCTION may be a real function (for setting or clearing flags) or, for SELECT, may be %"KEYWORD%" or %"UNKEYWORD%".")
  1736.  
  1737.     (* ;; "  The FUNARG argument can only be given if there is a sequence in effect (ugh).")
  1738.  
  1739.     (LET [(FLAGLST (WINDOWPROP WINDOW 'FLAGLST]
  1740.          `(SUBITEMS ,@(SELECTQ FUNCTION
  1741.                           ((KEYWORD UNKEYWORD) 
  1742.                                (for FLAG in FLAGLST
  1743.                                   collect (LIST FLAG `(MM.SELECT ,WINDOW
  1744.                                                                  '(,FUNCTION ,FLAG)
  1745.                                                                  ,FUNARG)
  1746.                                                     "Select this keyword")
  1747.                                   unless (FMEMB FLAG MM.SYSTEM.FLAGS)))
  1748.                           (for FLAG in FLAGLST
  1749.                              collect (LIST FLAG [if FUNARG
  1750.                                                         then `(,FUNCTION ,WINDOW SEQUENCE
  1751.                                                                    ,FUNARG
  1752.                                                                    ,(KWOTE FLAG))
  1753.                                                       else `(,FUNCTION ,WINDOW
  1754.                                                                  ,(KWOTE FLAG]
  1755.                                                "Select this keyword")
  1756.                              unless (FMEMB FLAG '(\Flagged \Deleted])
  1757.  
  1758. (MM.DOSEQUENCE
  1759.   [LAMBDA (WINDOW SEQUENCE MANIPULATEFN MANIPULATEFNARG) (* ; "Edited  6-Apr-88 17:59 by MRC")
  1760.                                                              (* ; 
  1761.                                                            "Perform an operation on a sequence")
  1762.     (if SEQUENCE
  1763.         then (LET ((STREAM (WINDOWPROP WINDOW 'TSTREAM))
  1764.                        SEQ)
  1765.                       (for MSGNO inside SEQUENCE
  1766.                          do (SETQ SEQ (if SEQ
  1767.                                               then (CONCAT SEQ "," MSGNO)
  1768.                                             else MSGNO)))
  1769.                       (APPLY* MANIPULATEFN (WINDOWPROP WINDOW 'TSTREAM)
  1770.                              SEQ MANIPULATEFNARG)
  1771.                       (for MSGNO inside SEQUENCE do (MM.UPDATE WINDOW MSGNO])
  1772.  
  1773. (MM.ADDNEWMESSAGES
  1774.   [LAMBDA (WINDOW)                                       (* ; "Edited 26-May-88 10:20 by cdl")
  1775.                                                              (* ; 
  1776.                                                            "Adds any new messages to the browser")
  1777.     (LET ((STREAM (WINDOWPROP WINDOW 'TSTREAM))
  1778.           (BROWSER (WINDOWPROP WINDOW 'TABLEBROWSER))
  1779.           (MESSAGEARRAY (WINDOWPROP WINDOW 'MESSAGEARRAY))
  1780.           (REDISPLAYMSGS (WINDOWPROP WINDOW 'REDISPLAYMSGS NIL))
  1781.           CURRENT NEW)
  1782.          (if (AND STREAM BROWSER MESSAGEARRAY)
  1783.              then (if [AND (NEQ (SETQ CURRENT (WINDOWPROP WINDOW 'NMSGS))
  1784.                                         (SETQ NEW (GETSTREAMPROP STREAM 'NMSGS]
  1785.                           then [if (LESSP CURRENT NEW)
  1786.                                        then (add CURRENT 1)
  1787.                                              (for MSGNO from CURRENT to NEW
  1788.                                                 do (TB.INSERT.ITEM BROWSER
  1789.                                                               (MM.TABLEITEM STREAM MESSAGEARRAY 
  1790.                                                                      MSGNO NIL]
  1791.                                 (WINDOWPROP WINDOW 'NMSGS NEW)
  1792.                                 (WINDOWPROP WINDOW 'TITLE (MM.MAILBOXWINDOWTITLE
  1793.                                                            (WINDOWPROP WINDOW 'MAILBOXNAME)
  1794.                                                            NEW)))
  1795.                    (for ITEM in REDISPLAYMSGS do (MM.UPDATE WINDOW
  1796.                                                                     (MM.TBPROP ITEM 'MSGNO])
  1797.  
  1798. (MM.EXISTS
  1799.   [LAMBDA (NMSGS STREAM)                                 (* ; "Edited 20-May-88 11:47 by MRC")
  1800.                                                              (* ; 
  1801.                               "Called by Mail Access Protocol when notifying of a new mailbox size")
  1802.     (LET ((MESSAGEARRAY (GETSTREAMPROP STREAM 'MESSAGEARRAY))
  1803.           (CURRENT (STREAMPROP STREAM 'NMSGS))
  1804.           (WINDOW (STREAMPROP STREAM 'TWINDOW))
  1805.           DELTA)
  1806.          (SETQ WINDOW (if WINDOW
  1807.                           then (GETPROMPTWINDOW WINDOW)
  1808.                         else PROMPTWINDOW))
  1809.          (if CURRENT
  1810.              then (SETQ DELTA (DIFFERENCE NMSGS CURRENT))
  1811.                    [COND
  1812.                       ((MINUSP DELTA)
  1813.                        (ERROR "Mailbox shrunk"))
  1814.                       ((ZEROP DELTA)
  1815.                        NIL)
  1816.                       (T (if (EQ DELTA 1)
  1817.                              then (printout WINDOW T "There is 1 new message.  ")
  1818.                            else (printout WINDOW T "There are " DELTA " new messages.  "))
  1819.                                                              (* ; 
  1820.               "Extra spaces after message are so that 'Check completed' message can follow cleanly")
  1821.                          (CL:ADJUST-ARRAY MESSAGEARRAY NMSGS)
  1822.                          (for i from CURRENT to NMSGS
  1823.                             do (CL:SETF (CL:AREF MESSAGEARRAY (SUB1 i))
  1824.                                           NIL)
  1825.                                   (MAP.ELT MESSAGEARRAY i]
  1826.            else (printout WINDOW T (if (EQ NMSGS 1)
  1827.                                            then "There is 1 message."
  1828.                                          else (CONCAT "There are " NMSGS " messages."])
  1829.  
  1830. (MM.EXPUNGED
  1831.   [LAMBDA (WINDOW MSG)                                   (* ; "Edited 26-May-88 10:16 by cdl")
  1832.                                                              (* ; 
  1833.                              "Called by Mail Access Protocol when notifying of an expunged message")
  1834.     (LET [(MESSAGEARRAY (WINDOWPROP WINDOW 'MESSAGEARRAY))
  1835.           (BROWSER (WINDOWPROP WINDOW 'TABLEBROWSER))
  1836.           (NMSGS (WINDOWPROP WINDOW 'NMSGS]
  1837.          (WINDOWPROP WINDOW 'NMSGS (add NMSGS -1))
  1838.          (TB.REMOVE.ITEM BROWSER (TB.NTH.ITEM BROWSER MSG))
  1839.          (replace (MM.CACHE Msg#) of (CL:AREF MESSAGEARRAY (SUB1 MSG)) with NIL)
  1840.          (if (LEQ MSG NMSGS)
  1841.              then (for i from MSG to NMSGS
  1842.                          do (CL:SETF (CL:AREF MESSAGEARRAY (SUB1 i))
  1843.                                        (CL:AREF MESSAGEARRAY i))
  1844.                                (replace (MM.CACHE Msg#) of (CL:AREF MESSAGEARRAY (SUB1 i))
  1845.                                   with i)
  1846.                                (LISTPUT (fetch (TABLEITEM TIDATA) of (TB.NTH.ITEM BROWSER i))
  1847.                                       'MSGNO i)))
  1848.          (CL:SETF (CL:AREF MESSAGEARRAY NMSGS)
  1849.                 NIL])
  1850.  
  1851. (MM.SEARCHED
  1852.   [LAMBDA (WINDOW MSGNO)                                 (* ; "Edited 25-Apr-88 13:51 by cdl")
  1853.                                                              (* ; 
  1854.                                                         "Here when a message has been searched out")
  1855.     (LET ((BROWSER (WINDOWPROP WINDOW 'TABLEBROWSER))
  1856.           ITEM)
  1857.          (if (SETQ ITEM (MM.FIND.TABLEITEM BROWSER MSGNO))
  1858.              then (TB.SELECT.ITEM BROWSER ITEM])
  1859.  
  1860. (MM.LOCK
  1861.   [LAMBDA (STREAM)                                       (* ; "Edited  6-Apr-88 18:36 by MRC")
  1862.                                                              (* ; 
  1863.                                                            "Put an MM command lock on the stream")
  1864.     (if (AND STREAM (PUTSTREAMPROP STREAM 'MMLOCK T))
  1865.         then (printout (GETPROMPTWINDOW (STREAMPROP STREAM 'TWINDOW))
  1866.                         T "MM command in progress, please wait")
  1867.               NIL
  1868.       else T])
  1869.  
  1870. (MM.UNLOCK
  1871.   [LAMBDA (STREAM)                                       (* ; "Edited  6-Apr-88 18:37 by MRC")
  1872.                                                              (* ; "Release the MM command lock")
  1873.     (if (NOT (AND STREAM (PUTSTREAMPROP STREAM 'MMLOCK NIL)))
  1874.         then (ERROR "MM unlock when already unlocked"])
  1875.  
  1876. (MM.YCOORD.FROM.ITEM
  1877.   [LAMBDA (BROWSER ITEM)                                 (* ; "Edited 26-May-88 09:13 by cdl")
  1878.     (DIFFERENCE (fetch (TABLEBROWSER TBORIGIN) of BROWSER)
  1879.            (TIMES (fetch (TABLEBROWSER TBFONTHEIGHT) of BROWSER)
  1880.                   (OR (FIXP ITEM)
  1881.                       (fetch (TABLEITEM TI#) of ITEM])
  1882. )
  1883.  
  1884.  
  1885.  
  1886. (* ; "TEdit plain text utility functions")
  1887.  
  1888. (DEFINEQ
  1889.  
  1890. (MM.TEDIT.FIXUP
  1891.   [LAMBDA (STREAM)                                       (* ; "Edited 29-Apr-88 17:04 by MRC")
  1892.                                                              (* ; 
  1893.                                                          "Put in line breaks at appropriate places")
  1894.     (DECLARE (SPECVARS STREAM))
  1895.     (RESETLST
  1896.         [RESETSAVE (SETFILEPTR STREAM 0)
  1897.                `(SETFILEPTR ,STREAM ,(GETFILEPTR STREAM]
  1898.         [bind (CHARPTR _ 0)
  1899.                (LINELENGTH _ (QUOTIENT (with REGION (DSPCLIPPINGREGION NIL (\TEDIT.MAINW STREAM))
  1900.                                                              (* ; "Adjust for TEdit cursor margin")
  1901.                                               (DIFFERENCE WIDTH 16))
  1902.                                     (CHARWIDTH (CHARCODE A)
  1903.                                            STREAM)))
  1904.                (LINEPTR _ 0)
  1905.                CH declare%: (SPECVARS LINEPTR CH) until (EOFP STREAM)
  1906.            do (SELCHARQ (BIN STREAM)
  1907.                        (EOL (SETQ CHARPTR 0)
  1908.                             (SETQ LINEPTR (GETFILEPTR STREAM)))
  1909.                        (TAB (SETQ CHARPTR (TIMES (ADD1 (QUOTIENT CHARPTR MM.TEDIT.TABWIDTH))
  1910.                                                  MM.TEDIT.TABWIDTH)))
  1911.                        (ADD1VAR CHARPTR))
  1912.                  (if (GREATERP CHARPTR LINELENGTH)
  1913.                      then (RESETLST
  1914.                                   [RESETSAVE NIL `(SETFILEPTR ,STREAM ,(GETFILEPTR STREAM]
  1915.                                   [if (SETQ CH (for FILEPTR from (SUB1 (GETFILEPTR STREAM
  1916.                                                                                           ))
  1917.                                                       to LINEPTR by -1
  1918.                                                       eachtime (SETFILEPTR STREAM FILEPTR)
  1919.                                                       thereis (SELCHARQ (BIN STREAM)
  1920.                                                                        (SPACE T)
  1921.                                                                        NIL)))
  1922.                                       then (ADD1VAR CH)
  1923.                                             (TEDIT.SETSEL STREAM CH 1 NIL T)
  1924.                                             (TEDIT.INSERT STREAM (CHARACTER (CHARCODE EOL])
  1925.                            (if CH
  1926.                                then (SETQ LINEPTR CH)
  1927.                                      (SETQ CHARPTR (DIFFERENCE (GETFILEPTR STREAM)
  1928.                                                           LINEPTR))
  1929.                              else                        (* ; 
  1930.                                                      "Don't keep looking at unbroken block of text")
  1931.                                    (add LINEPTR CHARPTR])])
  1932.  
  1933. (MM.TEDIT.STRIPEOLS
  1934.   [LAMBDA (TEXTOBJ)                                      (* ; "Edited 29-Apr-88 17:04 by MRC")
  1935.                                                              (* ; 
  1936.                                        "Replace all the EOLs with SPACEs in the current selection.")
  1937.     (LET* ((STREAM (TEXTSTREAM TEXTOBJ))
  1938.            (SELECTION (TEDIT.GETSEL STREAM)))
  1939.           (LET ((CH# (fetch (SELECTION CH#) of SELECTION))
  1940.                 (CHLIM (fetch (SELECTION CHLIM) of SELECTION)))
  1941.                (while (SETQ CH# (TEDIT.FIND (TEXTOBJ STREAM)
  1942.                                            [CONSTANT (MKSTRING (CHARACTER (CHARCODE EOL]
  1943.                                            CH# CHLIM))
  1944.                   do (if (AND (NOT (EOFP STREAM))
  1945.                                       (NEQ (CHARCODE EOL)
  1946.                                            (\PEEKBIN STREAM)))
  1947.                              then (TEDIT.SETSEL STREAM CH# 1 'RIGHT T)
  1948.                                    [TEDIT.INSERT STREAM (CONSTANT (MKSTRING (CHARACTER (CHARCODE
  1949.                                                                                         SPACE]
  1950.                            else (ADD1VAR CH#))
  1951.                         (ADD1VAR CH#) finally (TEDIT.SETSEL STREAM CHLIM 0])
  1952. )
  1953.  
  1954.  
  1955.  
  1956. (* ; "User-settable parameters")
  1957.  
  1958.  
  1959. (RPAQ? MM.SERVICEHOSTS NIL)
  1960.  
  1961. (RPAQ? MM.PERSONALNAME NIL)
  1962.  
  1963. (RPAQ? MM.PRIMARYMAILMENUFONT '(GACHA 10))
  1964.  
  1965. (RPAQ? MM.ICONFONT '(HELVETICA 8))
  1966.  
  1967. (RPAQ? MM.MAXIMUMDISPLAYEDMESSAGES 40)
  1968.  
  1969. (RPAQ? MM.MINIMUMDISPLAYEDMESSAGES 20)
  1970.  
  1971. (RPAQ? MM.MAXFROMLENGTH 20)
  1972.  
  1973. (RPAQ? MM.MAXSUBJECTLENGTH 35)
  1974.  
  1975. (RPAQ? MM.READWINDOWSIZE (CREATEPOSITION 80 24))
  1976.  
  1977. (RPAQ? MM.COMPOSEWINDOWSIZE (CREATEPOSITION 78 24))
  1978.  
  1979. (RPAQ? MM.DEFAULT.CC NIL)
  1980.  
  1981. (RPAQ? MM.DEFAULT.BCC NIL)
  1982.  
  1983. (RPAQ? MM.LIST.CONSECUTIVE.INDEX T)
  1984.  
  1985. (RPAQ? MM.LIST.ON.SEPARATE.PAGES NIL)
  1986.  
  1987. (RPAQ? MM.LIST.INCLUDE.HEADERS NIL)
  1988.  
  1989. (RPAQ? MM.LIST.HOST NIL)
  1990.  
  1991. (RPAQ? MM.DEFAULT.SEARCH.PATTERN "*.TXT")
  1992.  
  1993. (RPAQ? MM.REMEMBER.POSITIONS T)
  1994.  
  1995. (RPAQ? MM.WINDOW NIL)
  1996.  
  1997. (RPAQ? MM.MAILBOXES NIL)
  1998.  
  1999. (RPAQ? MM.SYSTEM.FLAGS '(\Flagged \Deleted \Answered \Seen \XXXX \YYYY))
  2000.  
  2001. (RPAQ? MM.TEDIT.MENU NIL)
  2002.  
  2003. (RPAQ? MM.TEDIT.TABWIDTH 8)
  2004.  
  2005. (RPAQ? MM.TEDIT.FIXUPFLG T)
  2006.  
  2007.  
  2008.  
  2009. (* ; "Declare all globals")
  2010.  
  2011.  
  2012.  
  2013.  
  2014. (* ; "Maximum header line length --- See MM.HEADERLINE for the fields")
  2015.  
  2016.  
  2017. (RPAQ MM.MAXIMUMHEADERLINELENGTH (PLUS (NCHARS "NUFAD 10-Jan ")
  2018.                                            MM.MAXFROMLENGTH 1 
  2019.                                            MM.MAXSUBJECTLENGTH
  2020.                                            (NCHARS " (9999999 chars)")))
  2021. (DECLARE%: DOEVAL@COMPILE DONTCOPY
  2022.  
  2023. (GLOBALVARS MM.SERVICEHOSTS MM.PERSONALNAME MM.PRIMARYMAILMENUFONT MM.ICONFONT
  2024.        MM.MAXIMUMDISPLAYEDMESSAGES MM.MINIMUMDISPLAYEDMESSAGES MM.MAXFROMLENGTH
  2025.        MM.MAXSUBJECTLENGTH MM.READWINDOWSIZE MM.COMPOSEWINDOWSIZE MM.DEFAULT.CC
  2026.        MM.DEFAULT.BCC MM.LIST.CONSECUTIVE.INDEX MM.LIST.ON.SEPARATE.PAGES 
  2027.        MM.LIST.INCLUDE.HEADERS MM.LIST.HOST MM.DEFAULT.SEARCH.PATTERN 
  2028.        MM.REMEMBER.POSITIONS MM.WINDOW MM.MAILBOXES MM.SYSTEM.FLAGS 
  2029.        MM.TEDIT.MENU MM.TEDIT.TABWIDTH MM.TEDIT.FIXUPFLG MM.COMPOSEMENUITEMS 
  2030.        MM.MAXIMUMHEADERLINELENGTH)
  2031. )
  2032.  
  2033.  
  2034.  
  2035. (* ; "Records")
  2036.  
  2037. (DECLARE%: EVAL@COMPILE
  2038.  
  2039. (RECORD MM.CACHE (Msg# InternalDate Flags Envelope RFC822.Size FromText 
  2040.                            SubjectText RFC822.Header RFC822.Stream))
  2041.  
  2042. (RECORD MM.MESSAGE 
  2043.         (Date Subject From Sender Reply-To To cc bcc In-Reply-To Message-ID 
  2044.               Return-Path Body Error))
  2045.  
  2046. (RECORD MM.ADDRESS (PersonalName RouteList Mailbox Host Extra RcptError))
  2047.  
  2048. (RECORD MM.ZOOMDATA (NewItems OldItems FirstVisibleItem))
  2049. )
  2050.  
  2051.  
  2052.  
  2053. (* ; "Other mailsystem globals")
  2054.  
  2055. (DECLARE%: DOEVAL@COMPILE DONTCOPY
  2056.  
  2057. (GLOBALVARS MAP.LOOKAHEAD)
  2058. )
  2059.  
  2060.  
  2061.  
  2062. (* ; "System globals")
  2063.  
  2064. (DECLARE%: DOEVAL@COMPILE DONTCOPY
  2065.  
  2066. (GLOBALVARS PROMPTWINDOW LOGINHOST/DIR TEDIT.DEFAULT.MENU)
  2067. )
  2068.  
  2069.  
  2070.  
  2071. (* ; "At compile time, also need EXPORTS.ALL for records such as TITLEDICON.")
  2072.  
  2073. (DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE 
  2074.  
  2075. (FILESLOAD TABLEBROWSERDECLS)
  2076. )
  2077.  
  2078.  
  2079.  
  2080. (* ; "Auxillary modules")
  2081.  
  2082.  
  2083. (FILESLOAD IMAP2 SMTP MMICONS)
  2084. (DECLARE%: DONTCOPY
  2085.   (FILEMAP (NIL (9046 16490 (MM 9056 . 12876) (MM.PRIMARYMAILMENU 12878 . 14405) (
  2086. MM.ADDNEWMAILBOX 14407 . 15144) (MM.SEARCHFORMAILBOXES 15146 . 16488)) (16536 
  2087. 41635 (MM.CREATEMAILBOXWINDOW 16546 . 20467) (MM.MAILBOXWINDOW 20469 . 22233) (
  2088. MM.FLAGMENU 22235 . 22742) (MM.MAILBOXWINDOWTITLE 22744 . 23116) (
  2089. MM.CREATEMAILBOXTB 23118 . 24902) (MM.MAILBOXMENU 24904 . 26414) (
  2090. MM.COMMANDMENUITEMS 26416 . 27645) (MM.MAILBOXMENUITEMS 27647 . 31302) (
  2091. MM.TBPRINTFN 31304 . 33624) (MM.TABLEITEM 33626 . 34003) (MM.UPDATE 34005 . 
  2092. 34524) (MM.TBPROP 34526 . 34895) (MM.HEADERLINE 34897 . 39364) (
  2093. MM.CLOSEMAILBOXWINDOW 39366 . 41127) (MM.FIND.TABLEITEM 41129 . 41633)) (41680 
  2094. 64600 (MM.NEWMAILBOX 41690 . 43064) (MM.SELECTMESSAGES 43066 . 44359) (
  2095. MM.DOSELECTION 44361 . 45019) (MM.SELECTMENUITEMS 45021 . 50123) (MM.SELECT 
  2096. 50125 . 52298) (MM.HARDCOPY 52300 . 55368) (MM.QUIT 55370 . 55771) (MM.EXIT 
  2097. 55773 . 56226) (MM.CHECKMAILBOX 56228 . 56673) (MM.CHECKENTIREMAILBOX 56675 . 
  2098. 57181) (MM.EXPUNGEMAILBOX 57183 . 57893) (MM.TOGGLE.SELECTED 57895 . 61582) (
  2099. MM.TOGGLED.SELECTEDFN 61584 . 62408) (MM.REPLACE.TABLEITEMS 62410 . 64598)) (
  2100. 64643 81029 (MM.READMESSAGE 64653 . 65310) (MM.TEDITMESSAGE 65312 . 67743) (
  2101. MM.READMENUITEMS 67745 . 69830) (MM.READCOMMANDMENUITEMS 69832 . 70435) (
  2102. MM.READCLOSE 70437 . 71908) (MM.SETFLAG 71910 . 72834) (MM.CLEARFLAG 72836 . 
  2103. 73843) (MM.REPLYMESSAGE 73845 . 74300) (MM.HARDCOPYMESSAGE 74302 . 74759) (
  2104. MM.COPYMESSAGE 74761 . 75366) (MM.MOVEMESSAGE 75368 . 76165) (MM.NEXTMESSAGE 
  2105. 76167 . 77883) (MM.PREVIOUSMESSAGE 77885 . 79612) (MM.KILLMESSAGE 79614 . 80205)
  2106.  (MM.MOVETOMESSAGE 80207 . 81027)) (81288 98840 (MM.COMPOSEMESSAGE 81298 . 84648
  2107. ) (MM.REPLY 84650 . 88453) (MM.FROMADDRESS 88455 . 88974) (MM.REPLY.ADDRESS 
  2108. 88976 . 90069) (MM.COMPOSEMENUITEMS 90071 . 91460) (MM.ADD.RECIPIENT 91462 . 
  2109. 91993) (MM.REMOVE 91995 . 93636) (MM.SUBJECT 93638 . 94142) (MM.REPAINT.ENVELOPE
  2110.  94144 . 94481) (MM.SENDMESSAGE 94483 . 97952) (MM.COMPOSEQUIT 97954 . 98838)) (
  2111. 98875 114116 (MM.SERVICEHOST 98885 . 99593) (MM.PROMPTFORMAILBOX 99595 . 100716)
  2112.  (MM.PROMPTFORLINE 100718 . 101314) (MM.MAILBOX 101316 . 101638) (MM.MENU 101640
  2113.  . 101984) (MM.ICONFN 101986 . 103099) (MM.GET.WINDOW.REGION 103101 . 104911) (
  2114. MM.FLAGMENUITEMS 104913 . 106715) (MM.DOSEQUENCE 106717 . 107587) (
  2115. MM.ADDNEWMESSAGES 107589 . 109315) (MM.EXISTS 109317 . 111132) (MM.EXPUNGED 
  2116. 111134 . 112390) (MM.SEARCHED 112392 . 112877) (MM.LOCK 112879 . 113402) (
  2117. MM.UNLOCK 113404 . 113748) (MM.YCOORD.FROM.ITEM 113750 . 114114)) (114168 118344
  2118.  (MM.TEDIT.FIXUP 114178 . 117025) (MM.TEDIT.STRIPEOLS 117027 . 118342)))))
  2119. STOP
  2120.