![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mh-e.ml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / mh / miscellany / mhe|
Return to mh-e.ml CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / mh / miscellany / mhe |
1.1 root 1: ; This file implements "mhe", the display-oriented front end to the MH mail
2: ; system. Documentation is in file mh-doc.ml.
3: ; To install this at your site you must edit the variables flagged with
4: ; an asterisk below.
5: ;
6: ; Brian K. Reid, Stanford, April 1982
7: ;
8: ; This is version 4 (September 1982); it uses fast-filter-region.
9: ;
10: ; UCI modification: we don't need fast-filter-region since we have
11: ; use-users-shell
12: (setq stack-trace-on-error 1)
13: (declare-global ;*marks installation constants
14: mh-keymap-defined ; T iff keymap exists.
15: mh-folder ; string name, e.g. "inbox"
16: mh-path ; "/mnt/reid/Mail", or whatever
17: mh-progs ;*"/usr/local/lib/mh", or whatever
18: bboard-path ;*"/usr/spool/netnews", or whatever
19: mh-buffer-filename ; "/mnt/reid/Mail/inbox", or whatever
20: t-buffer-filename ; scratch for side effect from mh-folder
21: mh-flist ; "inbox,carbons,news", or whatever
22: mh-direction ; 1 is up, -1 is down.
23: mh-annotate ; are we annotating processed msgs?
24: mh-writeable ; is this folder write-enabled?
25: mh-last-destination ; destination of last "move" command
26: mhe-debug ; are we debugging macro package?
27: )
28:
29: (argc) ; is this early enough, James?
30: (setq mh-keymap-defined 0)
31: (setq mhe-debug 0)
32: (setq-default mh-annotate 1)
33: (setq-default mh-writeable 1)
34: (setq bboard-path "/dev/null"); UCI
35: (setq mh-path "")
36: (setq mh-progs "/usr/uci") ; UCI
37: (setq mh-flist "")
38: (setq-default right-margin 77)
39: (setq-default mh-direction 1)
40: (setq pop-up-windows 1) ; mhe requires popup windows!
41:
42: (declare-buffer-specific
43: mh-direction
44: mh-buffer-filename
45: mh-folder-title
46: mh-annotate
47: mh-writeable
48: backup-before-writing
49: wrap-long-lines
50: )
51:
52: (defun ; (mh "folder" "range")
53: (mh folder range
54: (temp-use-buffer "cmd-buffer") (erase-buffer)
55: (setq backup-before-writing 0)
56: (find-path)
57: (setq folder (arg 1 (concat ": mh on folder? [" mh-folder "] ")))
58: (if (= folder "")
59: (setq folder mh-folder))
60: (if (= '+' (string-to-char (substr folder 1 1)))
61: (setq folder (substr folder 2 -1)))
62: (setq range (arg 2))
63: (setq mh-folder (get-folder-name "??" folder 1))
64: (&mh-read-folder mh-folder range t-buffer-filename mh-folder)
65: (progn stop-loop
66: (setq stop-loop 0)
67: (while (! stop-loop)
68: (pop-to-buffer (concat "+" mh-folder))
69: (use-local-map "&mh-keymap")
70: (error-occured (recursive-edit))
71: (setq stop-loop (&mh-exit))
72: )
73: )
74: )
75: )
76: ; This function marks a message as being deleted. This mark has two parts.
77: ; The letter "D" is placed in column 4 of the header line, and the message
78: ; number is added to the text of an "rmm" command that is being assembled
79: ; in the command buffer.
80: (defun
81: (&mh-Mark-file-deleted
82: (pop-to-buffer (concat "+" mh-folder))
83: (if (! mh-writeable)
84: (error-message "Sorry; this folder is read-only."))
85: (beginning-of-line)
86: (goto-character (+ (dot) 3))
87: (if (| (= (following-char) ' ') (= (following-char) '+'))
88: (progn
89: (delete-next-character)
90: (insert-string "D")
91: (setq buffer-is-modified 0)
92: (temp-use-buffer "cmd-buffer")
93: (beginning-of-file)
94: (if (error-occured
95: (re-search-forward
96: (concat "^rmm +" mh-folder)))
97: (progn
98: (end-of-file)
99: (insert-string (concat "rmm +" mh-folder "\n"))
100: (backward-character)
101: )
102: )
103: (end-of-line)
104: (insert-string (concat " " (&mh-get-msgnum)))
105: (setq buffer-is-modified 0)
106: (pop-to-buffer (concat "+" mh-folder))
107: )
108: )
109: (another-line)
110: )
111: )
112: ; These functions create (and make current) a header buffer on a new message
113: ; or bboard directory.
114: (defun
115: (&mh-new-folder which
116: (setq which (get-folder-name "New" "" 1))
117: (&mh-read-folder which "" t-buffer-filename which)
118: )
119:
120: (&mh-bboard which
121: (error-message "B: command not implemented at UCI."); UCI
122: ;UCI (setq which (get-bboard-name))
123: ;UCI (&mh-read-folder which "" t-buffer-filename t-buffer-filename)
124: ;UCI (setq mh-annotate 0)
125: ;UCI (setq mh-writeable 0)
126: )
127: )
128:
129: (defun
130: (&mh-remove
131: (if (= "+" (substr (current-buffer-name) 1 1))
132: (progn
133: (beginning-of-line)
134: (&mh-unmark)
135: (kill-to-end-of-line) (kill-to-end-of-line)
136: (setq buffer-is-modified 0)
137: )
138: (error-message "The " (char-to-string (last-key-struck)) " command works only in header windows.")
139: )
140: )
141:
142: ; This function gets redefined when &mh-move is autoloaded. Shame on me for
143: ; giving it a name so similar to the function above.
144: (&mh-re-move
145: (error-message "I can't repeat the last ^ command because you haven't typed one yet")
146: )
147:
148: (&mh-summary
149: (message
150: "nxt prev del ^put !rpt unmrk typ edit mail forw inc repl get bboard ^X^C ?")
151: )
152:
153: ; This function is redefined when file mh-extras.ml is autoloaded
154: (&mh-beep (send-string-to-terminal ""))
155: )
156: ; These functions are used to preserve the contents of the kill buffer
157: ; across things that we want to be invisible, so that the keyboard-level
158: ; user does not have to worry about system functions clobbering the kill
159: ; buffer.
160: (defun
161: (&mh-save-killbuffer
162: (save-excursion
163: (temp-use-buffer "Kill buffer")
164: (temp-use-buffer "Kill save")
165: (setq backup-before-writing 0)
166: (erase-buffer)
167: (yank-buffer "Kill buffer")
168: (setq buffer-is-modified 0)
169: )
170: )
171:
172: (&mh-restore-killbuffer
173: (save-excursion
174: (temp-use-buffer "Kill buffer")
175: (erase-buffer)
176: (yank-buffer "Kill save")
177: )
178: )
179: )
180: ; These functions move the cursor around in a header buffer, and possibly
181: ; also display the message that the cursor now points to.
182: (defun
183: (&mh-next-line
184: (pop-to-buffer (concat "+" mh-folder))
185: (setq mh-direction 1)
186: (next-line) (beginning-of-line)
187: (if (eobp)
188: (progn (previous-line)
189: (setq mh-direction -1)))
190: )
191: (&mh-previous-line
192: (pop-to-buffer (concat "+" mh-folder))
193: (setq mh-direction -1)
194: (previous-line) (beginning-of-line)
195: (if (bobp)
196: (setq mh-direction 1))
197: )
198:
199: (another-line old-direction
200: (setq old-direction mh-direction)
201: (if (> mh-direction 0)
202: (&mh-next-line)
203: (&mh-previous-line)
204: )
205: (if (!= old-direction mh-direction)
206: (if (> mh-direction 0)
207: (beginning-of-line)
208: (&mh-previous-line)
209: )
210: )
211: )
212:
213: )
214: ; These functions query the user for various things, and error-check the
215: ; responses. "get-response" reads a 1-letter response code in the minibuffer.
216: ; "get-folder-name" extracts the string name of an MH folder or file.
217: ; "get-bboard-name" gets the string name of a bboard file.
218: (defun
219: (get-response chr ok s c pr
220: (setq ok 0) (setq pr (arg 1))
221: (while (! ok)
222: (setq chr
223: (string-to-char
224: (setq c
225: (get-tty-string pr)
226: )
227: )
228: )
229:
230: (setq s (arg 2))
231: (while (> (length s) 0)
232: (if (= chr (string-to-char (substr s 1 1)))
233: (progn (setq ok 1) (setq s ""))
234: (setq s (substr s 2 -1))
235: )
236: )
237: (if (= ok 0)
238: (progn (if (!= chr '?')
239: (setq pr (concat "Illegal response '"
240: (char-to-string chr)
241: "'. " (arg 1)))
242: (setq pr (arg 3))
243: )
244: )
245: )
246: )
247: (if (& (>= chr 'A') (<= chr 'Z'))
248: (+ chr (- 'a' 'A'))
249: chr
250: )
251: )
252:
253: (get-folder-name ; (g-f-n "prompt" "default" can-create)
254: exists msgg name defarg
255: (setq exists 0)
256: (if (> (nargs) 1) (setq defarg (arg 2)) (setq defarg ""))
257: (setq msgg (concat (arg 1) " folder name? "))
258: (while (! exists)
259: (if (= 0 (length defarg))
260: (setq name (get-tty-string msgg))
261: (setq name defarg)
262: )
263: (setq defarg "")
264: (if (= 0 (length name))
265: (error-message "Aborted."))
266: (if (!= (string-to-char (substr name 1 1)) '/')
267: (setq t-buffer-filename (concat mh-path "/" name))
268: (setq t-buffer-filename name)
269: )
270: (setq exists (file-exists t-buffer-filename))
271: (if (& (!= exists 1) (!= (arg 3) 0))
272: (progn ans
273: (setq ans (get-response
274: (concat "Folder +" name " does not exist. May I create it for you? ")
275: "yYnN\"
276: "Please answer y or n"))
277: (if (= ans 'y')
278: (progn
279: (message "OK, I will create one for you.")
280: (send-to-shell
281: (concat "mkdir " t-buffer-filename))
282: (setq exists 1)
283: )
284: )
285: )
286: )
287: (if (!= exists 1)
288: (setq msgg (concat "Sorry, no such folder as `" name
289: "'. Folder name? "))
290: )
291: )
292: name
293: )
294:
295: (get-bboard-name exists msgg name
296: (setq exists 0)
297: (setq msgg "BBoard name? ")
298: (while (! exists)
299: (setq name (get-tty-string msgg))
300: (if (= 0 (length name))
301: (error-message "Aborted."))
302: (if (!= (string-to-char (substr name 1 1)) '/')
303: (setq t-buffer-filename (concat bboard-path "/" name))
304: (setq t-buffer-filename name)
305: )
306: (setq exists (file-exists t-buffer-filename))
307: (if (!= exists 1)
308: (setq msgg (concat "Sorry, no such BBoard as `" name
309: "'. BBoard name? "))
310: )
311: )
312: name
313: )
314: )
315: ; UCI hack for fast-filter-region
316: (defun (fast-filter-region UseUsersShell
317: (setq UseUsersShell use-users-shell)
318: (setq use-users-shell 0)
319: (filter-region
320: (arg 1 ": fast-filter-region (through command) "))
321: (setq use-users-shell UseUsersShell)
322: )
323: )
324: ; These functions are the initial entry points to mhe. "startup" is
325: ; expecting an argv like "emacs -lmh-e.ml -estartup +inbox 100-last
326: (defun
327: (startup
328: (setq stack-trace-on-error 0)
329: (mh (if (> (argc) 3)
330: (argv 3)
331: "")
332: (if (> (argc) 4)
333: (argv 4)
334: "")
335: )
336: (error-occured (kill-process "newtime"))
337: (exit-emacs)
338: )
339:
340: (debug-startup
341: (setq mh-progs "/usr/local/src/cmd/mh/progs")
342: (setq stack-trace-on-error 0)
343: (startup)
344: )
345: )
346: (load "mh-util.ml")
347: (load "mh-shell.ml")
348: (load "mh-cache.ml")
349: (autoload "&mh-send" "mh-send.ml")
350: (autoload "&mh-show" "mh-show.ml")
351: (autoload "&mh-edit" "mh-edit.ml")
352: (autoload "&mh-repl" "mh-repl.ml")
353: (autoload "&mh-inc" "mh-inc.ml")
354: (autoload "&mh-help" "mh-help.ml")
355: (autoload "&mh-move" "mh-move.ml")
356: (autoload "&mh-unmark" "mh-unmark.ml")
357: (autoload "&mh-forw" "mh-forw.ml")
358: (autoload "&mh-exit" "mh-exit.ml")
359: (autoload "annotate" "mh-annot.ml")
360: (autoload "mail-mode" "mh-mode.ml")
361: (autoload "&mh-extras" "mh-extras.ml")
362: (autoload "&mh-xpack" "mh-extras.ml")
363: (if (! (is-bound time))
364: (load "time.ml")
365: (time)
366: )
367: (load "mh-keymap.ml")
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.