|
|
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)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.