![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mh-extras.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 / mhe|
Return to mh-extras.ml CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / mh / miscellany / mhe |
1.1 root 1: ; This autoloaded file implements the "x" key of mhe: extended commands.
2: (defun
3: (&mh-extras
4: (save-excursion
5: (pop-to-buffer "mh-xcommands")
6: (use-local-map "&mh-x-keymap")
7: (if (= 0 (buffer-size))
8: (insert-string
9: "Key Meaning (Type extended command character: )\n"
10: " q Quit: get out of this extended command mode\n"
11: " p Pack the current folder (renumber messages to be 1-N)\n"
12: " c Close the current folder (process deletes and moves).\n"
13: " s Scavenge the current folder (regenerate header buffer)\n"
14: " f Show a list of the existing folders\n"
15: " l Print the current message on the line printer.\n"
16: " m Make a new folder.\n"
17: " k Kill a folder (erase it and all of its contents)\n"
18: )
19: )
20: (setq mode-line-format
21: "mhe extended command mode. Type 'q' to quit this mode %M")
22: (setq buffer-is-modified 0)
23: (beginning-of-file) (end-of-line) (backward-character)
24: (backward-character)
25: (local-bind-to-key "&mh-xpack" "p")
26: (local-bind-to-key "&mh-xclose" "c")
27: (local-bind-to-key "&mh-xscavenge" "s")
28: (local-bind-to-key "&mh-xfolders" "f")
29: (local-bind-to-key "&mh-xlprint" "l")
30: (local-bind-to-key "&mh-xmake" "m")
31: (local-bind-to-key "&mh-xkill" "k")
32: (recursive-edit)
33: (pop-to-buffer "mh-xcommands")
34: (delete-window)
35: )
36: )
37: (&mh-beep (error-message "Use 'q' to quit this extended command mode."))
38:
39: (&mh-xpack
40: (pop-to-buffer (concat "+" mh-folder))
41: (&mh-pack-folder)
42: (&mh-adjust-window)
43: (exit-emacs)
44: )
45:
46: (&mh-xclose
47: (message "C: close folder...") (sit-for 0)
48: (pop-to-buffer (concat "+" mh-folder))
49: (message "C: close folder...") (sit-for 1)
50: (&mh-close-folder)
51: (exit-emacs)
52: )
53:
54: (&mh-xscavenge sm
55: (pop-to-buffer (concat "+" mh-folder))
56: (setq sm mode-line-format)
57: (&mh-regenerate-headers)
58: (setq mode-line-format sm)
59: (exit-emacs)
60: )
61:
62: (&mh-xfolders
63: (message "F: list folders...")
64: (pop-to-buffer "mh-temp")
65: (use-local-map "&mh-keymap")
66: (erase-buffer) (sit-for 0)
67: (send-to-shell (concat mh-progs "/folders"))
68: (exit-emacs)
69: )
70:
71: (&mh-xlprint
72: (error-message "L: command not implemented.")
73: )
74:
75: (&mh-xmake exists msgg name
76: (message "M: make a new folder...")
77: (setq exists 1)
78: (setq msgg "M: make a new folder...name for it? ")
79: (while exists
80: (setq name (get-tty-string msgg))
81: (if (= 0 (length name))
82: (progn
83: (message "Aborted.") (sit-for 5)
84: (exit-emacs)))
85: (if (!= (string-to-char (substr name 1 1)) '/')
86: (setq t-buffer-filename (concat mh-path "/" name))
87: (setq t-buffer-filename name)
88: )
89: (setq exists (file-exists t-buffer-filename))
90: (if (= exists 1)
91: (setq msgg (concat "Folder +" name " already exists. Try another name? "))
92: )
93: )
94: (send-to-shell
95: (concat "mkdir " t-buffer-filename))
96: (exit-emacs)
97: )
98:
99: (&mh-xkill exists action name msgg
100: (message "K: kill a folder, erasing all of its contents...")
101: (setq exists 0)
102: (setq msgg "K: kill a folder, erasing all of its contents...which folder? ")
103: (while (! exists)
104: (setq name (get-tty-string msgg))
105: (if (= 0 (length name))
106: (progn
107: (message "Aborted.") (sit-for 5)
108: (exit-emacs)))
109: (if (!= (string-to-char (substr name 1 1)) '/')
110: (setq t-buffer-filename (concat mh-path "/" name))
111: (setq t-buffer-filename name)
112: )
113: (setq exists (file-exists t-buffer-filename))
114: (if (= exists 0)
115: (setq msgg (concat "Folder +" name " does not exist. Try another name? "))
116: )
117: )
118: (setq action
119: (get-response (concat "Do you really want to destroy folder +"
120: name " and all its contents? ")
121: "yYnN\3" "Please answer y or n"))
122: (if (= name "inbox")
123: (setq action
124: (get-response "That's your one and only inbox you are asking me to destroy. Still sure? "
125: "yYnN\3" "Please answer y or n: destroy inbox??? ")))
126: (if (= action 'y')
127: (progn
128: (send-to-shell (concat "rmf +" name))
129: (message "OK, the deed is done... +" name " destroyed.")
130: )
131: (message "Nothing has been destroyed.")
132: )
133: (sit-for 10)
134: (exit-emacs)
135: )
136: )
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.