Annotation of 43BSD/contrib/mh/miscellany/emh/emh.ml, revision 1.1

1.1     ! root        1: ; emh.ml :: another emacs-based interface to the Rand MH system
        !             2: ; Tue Oct  4 22:57:25 1983     /mtr  <mrose@uci-750a>
        !             3: ; This is meant to be a "fast" interface for emacs.  We use the process
        !             4: ; sentinel stuff to help us do things asynchronously.
        !             5: 
        !             6: 
        !             7: (declare-global &mhpath &mhbuffer &mhdmax)
        !             8: (declare-buffer-specific &mhdir &mhfolder &mhmsg &mhreadonly)
        !             9: (setq &mhdmax 4)
        !            10: (if (! (is-bound &mhexec))
        !            11:     (setq-default &mhexec "emh"))
        !            12: (if (! (is-bound &mhtemp))
        !            13:     (setq-default &mhtemp "MH scratch"))
        !            14: (if (! (is-bound &mhunique))
        !            15:     (setq-default &mhunique 0))
        !            16: 
        !            17: (defun 
        !            18:     
        !            19:     (&emh &args
        !            20:          (setq &args 
        !            21:                (if (| prefix-argument-provided (> (nargs) 0))
        !            22:                    (arg 1 ": emh (args) ") "+inbox"))
        !            23:          (&mh-daemon)
        !            24:          (if (!= (substr &args 1 1) "+")
        !            25:              (setq &args (concat "+" &args)))
        !            26:          (if (error-occured (next-buffer-name &args)) 
        !            27:              (&mh-scan &args)
        !            28:              (pop-to-buffer &args))
        !            29:          
        !            30:          (novalue)
        !            31:     )
        !            32:     
        !            33:     (&mh-cur-folder &fdr
        !            34:        (if (!= &mhfolder "") &mhfolder 
        !            35:            (!= &mhbuffer "") &mhbuffer
        !            36:            (error-message "no cur folder"))
        !            37:     )
        !            38:     
        !            39:     (&mh-cur-message &msg
        !            40:        (save-excursion 
        !            41:            (temp-use-buffer (&mh-cur-folder))
        !            42:            (beginning-of-line) (set-mark)
        !            43:            (if (error-occured
        !            44:                    (provide-prefix-argument &mhdmax (forward-character)))
        !            45:                (error-message "no cur message"))
        !            46:            (setq &msg (region-to-string))
        !            47:            (beginning-of-line)
        !            48:        )
        !            49:        (if (error-occured (setq &msg (+ &msg 0)))
        !            50:            (error-message "no cur message"))
        !            51:        
        !            52:        &msg
        !            53:     )
        !            54:     
        !            55:     (&mh-daemon &current
        !            56:        (setq &current "")
        !            57:        (while (!= (setq &current (next-buffer-name &current)) "")
        !            58:               (save-excursion 
        !            59:                   (temp-use-buffer &current)
        !            60:                   (if (& (!= &current MPX-process)
        !            61:                          (&mh-prefix &mhexec &current)
        !            62:                          (< (process-status &current) 0)
        !            63:                          (= mode-string "Exited"))
        !            64:                       (progn &deleted
        !            65:                              (setq &current
        !            66:                                    (next-buffer-name
        !            67:                                        (setq &deleted &current)))
        !            68:                              (delete-buffer &deleted)))))
        !            69:     )
        !            70:     
        !            71:     (&mh-find-entry &field &value
        !            72:        (setq &field (arg 1 ": mh-find-entry (name) "))
        !            73:        (save-excursion 
        !            74:            (temp-use-buffer &mhtemp)
        !            75:            (erase-buffer)
        !            76:            (error-occured 
        !            77:                (insert-file (expand-file-name "~/.mh_profile"))
        !            78:                (beginning-of-file)
        !            79:                (re-search-forward (concat "^" (quote &field) ": "))
        !            80:                (delete-white-space) (set-mark)
        !            81:                (end-of-line) (delete-white-space)
        !            82:                (setq &value (region-to-string)))
        !            83:            (delete-buffer &mhtemp))
        !            84:        
        !            85:        &value
        !            86:     )
        !            87:     
        !            88:     (&mh-path &name
        !            89:        (setq &name (arg 1 ": mh-path (name) "))
        !            90:        (if (= (substr &name 1 1) "/") &name
        !            91:            (= (substr &name 1 1) ".") (expand-file-name &name)
        !            92:            (concat &mhpath &name))
        !            93:     )
        !            94:     
        !            95:     (&mh-prefix &pattern &target
        !            96:        (setq &pattern (arg 1 ": mh-prefix (pattern) "))
        !            97:        (setq &target
        !            98:              (arg 2 (concat ": mh-prefix (pattern) " &pattern " (target) ")))
        !            99:        (& (> (length &target) (length &pattern))
        !           100:           (= &pattern (substr &target 1 (length &pattern))))
        !           101:     )
        !           102:     
        !           103:     (&mh-set-cur &current
        !           104:        (setq &current (arg 1 ": mh-setcur (msg) "))
        !           105:        (while (< (length &current) &mhdmax)
        !           106:               (setq &current (concat " " &current)))
        !           107:        (save-excursion 
        !           108:            (temp-use-buffer (&mh-cur-folder))
        !           109:            (beginning-of-file)
        !           110:            (error-occured (re-replace-string "^\\([ ]*[0-9]*\\)+" "\\1 "))
        !           111:            (end-of-file)
        !           112:            (error-occured (re-search-reverse (concat "^" &current)))
        !           113:            (if (! (eobp))
        !           114:                (progn 
        !           115:                       (beginning-of-line)
        !           116:                       (provide-prefix-argument &mhdmax (forward-character))
        !           117:                       (delete-next-character) (insert-character '+'))
        !           118:                (beginning-of-file)))
        !           119:        
        !           120:        (novalue)
        !           121:     )
        !           122:     
        !           123:     (&mh-start-process &command &connect &ushell
        !           124:        (setq &command (arg 1 ": mh-start-process (command) "))
        !           125:        (setq &connect
        !           126:              (arg 2
        !           127:                   (concat ": mh-start-process (command) " &command 
        !           128:                           " (buffer) ")))
        !           129:        (error-occured 
        !           130:            (setq &ushell use-users-shell)
        !           131:            (setq use-users-shell 0))
        !           132:        (start-process &command &connect)
        !           133:        (error-occured (setq use-users-shell &ushell))
        !           134:        (novalue)
        !           135:     )
        !           136:     
        !           137:     (&mh-unique
        !           138:        (concat
        !           139:               (arg 1 ": mh-unique (prefix) ")
        !           140:               (setq &mhunique (+ &mhunique 1)))
        !           141:     )
        !           142: )
        !           143: 
        !           144: (progn 
        !           145:     (if (= (file-exists (expand-file-name "~/.mh_profile")) 0)
        !           146:        (error-message "no MH profile"))
        !           147:     (if (!= (substr (setq &mhpath (&mh-find-entry "Path")) 1 1) "/")
        !           148:        (setq &mhpath (expand-file-name (concat "~/" &mhpath))))
        !           149:     (if (!= (substr &mhpath -1 1) "/")
        !           150:        (setq &mhpath (concat &mhpath "/")))
        !           151: 
        !           152:     (autoload "&mh-folders" "emh-list.ml")
        !           153:     (autoload "&mh-file"    "emh-move.ml")
        !           154:     (autoload "&mh-rmm"     "emh-move.ml")
        !           155:     (autoload "&mh-help"    "emh-help.ml")
        !           156:     (autoload "&mh-inc"     "emh-inc.ml")
        !           157:     (autoload "&mh-scan"    "emh-scan.ml")
        !           158:     (autoload "&mh-comp"    "emh-send.ml")
        !           159:     (autoload "&mh-forw"    "emh-send.ml")
        !           160:     (autoload "&mh-repl"    "emh-send.ml")
        !           161:     (autoload "&mh-next"    "emh-type.ml")
        !           162:     (autoload "&mh-prev"    "emh-type.ml")
        !           163:     (autoload "&mh-show"    "emh-type.ml")
        !           164: 
        !           165:     (bind-to-key "&mh-folders" "\^Xf")
        !           166:     (bind-to-key "&mh-inc"     "\^Xi")
        !           167:     (bind-to-key "&mh-comp"    "\^Xm")
        !           168:     (bind-to-key "&emh"        "\^Xr")
        !           169: 
        !           170:     (save-excursion &i
        !           171:        (temp-use-buffer &mhtemp)
        !           172:        (define-keymap "&mh-keymap")
        !           173:        (use-local-map "&mh-keymap")
        !           174: 
        !           175:        (setq &i ' ')
        !           176:        (while (< &i 127)
        !           177:            (local-bind-to-key "illegal-operation" &i)
        !           178:            (setq &i (+ &i 1)))
        !           179:        (setq &i '0')
        !           180:        (while (< &i '9')
        !           181:            (local-bind-to-key "digit" &i)
        !           182:            (setq &i (+ &i 1)))
        !           183:        (local-bind-to-key "minus" "-")
        !           184: 
        !           185:        (local-bind-to-key "&mh-prev" "\^B")
        !           186:        (local-bind-to-key "&mh-next" "\^F")
        !           187:        (local-bind-to-key "&mh-prev" "\^H")
        !           188:        (local-bind-to-key "&mh-help" "?")
        !           189:        (local-bind-to-key "&mh-comp" "C")
        !           190:        (local-bind-to-key "&mh-rmm"  "D")
        !           191:        (local-bind-to-key "&mh-forw" "F")
        !           192:         (local-bind-to-key "&mh-help" "H")
        !           193:        (local-bind-to-key "&mh-inc"  "I")
        !           194:        (local-bind-to-key "&mh-file" "M")
        !           195:        (local-bind-to-key "&mh-next" "N")
        !           196:        (local-bind-to-key "&mh-prev" "P")
        !           197:        (local-bind-to-key "&mh-repl" "R")
        !           198:        (local-bind-to-key "&mh-show" "S")
        !           199:        (local-bind-to-key "&mh-comp" "c")
        !           200:        (local-bind-to-key "&mh-rmm"  "d")
        !           201:        (local-bind-to-key "&mh-forw" "f")
        !           202:         (local-bind-to-key "&mh-help" "h")
        !           203:        (local-bind-to-key "&mh-inc"  "i")
        !           204:        (local-bind-to-key "&mh-file" "m")
        !           205:        (local-bind-to-key "&mh-next" "n")
        !           206:        (local-bind-to-key "&mh-prev" "p")
        !           207:        (local-bind-to-key "&mh-repl" "r")
        !           208:        (local-bind-to-key "&mh-show" "s")
        !           209: 
        !           210:        (delete-buffer &mhtemp))
        !           211: 
        !           212:     (error-occured (load "emh-custom.ml"))
        !           213: )
        !           214: 
        !           215: (novalue)

unix.superglobalmegacorp.com

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