Annotation of 43BSD/contrib/mh/miscellany/emh/emh-send.ml, revision 1.1.1.1

1.1       root        1: ; emh-send.ml :: implements the emh send commands
                      2: ; Wed Oct  5 03:43:43 1983     /mtr  <mrose@uci-750a>
                      3: 
                      4: 
                      5: (declare-buffer-specific &mhdraft &mhprocess)
                      6: 
                      7: (defun 
                      8:     
                      9:     (&mh-comp &args &buffer &components
                     10:        (setq &args 
                     11:              (if (| prefix-argument-provided (> (nargs) 0))
                     12:                  (arg 1 ": mh-comps (args) ") "components"))
                     13:        (if (! (file-exists (setq &components (&mh-path &args))))
                     14:            (if (!= &args "components")
                     15:                (error-message "no such file as " &components)
                     16:                (if (! (file-exists
                     17:                           (setq &components "/usr/local/lib/mh/components")))
                     18:                    (error-message "no default components file"))))
                     19:        (setq &buffer (&mh-unique "compose"))
                     20:        (error-occured (delete-buffer &buffer))
                     21:        (pop-to-buffer &buffer)
                     22:        (provide-prefix-argument 0 (&mh-finish-build &components))
                     23:        
                     24:        (novalue)
                     25:     )
                     26:     
                     27:     (&mh-forw &args &buffer &folder &msg
                     28:        (setq &args 
                     29:              (if (| prefix-argument-provided (> (nargs) 0))
                     30:                  (arg 1 ": mh-forw (args) ") ""))
                     31:        (save-excursion 
                     32:            (pop-to-buffer (&mh-cur-folder))
                     33:            (setq &folder &mhfolder))
                     34:        (setq &msg (&mh-cur-message))
                     35:        (if (>= (process-status 
                     36:                    (setq &buffer (concat "forward " &folder "/" &msg))) 0)
                     37:            (error-message "already doing forw " &msg))
                     38:        (save-excursion 
                     39:            (temp-use-buffer &buffer)
                     40:            (if (>= (process-status &mhprocess) 0)
                     41:                (error-message "already posting a draft for " &msg)))
                     42:        (error-occured (delete-buffer &buffer))
                     43:        (save-excursion 
                     44:            (temp-use-buffer &buffer)
                     45:            (setq needs-checkpointing 0)
                     46:            (erase-buffer)
                     47:            (setq &mhfolder &folder)
                     48:            (setq &mhmsg &msg)
                     49:            (&mh-start-process
                     50:                (concat "forw " &folder " " &msg
                     51:                        (if (!= &args "") (concat " " &args) "") " -build")
                     52:                &buffer)
                     53:            (insert-sentinel &buffer "&mh-forw-sentinel")
                     54:            (setq mode-string "Starting")
                     55:            (setq mode-line-format "  %b: forw (status: %m)  %M"))
                     56:        (&mh-set-cur &msg)
                     57:        
                     58:        (novalue)
                     59:     )
                     60:     
                     61:     (&mh-forw-sentinel &flag &text
                     62:        (setq &flag (>> prefix-argument 16))
                     63:        (setq &text (process-output))
                     64:        (save-excursion 
                     65:            (temp-use-buffer MPX-process)
                     66:            (setq mode-string (substr &text 1 (- (length &text) 1)))
                     67:            (if (= mode-string "Exited")
                     68:                (provide-prefix-argument 1 (&mh-finish-build "draft"))))
                     69:        (dot-is-visible)        ; hack...
                     70:        (if (bitwise-and &flag 12)
                     71:            (save-excursion (pop-to-buffer MPX-process) (beginning-of-file)))
                     72:     )
                     73:     
                     74:     (&mh-repl &args &buffer &folder &msg
                     75:        (setq &args 
                     76:              (if (| prefix-argument-provided (> (nargs) 0))
                     77:                  (arg 1 ": mh-repl (args) ") ""))
                     78:        (save-excursion 
                     79:            (pop-to-buffer (&mh-cur-folder))
                     80:            (setq &folder &mhfolder))
                     81:        (setq &msg (&mh-cur-message))
                     82:        (if (>= (process-status 
                     83:                    (setq &buffer (concat "reply " &folder "/" &msg))) 0)
                     84:            (error-message "already doing repl " &msg))
                     85:        (save-excursion 
                     86:            (temp-use-buffer &buffer)
                     87:            (if (>= (process-status &mhprocess) 0)
                     88:                (error-message "already posting a reply to " &msg)))
                     89:        (error-occured (delete-buffer &buffer))
                     90:        (save-excursion 
                     91:            (temp-use-buffer &buffer)
                     92:            (setq needs-checkpointing 0)
                     93:            (erase-buffer)
                     94:            (setq &mhfolder &folder)
                     95:            (setq &mhmsg &msg)
                     96:            (&mh-start-process
                     97:                (concat "repl " &folder " " &msg 
                     98:                        (if (!= &args "") (concat " " &args) "") " -build")
                     99:                &buffer)
                    100:            (insert-sentinel &buffer "&mh-repl-sentinel")
                    101:            (setq mode-string "Starting")
                    102:            (setq mode-line-format "  %b: repl (status: %m)  %M"))
                    103:        (&mh-set-cur &msg)
                    104:        
                    105:        (novalue)
                    106:     )
                    107:     
                    108:     (&mh-repl-sentinel &flag &text
                    109:        (setq &flag (>> prefix-argument 16))
                    110:        (setq &text (process-output))
                    111:        (save-excursion 
                    112:            (temp-use-buffer MPX-process)
                    113:            (setq mode-string (substr &text 1 (- (length &text) 1)))
                    114:            (if (= mode-string "Exited")
                    115:                (provide-prefix-argument 1 (&mh-finish-build "reply"))))
                    116:        (dot-is-visible)        ; hack...
                    117:        (if (bitwise-and &flag 12)
                    118:            (save-excursion (pop-to-buffer MPX-process) (beginning-of-file)))
                    119:     )
                    120:     
                    121:     (&mh-finish-build &file &remove
                    122:        (setq &file (&mh-path (arg 1 ": mh-finish-build (from file) ")))
                    123:        (setq &remove prefix-argument)
                    124:        (remove-all-local-bindings)
                    125:        (setq mode-string "Normal")
                    126:        (if (file-exists &file)
                    127:            (progn
                    128:                  (erase-buffer)
                    129:                  (insert-file &file)
                    130:                  (error-occured 
                    131:                      (if (is-bound &mh-draft-automode)
                    132:                          (execute-mlisp-line &mh-draft-automode)
                    133:                          (text-mode)))
                    134:                  (setq mode-line-format
                    135:                        "  %b*: ^X-^S to post (%m) %M %[%p%]")
                    136:                  (local-bind-to-key "&mh-send" "\^X\^S")
                    137:                  (local-bind-to-key "&mh-@-show" "\^X@")
                    138:                  (if &remove
                    139:                      (unlink-file &file)))
                    140:            (setq mode-line-format "  %b: build of draft failed  %M"))
                    141:     )
                    142:     
                    143:     (&mh-send &args &buffer &draft &file
                    144:        (setq &args 
                    145:              (if (| prefix-argument-provided (> (nargs) 0))
                    146:                  (arg 1 ": mh-send (args) ") ""))
                    147:        (if (>= (process-status &mhprocess) 0)
                    148:            (error-message "already sending draft"))
                    149:        (write-named-file
                    150:            (setq &file (concat &mhpath (setq &buffer (&mh-unique &mhexec)))))
                    151:        (error-occured (delete-buffer (setq &mhprocess &buffer)))
                    152:        (setq &draft (current-buffer-name))
                    153:        (setq mode-line-format
                    154:              "  %b*: posting in progress (%m) %M %[%p%]")
                    155:        (delete-window)
                    156:        (save-excursion 
                    157:            (temp-use-buffer &buffer)
                    158:            (setq needs-checkpointing 0)
                    159:            (erase-buffer)
                    160:            (setq &mhdraft &draft) 
                    161:            (local-bind-to-key "&mh-@-show" "\^X@")
                    162:            (&mh-start-process
                    163:                (concat "send " &file (if (!= &args "") (concat " " &args) ""))
                    164:                &buffer)
                    165:            (insert-sentinel &buffer "&mh-send-sentinel")
                    166:            (setq mode-string "Starting")
                    167:            (setq mode-line-format 
                    168:                  (concat "  %b: send of " &draft " (status: %m)  %M")))
                    169:        
                    170:        (novalue)
                    171:     )
                    172:     
                    173:     (&mh-send-sentinel &flag &text
                    174:        (setq &flag (>> prefix-argument 16))
                    175:        (setq &text (process-output))
                    176:        (save-excursion 
                    177:            (temp-use-buffer MPX-process)
                    178:            (setq mode-string (substr &text 1 (- (length &text) 1))))
                    179:        (dot-is-visible)        ; hack...
                    180:        (if (bitwise-and &flag 12)
                    181:            (save-excursion
                    182:                (pop-to-buffer MPX-process)
                    183:                (beginning-of-file)
                    184:                (save-excursion 
                    185:                    (temp-use-buffer &mhdraft)
                    186:                    (if (file-exists (current-file-name))
                    187:                        (setq mode-line-format
                    188:                              (concat "  %b: posting of draft in " 
                    189:                                      MPX-process " failed (%m) %M %[%p%]"))
                    190:                        (delete-buffer (current-buffer-name))))))
                    191:     )
                    192:     
                    193:     (&mh-@-show
                    194:         (if
                    195:            (& (!= &mhfolder "") (!= &mhmsg ""))
                    196:            (progn (&mh-set-cur &mhmsg) (&mh-show))
                    197:            (!= &mhdraft "")
                    198:            (if (error-occured (next-buffer-name &mhdraft))
                    199:                (save-excursion (pop-to-buffer &mhdraft))
                    200:                (error-message "no draft message"))
                    201:            (error-message "no target message"))
                    202:         
                    203:         (novalue)
                    204:     )
                    205: )
                    206: 
                    207: (novalue)

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.