![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mh-cache.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-cache.ml CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / mh / miscellany / mhe |
1.1 root 1: ; This file holds functions that create and manipulate the cache of header
2: ; information for the various message files. It is explicitly loaded from
3: ; the root.
4: -------------------------------------------------------------------------
5:
6: ; This function creates the header buffer that represents a message or
7: ; bboard directory. It associates several buffer-specific variables
8: ; with it: mh-buffer-filename, which is the actual Unix file name of the
9: ; directory; mh-folder-title, which is either the tail of the directory
10: ; name or the whole thing depending on whether it is in your mail path.
11: ; call: (&mh-read-folder "folder" "range" "pathname" "title")
12: (defun
13: (&mh-read-folder name rnge title
14: (setq name (arg 1)) (setq rnge (arg 2))
15: (pop-to-buffer (concat "+" mh-folder))
16: (if buffer-is-modified
17: (write-current-file))
18: (setq mh-folder name)
19: (switch-to-buffer (concat "+" name))
20: (setq backup-before-writing 0)
21: (setq wrap-long-lines 0)
22: (use-local-map "&mh-keymap")
23: (setq mode-string "mh-folder")
24: (if (= (buffer-size) 0)
25: (progn
26: (if (!= 0 (length mh-flist))
27: (setq mh-flist (concat mh-flist ",")))
28: (setq mh-flist (concat mh-flist name))
29: (setq mh-buffer-filename (arg 3))
30: (setq mh-folder-title (arg 4))
31: (use-local-map "&mh-keymap")
32: (if (error-occured
33: (read-file (concat mh-buffer-filename "/"
34: (current-buffer-name))))
35: (progn
36: (message "Header file missing; regenerating it...")
37: (sit-for 0)
38: (&mh-regenerate-headers)
39: )
40: (progn
41: (&mh-update-headers)
42: )
43: )
44: (if (looking-at "scan: "); UCI
45: ;UCI (looking-at "No messages ")
46: (progn
47: (if (= rnge "")
48: (message "Folder +" name " is empty.")
49: (message "No messages in +" name " range " rnge)
50: ;UCI (erase-buffer)
51: )
52: (sit-for 15)
53: (erase-buffer); UCI
54: )
55: )
56: (setq mode-line-format
57: (concat "{%b} %[%] "
58: "Cmds: n p d ^ ! u t e m f i r g b x ? Exit:^X^C %M")
59: )
60: (&mh-check-folder-full)
61: )
62: )
63: (&mh-adjust-window)
64: (setq buffer-is-modified 0)
65: )
66: )
67:
68: (defun
69: (&mh-check-folder-full lastmsg
70: (save-excursion
71: (temp-use-buffer (concat "+" mh-folder))
72: (end-of-file)
73: (previous-line)
74: (beginning-of-line)
75: (while (= (following-char) ' ') (forward-character))
76: (set-mark)
77: (beginning-of-line)
78: (goto-character (+ (dot) 3))
79: (setq lastmsg (region-to-string))
80: (if (> lastmsg 900)
81: (progn ans
82: (setq ans
83: (get-response (concat "Folder +" mh-folder " is >90%% full. May I pack it for you? ")
84: "yYnN\"
85: "Please answer y or n"))
86: (if (= ans 'y')
87: (progn
88: (&mh-pack-folder)
89: )
90: (progn
91: (message "OK, but you should use the 'x-p' command to pack it soon.")
92: (sit-for 20)
93: )
94: )
95: )
96: )
97: )
98: )
99:
100: (&mh-adjust-window
101: (&mh-unmark-all-headers 0)
102: (&mh-position-to-current)
103: (save-excursion
104: (beginning-of-window)
105: (if (! (bobp))
106: (progn t
107: (end-of-file)
108: (setq t (dot))
109: (while (= t (dot))
110: (progn
111: (scroll-one-line-down)
112: (sit-for 0)
113: ))
114: (scroll-one-line-up)
115: )
116: )
117: )
118: )
119: )
120:
121: (defun
122: (&mh-regenerate-headers
123: (setq mode-line-format " please wait for header regeneration...")
124: (message "scan +" mh-folder-title)
125: (sit-for 0)
126: (erase-buffer) (set-mark)
127: (fast-filter-region (concat mh-progs "/scan +" mh-folder-title))
128: (write-named-file (concat mh-buffer-filename "/"
129: (&mh-header-file-name)))
130: (unlink-file (concat mh-buffer-filename "/++"))
131: )
132: (&mh-header-file-name
133: (if (!= (substr (current-buffer-name) 2 1) "/")
134: (current-buffer-name)
135: (save-excursion x
136: (setq x (current-buffer-name))
137: (temp-use-buffer "scratch")
138: (erase-buffer) (insert-string x)
139: (beginning-of-file) (set-mark)
140: (error-occured
141: (replace-string "/" ".")
142: )
143: (end-of-file)
144: (region-to-string)
145: )
146: )
147: )
148: )
149: ; Read in the ++ file that was generated by an external "inc", then erase.
150: (defun
151: (&mh-update-headers uhf
152: (setq uhf (concat mh-buffer-filename "/++"))
153: (if (file-exists uhf)
154: (progn
155: (save-excursion
156: (temp-use-buffer "++")
157: (read-file uhf)
158: (temp-use-buffer (concat "+" mh-folder))
159: (end-of-file)
160: (yank-buffer "++")
161: (write-current-file)
162: (temp-use-buffer "++")
163: (erase-buffer)
164: (unlink-file uhf)
165: )
166: )
167: )
168: )
169: )
170: ; This function removes all "+" flags from the headers, and if it is called
171: ; with an argument of 1, removes all "D" and "^" flags too.
172: (defun
173: (&mh-unmark-all-headers
174: (temp-use-buffer (concat "+" mh-folder))
175: (beginning-of-file)
176: (while (! (error-occured
177: (if (= 0 (arg 1))
178: (re-search-forward "^...\\+")
179: (re-search-forward "^...\\D\\|^...\\^\\|^...\\+")
180: )
181: )
182: )
183: (delete-previous-character)
184: (insert-character ' ')
185: )
186: )
187:
188: ; position the cursor to the current message.
189: (&mh-position-to-current curmsg curbuf curfil
190: (setq curbuf (current-buffer-name))
191: (setq curfil mh-buffer-filename)
192: (temp-use-buffer "mh-temp") (erase-buffer)
193: (if (error-occured
194: (insert-file (concat curfil "/cur")))
195: (setq curmsg 0)
196: (progn
197: (beginning-of-file)
198: (set-mark)
199: (end-of-line)
200: (setq curmsg (region-to-string))
201: )
202: )
203: (temp-use-buffer curbuf)
204: (end-of-file)
205: (if (= curmsg 0) (previous-line)
206: (progn
207: (while (< (length curmsg) 3)
208: (setq curmsg (concat " " curmsg)))
209: (if (error-occured
210: (re-search-reverse (concat "^" curmsg)))
211: (progn (end-of-file) (previous-line))
212: )
213: )
214: )
215: (if (! (eobp))
216: (progn
217: (beginning-of-line)
218: (goto-character (+ (dot) 3))
219: (delete-next-character)
220: (insert-character '+')
221: (beginning-of-line)
222: )
223: )
224: )
225: ; This function sets the "current message" (+ sign) to equal the number of
226: ; the message that the cursor is pointing to. I.e. it writes cur to stable
227: ; storage
228: (&mh-set-cur cm cf
229: (save-window-excursion
230: (temp-use-buffer (concat "+" mh-folder))
231: (setq cm (&mh-get-msgnum))
232: (setq cf (concat mh-buffer-filename "/cur"))
233: (temp-use-buffer "mh-temp")
234: (erase-buffer)
235: (insert-string cm)
236: (write-named-file cf)
237: (delete-buffer "mh-temp")
238: )
239: )
240:
241: ; write out the header buffer as a file in the current folder
242: (&mh-make-headers-current
243: (temp-use-buffer (concat "+" mh-folder))
244: (save-excursion
245: (beginning-of-file)
246: (while (! (error-occured
247: (re-search-forward "^...\\D\\|^...\\^")))
248: (beginning-of-line)
249: (kill-to-end-of-line) (delete-next-character)
250: )
251: (write-current-file)
252: )
253: (&mh-set-cur)
254: )
255:
256: ; This function closes a folder, i.e. processes all of the pending deletes and
257: ; moves for it and edits the header buffer accordingly.
258: (&mh-close-folder ts
259: (temp-use-buffer "cmd-buffer") (beginning-of-file)
260: (error-occured
261: (re-search-forward (concat "^rmm +" mh-folder))
262: (beginning-of-line) (insert-string mh-progs "/")
263: (beginning-of-line) (set-mark)
264: (end-of-line) (delete-next-character)
265: (setq ts (region-to-string)) (erase-region)
266: (send-to-shell ts)
267: )
268: (beginning-of-file)
269: (while (!
270: (error-occured
271: (re-search-forward (concat "^filem -src +" mh-folder))
272: ))
273: (beginning-of-line) (insert-string mh-progs "/")
274: (beginning-of-line) (set-mark)
275: (end-of-line) (delete-next-character)
276: (setq ts (region-to-string)) (erase-region)
277: (send-to-shell ts)
278: )
279: (pop-to-buffer (concat "+" mh-folder))
280: (&mh-make-headers-current)
281: (&mh-unmark-all-headers)
282: (&mh-position-to-current)
283: )
284: ; This function applies "folder -pack" to the current folder, after first
285: ; closing it (see above)
286: (&mh-pack-folder sm
287: (setq sm mode-line-format)
288: (setq mode-line-format " closing folder first...") (sit-for 0)
289: (&mh-close-folder)
290: (setq mode-line-format " please wait for pack...") (sit-for 0)
291: (send-to-shell (concat mh-progs "/folder +" mh-folder " -pack"))
292: (&mh-regenerate-headers)
293: (setq mode-line-format sm)
294: )
295: )
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.