Return to mh-extras.ml CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / mh / miscellany / mhe

Annotation of 43BSD/contrib/mh/miscellany/mhe/mh-extras.ml, revision 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: )

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