![[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] / 43BSDReno / contrib / mh / miscellany / mhe|
Return to mh-cache.ml CVS log | Up to [CSRG BSD Unix] / 43BSDReno / 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.