Added -clobber switch to mhstore(1) [Bug #11160].
[mmh] / 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 )