|
|
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: )
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.