home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
me34src.zip
/
me3
/
mutt
/
package
/
muttmode.mut
< prev
next >
Wrap
Text File
|
1995-01-14
|
9KB
|
355 lines
;; muttmode.mut : an electric Mutt mode
;; C Durland Public Domain
(const
Mutt-indent 2
Mutt-wrapper 75 ; column to wrap block comments at
Mutt-start-comment ";; " ; what a comment usually starts with
Enter-key-action "newline-and-indent"
)
(include me.mh)
(include bs_untab.mut)
(int Mutt-mode-keymap Mutt-comment-keymap)
(defun
MAIN
{
(bind-key (Mutt-mode-keymap (create-keymap))
Enter-key-action "C-m"
"Mutt-mode-{" "{"
; "Mutt-mode-(" "("
"Mutt-commento" "M-;"
"format-Mutt-comment" "M-J"
"BS-untabify" "C-h"
"deref-key" "F-3"
"pgm-completer" "F-4"
"pgm-completer-in-place""M-C-[" ;; ESC ESC
"pgm-ask-complete" "M-="
"Mutt-help" "M-?"
)
(bind-key (Mutt-comment-keymap (create-keymap))
"Mutt-Enter" "C-m"
"end-Mutt-comment" "M-;"
"format-Mutt-comment" "M-J"
"BS-untabify" "C-h"
"deref-key" "F-3"
"pgm-completer" "F-4"
"pgm-completer-in-place""M-C-[" ;; ESC ESC
"pgm-ask-complete" "M-="
"Mutt-help" "M-?"
)
}
mutt-mode
{
(clear-modes)
(install-keymap Mutt-mode-keymap LOCAL-KEYMAP)
(major-mode "Mutt")
}
Mutt-help
{
(load-code "web" FALSE TRUE) ;;!!! yuch
(web-word)
}
)
(list Mutt-keywords)
(defun
deref-key ;; insert name of the function bound to a key
{
(string key bind)
(key (ask "Key: "))
(if (!= "" (bind (key-bound-to key)))(insert-text bind))
}
pgm-completer ;; use command completion
{
(insert-text
(complete (+ CC_PGM CC_MUTT CC_SYSVAR CC_LIST)
"Command: " Mutt-keywords))
}
pgm-completer-in-place ;; complete word in place
{
(int n)
(string new-word)
(if (not (looking-at '\<')) (forward-word -1))
(n (looking-at '\(\w+\)' FALSE TRUE))
(if (!= "" (new-word
(complete (+ CC_PGM CC_MUTT CC_SYSVAR CC_LIST CC_NO_ASK)
(get-matched '\1') Mutt-keywords)))
{
(delete-char n)
(insert-text new-word)
})
}
pgm-ask-complete ;; complete word in place with asking
{
(int n)
(string old-word new-word)
(if (not (looking-at '\<')) (forward-word -1))
(n (looking-at '\(\w+\)' FALSE TRUE))
(old-word (get-matched '\1'))
(ask-user)
(prime-ask (complete (+ CC_PGM CC_MUTT CC_SYSVAR CC_LIST CC_NO_ASK)
old-word Mutt-keywords))
(new-word (complete (+ CC_PGM CC_MUTT CC_SYSVAR CC_LIST)
(concat "[" old-word "] Completing: ") Mutt-keywords))
(delete-char n)
(insert-text new-word)
}
MAIN
{
(insert-object Mutt-keywords 1 ;; most of them anyway
"arg" "array" "ask" "ask-user" "bool" "break" "byte" "concat"
"cond" "const" "continue" "convert-to" "defun" "done"
"extract-element" "extract-elements" "floc" "goto" "halt"
"include" "insert-object" "int" "label" "length-of" "list" "nargs"
"novalue" "pointer" "push-arg" "push-args" "remove-elements"
"small-int" "string" "switch" "while")
}
)
(defun
"Mutt-mode-{" ;; handle { and {{
{
(int key)
(insert-text "{")(update)
(if (== 0x7B (key (get-key))) ;; {{
{ (insert-text "{")(update)(do-brace (get-key) "}}" -4) }
(do-brace key "}" -3))
}
do-brace (int key)(string braces)(int back) HIDDEN
{
(int n)
(switch key
Space-bar
(cond
(looking-at '\ *$') ;; only ws til end of line
{
(insert-text " () " braces)
(if (control1 0) { (insert-text ")")(forward-char -1) })
(forward-char back)
}
(looking-at ')\ *$') ;; only ")ws" til end of line
{
(insert-text " () " braces)
(forward-char back)
}
TRUE (insert-text " "))
Enter-key
{
(newline-and-indent)(n (+ Mutt-indent (current-column)))
(cond
(looking-at '\ *$') ;; white space to end of line
{
(insert-text braces)
(if (control1 -2) (insert-text ")"))
(beginning-of-line)(open-line)(to-col n)
(insert-text "()")(forward-char -1)
}
(looking-at ')\ *$') ;; )white space to end of line
{
(insert-text braces)
(beginning-of-line)(open-line)(to-col n)
(insert-text "()")(forward-char -1)
}
TRUE (to-col n))
}
default (exe-key key)
)
}
control1 (int n) HIDDEN
{
(save-point
{{
(forward-line (arg 0))
(or
(looking-at '\ *(while')
(looking-at '\ *(for'))
}} n)
}
)
(defun
"Mutt-mode-(" ;; handle (
{
(if (or
(== 1 (current-column))
(save-point
{{
(forward-char -1)
(is-space)
}}))
{
(insert-text "()")(forward-char -1)
}
(insert-text "("))
}
)
(include runblock.mut)
(defun
Mutt-comment-out-block { (run-pgm-on-block {{ (insert-text ";") }}) }
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;; Comment Mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun
Mutt-commento ;; Start up a block comment
{
(int col)
(col (current-column))(beginning-of-line)
(if (looking-at '\ *$') ;; blank line => can start a block comment
{ (current-column col)(insert-text Mutt-start-comment) }
{
(if (looking-at '\ *;') ; "blanks ;" => can restart a block comment
(current-column col)
{
;; none of the above => bad place for a comment
(current-column col)
(msg "Not a valid place to start a block comment!")
(done)
})
})
;; finish up turning on block comment mode
(word-wrap Mutt-wrapper)
(install-keymap Mutt-comment-keymap LOCAL-KEYMAP)
(minor-mode "Dr. Commento")
}
end-Mutt-comment
{
(int col)
;; if [ws];[;...][ws] only thing on line, clear the line
(col (current-column))
(beginning-of-line)
(if (looking-at '\ *;+\ *$') ; [ws];[;...][ws]$
(cut-line)
(current-column col))
;; turn off comment mode
(minor-mode "")
(word-wrap 0)
(install-keymap Mutt-mode-keymap LOCAL-KEYMAP)
}
Mutt-Enter ; handle Return
{
(int key)
(open-line)(beginning-of-line)
(if (looking-at '\(\ *;+\ *\)') ; [ws];[;...][ws]
{
(forward-line 1)
(insert-text (get-matched '\1'))
})
}
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;; Format Block Comment ;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(include block.mut)
(defun
format-Mutt-comment
{
(int offset code-buffer-id scrbuf bag-id)
(string semis)
(code-buffer-id (current-buffer))
(delete-region-as-block)
(current-buffer (scrbuf (create-buffer scratch-buffer)))
(clear-buffer)
(insert-bag CUT-BUFFER)
; get the ;'s that start a comment
(beginning-of-buffer)
(semis
(if (re-search-forward '^\ *\(;+\)') ; [ws];[;...]
(get-matched '\1')
";;" ; if no ;'s, use my favorite
))
; Get the block offset from left margin
; Hopefully on same line as start comment
(beginning-of-line)
(while (is-space) (next-character))
(offset (current-column))
(beginning-of-buffer)
(re-search-replace '^\ *;+' "") ; get rid of [white-space];[;...]
(msg "Formatting comment ...")
(beginning-of-buffer)
(adjust-lines 10000 (- Mutt-wrapper (- offset 1) (length-of semis)) FALSE)
(beginning-of-buffer)
; put ;'s in front of text
(while (not (EoB))
{
(if (looking-at '^$')
{ (arg-prefix 1)(cut-line)(continue) } ; remove blank lines
{ (to-col offset)(insert-text semis) } ; else prepend ;
)
(forward-line 1)
})
; replace comment
(beginning-of-buffer)(set-mark)(end-of-buffer)
(append-to-bag (bag-id (create-bag)) APPEND-REGION)
(msg "Comment formatted.")
(current-buffer code-buffer-id)
(insert-bag bag-id)
; clean up
(free-buffer scrbuf)(free-bag bag-id)
}
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;; Create a Header ;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun
Mutt-header-with-text
{
(int n len)
(string text)
(text (ask "Header text: "))
(n (/ (- 68 (len (length-of text))) 2))
(insert-text
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;^J"
(extract-elements
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;"
0 n)
" " text " "
(extract-elements
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;"
0 n)
(if (!= len (* 2 (/ len 2))) ";" "") ;; pad odd length text
"^J"
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;^J")
}
)