home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34exe.zip / mutt / package / muttmode.mut < prev    next >
Text File  |  1995-01-14  |  9KB  |  355 lines
  1.   ;; muttmode.mut : an electric Mutt mode
  2.   ;; C Durland    Public Domain
  3.  
  4. (const
  5.   Mutt-indent    2
  6.   Mutt-wrapper 75    ; column to wrap block comments at
  7.  
  8.   Mutt-start-comment ";; "    ; what a comment usually starts with
  9.  
  10.   Enter-key-action "newline-and-indent"
  11. )
  12.  
  13. (include me.mh)
  14. (include bs_untab.mut)
  15.  
  16. (int Mutt-mode-keymap Mutt-comment-keymap)
  17.  
  18. (defun
  19.   MAIN
  20.   {
  21.     (bind-key (Mutt-mode-keymap (create-keymap))
  22.     Enter-key-action    "C-m"
  23.     "Mutt-mode-{"        "{"
  24. ;    "Mutt-mode-("        "("
  25.     "Mutt-commento"        "M-;"
  26.  
  27.     "format-Mutt-comment"    "M-J"
  28.     "BS-untabify"        "C-h"
  29.     "deref-key"        "F-3"
  30.     "pgm-completer"        "F-4"
  31.     "pgm-completer-in-place""M-C-["        ;; ESC ESC
  32.     "pgm-ask-complete"    "M-="
  33.     "Mutt-help"        "M-?"
  34.     )
  35.     (bind-key (Mutt-comment-keymap (create-keymap))
  36.     "Mutt-Enter"        "C-m"
  37.     "end-Mutt-comment"    "M-;"
  38.  
  39.     "format-Mutt-comment"    "M-J"
  40.     "BS-untabify"        "C-h"
  41.     "deref-key"        "F-3"
  42.     "pgm-completer"        "F-4"
  43.     "pgm-completer-in-place""M-C-["        ;; ESC ESC
  44.     "pgm-ask-complete"    "M-="
  45.     "Mutt-help"        "M-?"
  46.     )
  47.   }
  48.   mutt-mode
  49.   {
  50.     (clear-modes)
  51.  
  52.     (install-keymap Mutt-mode-keymap LOCAL-KEYMAP)
  53.     (major-mode "Mutt")
  54.   }
  55.   Mutt-help 
  56.   {
  57.     (load-code "web" FALSE TRUE)        ;;!!! yuch
  58.     (web-word)
  59.   }
  60. )
  61.  
  62. (list Mutt-keywords)
  63.  
  64. (defun
  65.   deref-key    ;; insert name of the function bound to a key
  66.   {
  67.     (string key bind)
  68.     (key (ask "Key: "))
  69.     (if (!= "" (bind (key-bound-to key)))(insert-text bind))
  70.   }
  71.   pgm-completer        ;; use command completion
  72.   {
  73.     (insert-text
  74.       (complete (+ CC_PGM CC_MUTT CC_SYSVAR CC_LIST)
  75.     "Command: " Mutt-keywords))
  76.   }
  77.   pgm-completer-in-place    ;; complete word in place
  78.   {
  79.     (int n)
  80.     (string new-word)
  81.  
  82.     (if (not (looking-at '\<')) (forward-word -1))
  83.     (n (looking-at '\(\w+\)' FALSE TRUE))
  84.     (if (!= "" (new-word
  85.           (complete (+ CC_PGM CC_MUTT CC_SYSVAR CC_LIST CC_NO_ASK)
  86.             (get-matched '\1') Mutt-keywords)))
  87.       {
  88.     (delete-char n)
  89.     (insert-text new-word)
  90.       })
  91.   }
  92.   pgm-ask-complete    ;; complete word in place with asking
  93.   {
  94.     (int n)
  95.     (string old-word new-word)
  96.  
  97.     (if (not (looking-at '\<')) (forward-word -1))
  98.     (n (looking-at '\(\w+\)' FALSE TRUE))
  99.     (old-word (get-matched '\1'))
  100.     (ask-user)
  101.     (prime-ask (complete (+ CC_PGM CC_MUTT CC_SYSVAR CC_LIST CC_NO_ASK)
  102.             old-word Mutt-keywords))
  103.     (new-word  (complete (+ CC_PGM CC_MUTT CC_SYSVAR CC_LIST)
  104.         (concat "[" old-word "] Completing: ") Mutt-keywords))
  105.     (delete-char n)
  106.     (insert-text new-word)
  107.   }
  108.   MAIN
  109.   {
  110.     (insert-object Mutt-keywords 1    ;; most of them anyway
  111.       "arg" "array" "ask" "ask-user" "bool" "break" "byte" "concat"
  112.       "cond" "const" "continue" "convert-to" "defun" "done"
  113.       "extract-element" "extract-elements" "floc" "goto" "halt"
  114.       "include" "insert-object" "int" "label" "length-of" "list" "nargs"
  115.       "novalue" "pointer" "push-arg" "push-args" "remove-elements"
  116.       "small-int" "string" "switch" "while")
  117.   }
  118. )
  119.  
  120. (defun
  121.   "Mutt-mode-{"        ;; handle { and {{
  122.   {
  123.     (int key)
  124.  
  125.     (insert-text "{")(update)
  126.     (if (== 0x7B (key (get-key)))        ;; {{
  127.       { (insert-text "{")(update)(do-brace (get-key) "}}" -4) }
  128.       (do-brace key "}"  -3))
  129.   }
  130.   do-brace (int key)(string braces)(int back) HIDDEN
  131.   {
  132.     (int n)
  133.  
  134.     (switch key
  135.       Space-bar
  136.         (cond
  137.       (looking-at '\ *$')    ;; only ws til end of line
  138.       {
  139.         (insert-text " () " braces)
  140.         (if (control1 0) { (insert-text ")")(forward-char -1) })
  141.         (forward-char back)
  142.       }
  143.       (looking-at ')\ *$')    ;; only ")ws" til end of line
  144.       {
  145.         (insert-text " () " braces)
  146.         (forward-char back)
  147.       }
  148.       TRUE (insert-text " "))
  149.       Enter-key
  150.         {
  151.       (newline-and-indent)(n (+ Mutt-indent (current-column)))
  152.       (cond
  153.         (looking-at '\ *$')    ;; white space to end of line
  154.         {
  155.           (insert-text braces)
  156.           (if (control1 -2) (insert-text ")"))
  157.           (beginning-of-line)(open-line)(to-col n)
  158.           (insert-text "()")(forward-char -1)
  159.         }
  160.         (looking-at ')\ *$')    ;; )white space to end of line
  161.         {
  162.           (insert-text braces)
  163.           (beginning-of-line)(open-line)(to-col n)
  164.           (insert-text "()")(forward-char -1)
  165.         }
  166.         TRUE (to-col n))
  167.     }
  168.       default (exe-key key)
  169.     )
  170.   }
  171.   control1 (int n)    HIDDEN
  172.   {
  173.     (save-point
  174.       {{
  175.     (forward-line (arg 0))
  176.     (or
  177.       (looking-at '\ *(while')
  178.       (looking-at '\ *(for'))
  179.       }} n)
  180.   }
  181. )
  182.  
  183. (defun
  184.   "Mutt-mode-("        ;; handle (
  185.   {
  186.     (if (or
  187.       (== 1 (current-column))
  188.       (save-point
  189.         {{
  190.           (forward-char -1)
  191.           (is-space)
  192.         }}))
  193.       {
  194.     (insert-text "()")(forward-char -1)
  195.       }
  196.       (insert-text "("))
  197.   }
  198. )
  199.  
  200.  
  201. (include runblock.mut)
  202. (defun
  203.   Mutt-comment-out-block { (run-pgm-on-block {{ (insert-text ";") }}) }
  204. )
  205.  
  206.  
  207. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  208. ;;;;;;;;;;;;;;;;;;;;;;;;;;;; Comment Mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  209. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  210.  
  211. (defun
  212.   Mutt-commento        ;; Start up a block comment
  213.   {
  214.     (int col)
  215.  
  216.     (col (current-column))(beginning-of-line)
  217.     (if (looking-at '\ *$')    ;; blank line => can start a block comment
  218.       { (current-column col)(insert-text Mutt-start-comment) }
  219.       {
  220.     (if (looking-at '\ *;')    ; "blanks ;" => can restart a block comment
  221.       (current-column col)
  222.       {
  223.         ;; none of the above => bad place for a comment
  224.         (current-column col)
  225.         (msg "Not a valid place to start a block comment!")
  226.         (done)
  227.       })
  228.       })
  229.     ;; finish up turning on block comment mode
  230.     (word-wrap Mutt-wrapper)
  231.  
  232.     (install-keymap Mutt-comment-keymap LOCAL-KEYMAP)
  233.  
  234.     (minor-mode "Dr. Commento")
  235.   }
  236.   end-Mutt-comment
  237.   {
  238.     (int col)
  239.  
  240.     ;; if [ws];[;...][ws] only thing on line, clear the line
  241.     (col (current-column))
  242.     (beginning-of-line)
  243.     (if (looking-at '\ *;+\ *$')    ; [ws];[;...][ws]$
  244.       (cut-line)
  245.       (current-column col))
  246.  
  247.     ;; turn off comment mode
  248.     (minor-mode "")
  249.     (word-wrap 0)
  250.  
  251.     (install-keymap Mutt-mode-keymap LOCAL-KEYMAP)
  252.   }
  253.   Mutt-Enter        ; handle Return
  254.   {
  255.     (int key)
  256.  
  257.     (open-line)(beginning-of-line)
  258.     (if (looking-at '\(\ *;+\ *\)') ; [ws];[;...][ws]
  259.     {
  260.       (forward-line 1)
  261.       (insert-text (get-matched '\1'))
  262.     })
  263.   }
  264. )
  265.  
  266. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  267. ;;;;;;;;;;;;;;;;;;;;;;;; Format Block Comment ;;;;;;;;;;;;;;;;;;;;;;;;
  268. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  269.  
  270. (include block.mut)
  271.  
  272. (defun
  273.   format-Mutt-comment
  274.   {
  275.     (int offset code-buffer-id scrbuf bag-id)
  276.     (string semis)
  277.  
  278.     (code-buffer-id (current-buffer))
  279.     (delete-region-as-block)
  280.  
  281.     (current-buffer (scrbuf (create-buffer scratch-buffer)))
  282.     (clear-buffer)
  283.     (insert-bag CUT-BUFFER)
  284.  
  285.     ; get the ;'s that start a comment
  286.     (beginning-of-buffer)
  287.     (semis
  288.       (if (re-search-forward '^\ *\(;+\)')        ; [ws];[;...]
  289.         (get-matched '\1')
  290.         ";;"    ; if no ;'s, use my favorite
  291.       ))
  292.     ; Get the block offset from left margin
  293.     ; Hopefully on same line as start comment
  294.     (beginning-of-line)
  295.     (while (is-space) (next-character))
  296.     (offset (current-column))
  297.  
  298.     (beginning-of-buffer)
  299.     (re-search-replace '^\ *;+' "")    ; get rid of [white-space];[;...]
  300.     (msg "Formatting comment ...")
  301.     (beginning-of-buffer)
  302.     (adjust-lines 10000 (- Mutt-wrapper (- offset 1) (length-of semis)) FALSE)
  303.     (beginning-of-buffer)
  304.  
  305.     ; put ;'s in front of text
  306.     (while (not (EoB))
  307.     {
  308.       (if (looking-at '^$')
  309.         { (arg-prefix 1)(cut-line)(continue) }        ; remove blank lines
  310.     { (to-col offset)(insert-text semis) }        ; else prepend ;
  311.       )
  312.       (forward-line 1)
  313.     })
  314.  
  315.     ; replace comment
  316.     (beginning-of-buffer)(set-mark)(end-of-buffer)
  317.     (append-to-bag (bag-id (create-bag)) APPEND-REGION)
  318.  
  319.     (msg "Comment formatted.")
  320.  
  321.     (current-buffer code-buffer-id)
  322.     (insert-bag bag-id)
  323.  
  324.     ; clean up
  325.     (free-buffer scrbuf)(free-bag bag-id)
  326.   }
  327. )
  328.  
  329. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  330. ;;;;;;;;;;;;;;;;;;;;;;;;;; Create a Header ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  331. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  332.  
  333. (defun
  334.   Mutt-header-with-text
  335.   {
  336.     (int n len)
  337.     (string text)
  338.  
  339.     (text (ask "Header text: "))
  340.     (n (/ (- 68 (len (length-of text))) 2))
  341.     (insert-text
  342. ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;^J"
  343.       (extract-elements
  344.         ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;"
  345.     0 n)
  346.       " " text " "
  347.       (extract-elements
  348.         ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;"
  349.     0 n)
  350.       (if (!= len (* 2 (/ len 2))) ";" "")    ;; pad odd length text
  351.       "^J"
  352. ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;^J")
  353.   }
  354. )
  355.