Added -clobber switch to mhstore(1) [Bug #11160].
[mmh] / docs / historical / mh-6.8.5 / miscellany / mhe / mh-extras.ml
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 )