diplodocus.org Git - nmh/blob - 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 )