Annotation of 43BSD/contrib/mh/miscellany/mhe/mh-mode.ml, revision 1.1.1.1

1.1       root        1: ; This file implements a "mail draft mode" for composition of messages in
                      2: ; the MH mail handler (q.v.). When MH calls Emacs, its customary call
                      3: ;  is
                      4: ;      emacs ./reply ./message -lmh-mode -email-draft-mode
                      5: ;  for the case of a reply, and
                      6: ;      emacs ./draft -lmh-mode -email-draft-mode
                      7: ;  for a newly originated message. 
                      8: ; 
                      9: ; For use from mhe, in which Emacs calls MH instead of vice versa, it will
                     10: ; work fine as long as the function mail-draft-mode is not called.
                     11: ; 
                     12: ;      Brian Reid, December 1981
                     13: 
                     14: (defun
                     15:     (dot-in-header wasdot      ; return True iff cursor in message hdr
                     16:        (save-excursion
                     17:            (setq wasdot (dot))
                     18:            (beginning-of-file)
                     19:            (re-search-forward "^-*$")
                     20:            (beginning-of-line) (backward-character)
                     21:            (>= (dot) wasdot)
                     22:        )
                     23:     )
                     24:     (header-line-position      ; position cursor w.r.t. header line
                     25:        (if (dot-in-header)
                     26:            (progn 
                     27:                   (if (save-excursion 
                     28:                           (beginning-of-line)
                     29:                           (& (!= (following-char) ' ')
                     30:                              (!= (following-char) '\t'))
                     31:                       )
                     32:                       (progn (beginning-of-line)
                     33:                              (error-occured (search-forward ":"))
                     34:                              (if (eolp) 
                     35:                                  (insert-character ' ')
                     36:                                  (progn
                     37:                                        (forward-character)
                     38:                                        (if (! (eolp))
                     39:                                            (progn
                     40:                                                  (forward-word)
                     41:                                                  (backward-word))
                     42:                                        ))))
                     43:                   )))
                     44:     )
                     45:     
                     46:     (header-next               ; modified ^N command.
                     47:        (next-line)
                     48:        (header-line-position)
                     49:     )
                     50:     
                     51:     (header-previous           ; modified ^P command
                     52:        (previous-line)
                     53:        (header-line-position)
                     54:     )
                     55:     
                     56:     (find-starting-line                ; back cursor up to first line of this para.
                     57:        (beginning-of-line)
                     58:        (while (& (! (bobp))
                     59:                  (! (eolp))
                     60:                  (!= (following-char) '        ')
                     61:                  (! (looking-at "^-*$"))
                     62:               )
                     63:               (previous-line)
                     64:        )
                     65:        (next-line)
                     66:     )
                     67:     (justify-mail-paragraph    ;  like ordinary justify-para, but
                     68:        (error-occured          ; avoids trashing mail header.
                     69:            (if (! (dot-in-header))
                     70:                (progn 
                     71:                       (save-excursion
                     72:                           (find-starting-line)
                     73:                           (if (& (! (eolp)) (! (eobp)))
                     74:                               (progn 
                     75:                                      (set-mark)
                     76:                                      (forward-paragraph)
                     77:                                      (backward-word) (forward-word)
                     78:                                      (forward-character)
                     79:                                      (narrow-region)
                     80:                                      (error-occured (justify-mail-region))
                     81:                                      (widen-region))
                     82:                           )
                     83:                       )
                     84:                       (message "Done!")
                     85:                       (novalue)
                     86:                )))
                     87:     )
                     88:     
                     89:     (justify-mail-region       ; justify the entire buffer
                     90:        (beginning-of-file)
                     91:        (delete-white-space)
                     92:        (to-col left-margin)
                     93:        (while (progn   ; Turn it all into 1 long line....
                     94:                   (end-of-line)
                     95:                   (if (! (eobp))
                     96:                       (forward-character))
                     97:                   (! (eobp))
                     98:               )
                     99:               (delete-previous-character)
                    100:               (delete-white-space)
                    101:               (insert-string " ")
                    102:        )
                    103:        (beginning-of-line)
                    104:        (while (save-excursion 
                    105:                   (end-of-line)
                    106:                   (> (current-column) right-margin)
                    107:               )
                    108:               (goto-character (+ (dot) right-margin))
                    109:               (forward-character) (backward-word)
                    110:               (while (progn 
                    111:                             (backward-character)
                    112:                             (& (!= (following-char) ' ')
                    113:                                (!= (following-char) '\t')
                    114:                                (!= (following-char) '\n')
                    115:                                (! (bobp)))
                    116:                      )
                    117:                      (novalue)
                    118:               )
                    119:               (delete-next-character) (newline)
                    120:        )
                    121:     )
                    122: )
                    123: 
                    124: (defun 
                    125:     (mail-mode
                    126:        (set "right-margin" 72)
                    127:        (local-bind-to-key "header-next" '')
                    128:        (local-bind-to-key "header-previous" '')
                    129:        (local-bind-to-key "justify-mail-paragraph" "\ej")
                    130:        (use-syntax-table "text-mode")
                    131:        (setq mode-string "mh-mail")
                    132:        (novalue)
                    133:     )
                    134:     
                    135:     (mail-draft-mode
                    136:        (if (> (argc) 4)
                    137:            (progn 
                    138:                   (visit-file (argv 1))
                    139:                   (mail-mode)
                    140:                   (visit-file (argv 2))
                    141:                   (mail-mode)
                    142:                   (visit-file (argv 1))
                    143:                   (end-of-file)
                    144:            )
                    145:            (progn 
                    146:                   (visit-file (argv 1))
                    147:                   (mail-mode)
                    148:                   (beginning-of-file)
                    149:                   (header-line-position)
                    150:            )
                    151:        )
                    152:     )
                    153: )

unix.superglobalmegacorp.com

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