![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to emh-move.ml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / mh / miscellany / emh|
Return to emh-move.ml CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / mh / miscellany / emh |
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.