Annotation of 43BSDReno/contrib/mh/miscellany/mhe/mh-extras.ml, revision 1.1.1.1

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: )

unix.superglobalmegacorp.com

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