diplodocus.org Git - nmh/blob - docs/historical/mh-6.8.5/miscellany/mhe/mh-mode.ml

   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" '\ e')
 128         (local-bind-to-key "header-previous" '\10')
 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 )