![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to emh-scan.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 / emh|
Return to emh-scan.ml CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / mh / miscellany / emh |
1.1 root 1: ; emh-scan.ml :: implements the emh scan facility
2: ; Wed Oct 5 23:40:17 1983 /mtr <mrose@uci-750a>
3:
4:
5: (defun
6:
7: (&mh-scan &buffer &dir &folder
8: (setq &folder (arg 1 ": mh-scan (on folder) "))
9: (if (= (substr &folder 1 1) "+")
10: (setq &folder (substr &folder 2 (- (length &folder) 1))))
11: (if (! (file-exists (setq &dir (&mh-path &folder))))
12: (error-message "no such folder as +" &folder))
13: (if (>= (process-status (setq &buffer (concat "+" &folder))) 0)
14: (error-message "already doing mh " &buffer))
15: (error-occured (delete-buffer &buffer))
16: (save-excursion
17: (temp-use-buffer &buffer)
18: (use-local-map "&mh-keymap")
19: (setq needs-checkpointing 0)
20: (erase-buffer)
21: (setq &mhfolder (setq &folder &buffer))
22: (setq &mhreadonly (= (setq &mhdir (concat &dir "/")) -1))
23: (&mh-purge)
24: (&mh-start-process (concat "scan " &folder) &buffer)
25: (insert-sentinel &buffer "&mh-scan-sentinel")
26: (setq mode-string "Starting")
27: (setq mode-line-format " %b: scan (status: %m) %M"))
28:
29: (novalue)
30: )
31:
32: (&mh-scan-sentinel &flag &text
33: (setq &flag (>> prefix-argument 16))
34: (setq &text (process-output))
35: (save-excursion
36: (temp-use-buffer MPX-process)
37: (setq mode-string (substr &text 1 (- (length &text) 1)))
38: (if (= mode-string "Exited")
39: (progn
40: (setq mode-string "emh")
41: (setq mode-line-format
42: " %b: scan listing (%m) %M %[%p%]")
43: (setq &mhbuffer MPX-process)
44: (&mh-trim-long-lines))))
45: (dot-is-visible) ; hack...
46: (if (bitwise-and &flag 12)
47: (save-excursion
48: (&mh-daemon)
49: (pop-to-buffer MPX-process)
50: (&mh-find-cur)))
51: )
52:
53: (&mh-find-cur ¤t
54: (beginning-of-file)
55: (if (!= (setq ¤t (&mh-get-cur)) 0)
56: (progn
57: (while (< (length ¤t) &mhdmax)
58: (setq ¤t (concat " " ¤t)))
59: (end-of-file)
60: (error-occured (re-search-reverse (concat "^" ¤t)))
61: (if (! (eobp))
62: (progn
63: (beginning-of-line)
64: (provide-prefix-argument &mhdmax (forward-character))
65: (delete-next-character) (insert-character '+')
66: (beginning-of-line) (line-to-top-of-window)
67: (set-mark)
68: (provide-prefix-argument (/ (window-height) 2)
69: (scroll-one-line-down))
70: (exchange-dot-and-mark))
71: (beginning-of-file))))
72: (beginning-of-line)
73: )
74:
75: (&mh-get-cur &cur &file
76: (if &mhreadonly
77: (setq &cur (&mh-find-entry (concat "cur-" &mhdir)))
78: (if (file-exists (setq &file (concat &mhdir "cur")))
79: (save-excursion
80: (temp-use-buffer &mhtemp)
81: (erase-buffer)
82: (error-occured (insert-file &file))
83: (beginning-of-file) (set-mark) (end-of-line)
84: (setq &cur (region-to-string))
85: (delete-buffer &mhtemp))))
86: (if (error-occured (+ &cur 0))
87: (setq &cur 0))
88:
89: &cur
90: )
91:
92: (&mh-purge ¤t &template
93: (setq &template (concat "message " &mhfolder "/"))
94: (setq ¤t "")
95: (while (!= (setq ¤t (next-buffer-name ¤t)) "")
96: (if (&mh-prefix &template ¤t)
97: (progn &deleted
98: (setq ¤t
99: (next-buffer-name (setq &deleted ¤t)))
100: (delete-buffer &deleted))))
101: )
102:
103: (&mh-trim-long-lines
104: (beginning-of-file)
105: (while (! (eobp))
106: (end-of-line)
107: (while (> (current-column) (screen-width))
108: (delete-previous-character))
109: (next-line))
110: )
111: )
112:
113: (novalue)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.