Return to emh-scan.ml CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / mh / miscellany / emh

Annotation of 43BSD/contrib/mh/miscellany/emh/emh-scan.ml, revision 1.1

1.1     ! root        1: ; emh-scan.ml :: implements the emh scan facility
        !             2: ; Wed Oct  5 23:40:17 1983     /mtr  <mrose@uci-750a>
        !             3: 
        !             4: 
        !             5: (defun 
        !             6: 
        !             7:     (&mh-scan &buffer &dir &folder
        !             8:        (setq &folder (arg 1 ": mh-scan (on folder) "))
        !             9:        (if (= (substr &folder 1 1) "+")
        !            10:            (setq &folder (substr &folder 2 (- (length &folder) 1))))
        !            11:        (if (! (file-exists (setq &dir (&mh-path &folder))))
        !            12:            (error-message "no such folder as +" &folder))
        !            13:        (if (>= (process-status (setq &buffer (concat "+" &folder))) 0)
        !            14:            (error-message "already doing mh " &buffer))
        !            15:        (error-occured (delete-buffer &buffer))
        !            16:        (save-excursion 
        !            17:            (temp-use-buffer &buffer)
        !            18:            (use-local-map "&mh-keymap")
        !            19:            (setq needs-checkpointing 0)
        !            20:            (erase-buffer)
        !            21:            (setq &mhfolder (setq &folder &buffer))
        !            22:            (setq &mhreadonly (= (setq &mhdir (concat &dir "/")) -1))
        !            23:            (&mh-purge)
        !            24:            (&mh-start-process (concat "scan " &folder) &buffer)
        !            25:            (insert-sentinel &buffer "&mh-scan-sentinel")
        !            26:            (setq mode-string "Starting")
        !            27:            (setq mode-line-format "  %b: scan (status: %m)  %M"))
        !            28:        
        !            29:        (novalue)
        !            30:     )
        !            31:     
        !            32:     (&mh-scan-sentinel &flag &text
        !            33:        (setq &flag (>> prefix-argument 16))
        !            34:        (setq &text (process-output))
        !            35:        (save-excursion 
        !            36:            (temp-use-buffer MPX-process)
        !            37:            (setq mode-string (substr &text 1 (- (length &text) 1)))
        !            38:            (if (= mode-string "Exited")
        !            39:                (progn 
        !            40:                       (setq mode-string "emh")
        !            41:                       (setq mode-line-format
        !            42:                             "  %b: scan listing (%m) %M %[%p%]")
        !            43:                       (setq &mhbuffer MPX-process)
        !            44:                       (&mh-trim-long-lines))))
        !            45:        (dot-is-visible)        ; hack...
        !            46:        (if (bitwise-and &flag 12)
        !            47:            (save-excursion 
        !            48:                (&mh-daemon)
        !            49:                (pop-to-buffer MPX-process)
        !            50:                (&mh-find-cur)))
        !            51:     )
        !            52: 
        !            53:     (&mh-find-cur &current
        !            54:        (beginning-of-file)
        !            55:        (if (!= (setq &current (&mh-get-cur)) 0)
        !            56:            (progn
        !            57:                  (while (< (length &current) &mhdmax)
        !            58:                         (setq &current (concat " " &current)))
        !            59:                  (end-of-file)
        !            60:                  (error-occured (re-search-reverse (concat "^" &current)))
        !            61:                  (if (! (eobp))
        !            62:                      (progn
        !            63:                            (beginning-of-line)
        !            64:                            (provide-prefix-argument &mhdmax (forward-character))
        !            65:                            (delete-next-character) (insert-character '+')
        !            66:                            (beginning-of-line) (line-to-top-of-window)
        !            67:                            (set-mark)
        !            68:                            (provide-prefix-argument (/ (window-height) 2)
        !            69:                                (scroll-one-line-down))
        !            70:                            (exchange-dot-and-mark))
        !            71:                      (beginning-of-file))))
        !            72:        (beginning-of-line)
        !            73:     )
        !            74:     
        !            75:     (&mh-get-cur &cur &file
        !            76:        (if &mhreadonly
        !            77:            (setq &cur (&mh-find-entry (concat "cur-" &mhdir)))
        !            78:            (if (file-exists (setq &file (concat &mhdir "cur")))
        !            79:                (save-excursion
        !            80:                    (temp-use-buffer &mhtemp)
        !            81:                    (erase-buffer)
        !            82:                    (error-occured (insert-file &file))
        !            83:                    (beginning-of-file) (set-mark) (end-of-line)
        !            84:                    (setq &cur (region-to-string))
        !            85:                    (delete-buffer &mhtemp))))
        !            86:        (if (error-occured (+ &cur 0))
        !            87:            (setq &cur 0))
        !            88:        
        !            89:        &cur
        !            90:     )
        !            91: 
        !            92:     (&mh-purge &current &template
        !            93:        (setq &template (concat "message " &mhfolder "/"))
        !            94:        (setq &current "")
        !            95:        (while (!= (setq &current (next-buffer-name &current)) "")
        !            96:               (if (&mh-prefix &template &current)
        !            97:                   (progn &deleted
        !            98:                          (setq &current
        !            99:                                (next-buffer-name (setq &deleted &current)))
        !           100:                          (delete-buffer &deleted))))
        !           101:     )
        !           102:     
        !           103:     (&mh-trim-long-lines
        !           104:        (beginning-of-file)
        !           105:        (while (! (eobp))
        !           106:               (end-of-line)
        !           107:               (while (> (current-column) (screen-width))
        !           108:                      (delete-previous-character))
        !           109:               (next-line))
        !           110:     )
        !           111: )
        !           112: 
        !           113: (novalue)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.