; emh-scan.ml :: implements the emh scan facility ; Wed Oct 5 23:40:17 1983 /mtr (defun (&mh-scan &buffer &dir &folder (setq &folder (arg 1 ": mh-scan (on folder) ")) (if (= (substr &folder 1 1) "+") (setq &folder (substr &folder 2 (- (length &folder) 1)))) (if (! (file-exists (setq &dir (&mh-path &folder)))) (error-message "no such folder as +" &folder)) (if (>= (process-status (setq &buffer (concat "+" &folder))) 0) (error-message "already doing mh " &buffer)) (error-occured (delete-buffer &buffer)) (save-excursion (temp-use-buffer &buffer) (use-local-map "&mh-keymap") (setq needs-checkpointing 0) (erase-buffer) (setq &mhfolder (setq &folder &buffer)) (setq &mhreadonly (= (setq &mhdir (concat &dir "/")) -1)) (&mh-purge) (&mh-start-process (concat "scan " &folder) &buffer) (insert-sentinel &buffer "&mh-scan-sentinel") (setq mode-string "Starting") (setq mode-line-format " %b: scan (status: %m) %M")) (novalue) ) (&mh-scan-sentinel &flag &text (setq &flag (>> prefix-argument 16)) (setq &text (process-output)) (save-excursion (temp-use-buffer MPX-process) (setq mode-string (substr &text 1 (- (length &text) 1))) (if (= mode-string "Exited") (progn (setq mode-string "emh") (setq mode-line-format " %b: scan listing (%m) %M %[%p%]") (setq &mhbuffer MPX-process) (&mh-trim-long-lines)))) (dot-is-visible) ; hack... (if (bitwise-and &flag 12) (save-excursion (&mh-daemon) (pop-to-buffer MPX-process) (&mh-find-cur))) ) (&mh-find-cur ¤t (beginning-of-file) (if (!= (setq ¤t (&mh-get-cur)) 0) (progn (while (< (length ¤t) &mhdmax) (setq ¤t (concat " " ¤t))) (end-of-file) (error-occured (re-search-reverse (concat "^" ¤t))) (if (! (eobp)) (progn (beginning-of-line) (provide-prefix-argument &mhdmax (forward-character)) (delete-next-character) (insert-character '+') (beginning-of-line) (line-to-top-of-window) (set-mark) (provide-prefix-argument (/ (window-height) 2) (scroll-one-line-down)) (exchange-dot-and-mark)) (beginning-of-file)))) (beginning-of-line) ) (&mh-get-cur &cur &file (if &mhreadonly (setq &cur (&mh-find-entry (concat "cur-" &mhdir))) (if (file-exists (setq &file (concat &mhdir "cur"))) (save-excursion (temp-use-buffer &mhtemp) (erase-buffer) (error-occured (insert-file &file)) (beginning-of-file) (set-mark) (end-of-line) (setq &cur (region-to-string)) (delete-buffer &mhtemp)))) (if (error-occured (+ &cur 0)) (setq &cur 0)) &cur ) (&mh-purge ¤t &template (setq &template (concat "message " &mhfolder "/")) (setq ¤t "") (while (!= (setq ¤t (next-buffer-name ¤t)) "") (if (&mh-prefix &template ¤t) (progn &deleted (setq ¤t (next-buffer-name (setq &deleted ¤t))) (delete-buffer &deleted)))) ) (&mh-trim-long-lines (beginning-of-file) (while (! (eobp)) (end-of-line) (while (> (current-column) (screen-width)) (delete-previous-character)) (next-line)) ) ) (novalue)