Added -clobber switch to mhstore(1) [Bug #11160].
[mmh] / docs / historical / mh-6.8.5 / miscellany / mhe / mh-cache.ml
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\\ 3"
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 )