Annotation of 43BSDReno/contrib/mh/miscellany/emh/emh-move.ml, revision 1.1

1.1     ! root        1: ; emh-move.ml :: implements the emh move commands
        !             2: ; Wed Oct  5 13:27:42 1983     /mtr  <mrose@uci-750a>
        !             3: 
        !             4: 
        !             5: (defun 
        !             6:     
        !             7:     (&mh-file &args &buffer &dest &dir &folder &msg &readonly
        !             8:        (setq &dest (arg 1 ": mh-file (destination folder) "))
        !             9:        (if (= (substr &dest 1 1) "+")
        !            10:            (setq &dest (substr &dest 2 (- (length &dest) 1))))
        !            11:        (if (= (setq &args (file-exists (setq &dir (&mh-path &dest)))) 0)
        !            12:            (error-message "no such folder as +" &dest)
        !            13:            (< &args 0) (error-message "folder +" &dest " is not writable"))
        !            14:        (setq &args 
        !            15:              (if (| prefix-argument-provided (> (nargs) 1))
        !            16:                  (arg 2  (concat ": mh-file +" &dest " (args) ")) ""))
        !            17:        (save-excursion
        !            18:            (pop-to-buffer (&mh-cur-folder))
        !            19:            (setq &folder (&mh-cur-folder))
        !            20:            (setq &msg (&mh-cur-message))
        !            21:            (setq &readonly &mhreadonly)
        !            22:            (beginning-of-line)
        !            23:            (provide-prefix-argument 2 (kill-to-end-of-line))
        !            24:            (error-occured
        !            25:                (delete-buffer (concat "message " &folder "/" &msg)))
        !            26:            (setq &buffer (&mh-unique &mhexec))
        !            27:            (error-occured (delete-buffer &buffer))
        !            28:            (error-occured (delete-buffer (setq &dest (concat "+" &dest))))
        !            29:            (save-excursion 
        !            30:                (temp-use-buffer &buffer)
        !            31:                (setq needs-checkpointing 0)
        !            32:                (erase-buffer)
        !            33:                (&mh-start-process
        !            34:                    (concat "refile -src " &folder " " &msg " " &dest
        !            35:                            (if (!= &args "") (concat " " &args)
        !            36:                                (if &readonly " -link" " -nolink")))
        !            37:                    &buffer)
        !            38:                (insert-sentinel &buffer "&mh-move-sentinel")
        !            39:                (setq mode-string "Starting")
        !            40:                (setq mode-line-format
        !            41:                      (concat "  " &mhexec ": file " &msg " " &dest
        !            42:                              " (status: %m)  %M"))))   
        !            43:        
        !            44:        (novalue)
        !            45:     )
        !            46:     
        !            47:     (&mh-rmm &args &buffer &folder &msg
        !            48:        (setq &args 
        !            49:              (if (| prefix-argument-provided (> (nargs) 0))
        !            50:                  (arg 1 ": mh-rmm (args) ") ""))
        !            51:        (save-excursion
        !            52:            (pop-to-buffer (&mh-cur-folder))
        !            53:            (setq &folder (&mh-cur-folder))
        !            54:            (setq &msg (&mh-cur-message))
        !            55:            (beginning-of-line)
        !            56:            (provide-prefix-argument 2 (kill-to-end-of-line))
        !            57:            (error-occured
        !            58:                (delete-buffer (concat "message " &folder "/" &msg)))
        !            59:            (if (! &mhreadonly)
        !            60:                (progn 
        !            61:                       (setq &buffer (&mh-unique &mhexec))
        !            62:                       (error-occured (delete-buffer &buffer))
        !            63:                       (save-excursion 
        !            64:                           (temp-use-buffer &buffer)
        !            65:                           (setq needs-checkpointing 0)
        !            66:                           (erase-buffer)
        !            67:                           (&mh-start-process
        !            68:                               (concat "rmm " &folder " " &msg
        !            69:                                       (if (!= &args "") (concat " " &args) ""))
        !            70:                               &buffer)
        !            71:                           (insert-sentinel &buffer "&mh-move-sentinel")
        !            72:                           (setq mode-string "Starting")
        !            73:                           (setq mode-line-format
        !            74:                                 (concat "  " &mhexec ": rmm " &folder " "
        !            75:                                         &msg " (status: %m)  %M"))))))
        !            76:        
        !            77:        (novalue)
        !            78:     )  
        !            79:     
        !            80:     (&mh-move-sentinel &abnormal &flag &text
        !            81:        (setq &abnormal 1)
        !            82:        (setq &flag (>> prefix-argument 16))
        !            83:        (setq &text (process-output))
        !            84:        (save-excursion 
        !            85:            (temp-use-buffer MPX-process)
        !            86:            (setq mode-string (substr &text 1 (- (length &text) 1)))
        !            87:            (setq &abnormal (!= mode-string "Exited")))
        !            88:        (dot-is-visible)        ; hack...
        !            89:        (if (bitwise-and &flag 12)
        !            90:            (if &abnormal
        !            91:                (save-excursion 
        !            92:                    (pop-to-buffer MPX-process)
        !            93:                    (beginning-of-file))
        !            94:                (&mh-daemon)))
        !            95:     )
        !            96: )
        !            97: 
        !            98: (novalue)

unix.superglobalmegacorp.com

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