home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / editor / me_cd.arc / MUTTMODE.MUT < prev    next >
Text File  |  1988-10-10  |  5KB  |  193 lines
  1. ; muttmode.mut : an electric Mutt mode
  2. ; C Durland
  3.  
  4. (const
  5.   Mutt-wrapper 75    ; column to wrap block comments at
  6.  
  7.   Mutt-start-comment ";; "    ; what a comment usually starts with
  8.  
  9.   Enter-key-action "newline-and-indent"
  10. )
  11.  
  12. (defun
  13.   mutt-mode
  14.   {
  15.     (tab-stops 0)(word-wrap 0)
  16.     (bind-local-key Enter-key-action      "^M")
  17.     (bind-local-key "Mutt-mode-{"      "{")
  18.     (bind-local-key "Dr.Commento"      "M-;")
  19.     (bind-local-key "BS-untabify"      "^H")
  20.     (bind-local-key "format-Mutt-comment" "M-J")
  21.     (bind-local-key "deref-key"          "F-3")
  22.     (bind-local-key "pgm-completer"      "F-4")
  23.   }
  24. )
  25.  
  26. (include me.h)
  27. (include bs_untab.mut)
  28.  
  29. (defun
  30.   deref-key    ; insert name of the function bound to a key
  31.   {
  32.     (string key 10 bind 80)
  33.     (key (ask "Key: "))
  34.     (if (!= "" (bind (key-bound-to key)))(insert-text bind))
  35.   }
  36.   pgm-completer        ; use command completion
  37.     { (insert-text (complete "command: " 23)) }
  38.   "Mutt-mode-{"        ; handle {
  39.   {
  40.     (int key n)
  41.     (insert-text "{")(update)
  42.     (switch (key (get-key))
  43.       Space-bar
  44.         (if (looking-at '\ *$')    ; only ws til end of line
  45.       { (insert-text " () }")(arg-prefix 3)(previous-character) }
  46.       (insert-text " ")
  47.     )
  48.       Enter-key
  49.         {
  50.       (newline-and-indent)(n (+ 2 (current-column)))
  51.       (if (looking-at '\ *$')    ; white space to end of line
  52.         {
  53.           (insert-text "}")
  54.           (beginning-of-line)(open-line)(to-col n)
  55.           (insert-text "()")(previous-character)
  56.         }
  57.         (to-col n)
  58.       )
  59.     }
  60.       default (exe-key key)
  61.     )
  62.   }
  63. )
  64.  
  65. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  66. ;;;;;;;;;;;;;;;;;;; Comment Mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  67. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  68.  
  69. (defun
  70.   Dr.Commento        ; Start up a block comment
  71.   {
  72.     (int key col)
  73.  
  74.     (col (current-column))(beginning-of-line)
  75.     (if (not (looking-at '\ *$'))    ; Not ^[ws]$ => not a block comment
  76.     {
  77.       (current-column col)
  78.       (msg "Not a valid place to start a block comment!")
  79.       (done)
  80.     })
  81.     ; turn on block comment mode
  82.     (current-column col)(insert-text Mutt-start-comment)
  83.     (word-wrap Mutt-wrapper)
  84.     (bind-local-key "Dr.Enter"        "C-M")
  85.     (bind-local-key "end-Mutt-comment"    "M-;")
  86.     (msg "Consulting Dr Commento")
  87.   }
  88.   end-Mutt-comment
  89.   {
  90.     (int col)
  91.  
  92.     ;; if [ws];[;...][ws] only thing on line, clear the line
  93.     (col (current-column))
  94.     (beginning-of-line)
  95.     (if (looking-at '\ *;+\ *$')    ; [ws];[;...][ws]$
  96.       (kill-line)
  97.       (current-column col))
  98.  
  99.     ;; turn off comment mode
  100.     (word-wrap 0)
  101.     (bind-local-key Enter-key-action    "C-M")
  102.     (bind-local-key "Dr.Commento"    "M-;")
  103.     (msg "end comment")
  104.   }
  105.   Dr.Enter        ; handle Return
  106.   {
  107.     (int key)
  108.  
  109.     (open-line)(beginning-of-line)
  110. (msg "Still consulting Dr Commento")
  111.     (if (looking-at '\(\ *;+\ *\)') ; [ws];[;...][ws]
  112.     {
  113.       (forward-line 1)
  114.       (insert-text (get-matched '\1'))
  115.     })
  116.   }
  117. )
  118.  
  119. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  120. ;;;;;;;; Format block comment ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  121. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  122.  
  123. (defun
  124.   format-Mutt-comment
  125.   {
  126.     (int offset)
  127.     (string code-buffer 50 semis 50)
  128.  
  129.     (code-buffer (buffer-name -1))
  130.     (delete-region-as-block)
  131.  
  132.     (switch-to-buffer scratch-buffer)
  133.     (buffer-flags -1 BFGone)(clear-buffer -1)
  134.     (insert-register 0)
  135.  
  136.     ; get the ;'s that start a comment
  137.     (beginning-of-buffer)
  138.     (semis
  139.       (if (re-search-forward '^\ *\(;+\)')        ; [ws];[;...]
  140.         (get-matched '\1')
  141.         ";;"    ; if no ;'s, use my favorite
  142.       ))
  143.     ; Get the block offset from left margin
  144.     ; Hopefully on same line as start comment
  145.     (beginning-of-line)
  146.     (while (isspace) (next-character))
  147.     (offset (current-column))
  148.  
  149.     (beginning-of-buffer)
  150.     (re-query-replace '^\ *;+' "")    ; get rid of [white-space];[;...]
  151.  
  152.     (msg "Formatting comment ...")
  153.     (beginning-of-buffer)
  154.     (adjust-lines 10000 (- Mutt-wrapper (- offset 1) (strlen semis)) FALSE)
  155.     (beginning-of-buffer)
  156.     
  157.     ; put ;'s in front of text
  158.     (while (not (EoB))
  159.     {
  160.       (if (looking-at '^$')
  161.         { (arg-prefix 1)(kill-line)(continue) }        ; remove blank lines
  162.     { (to-col offset)(insert-text semis) }        ; else prepend ;
  163.       )
  164.       (forward-line 1)
  165.     })
  166.  
  167.     ; replace comment
  168.     (beginning-of-buffer)(set-mark)(end-of-buffer)
  169.     (clear-register 0)(append-to-register 0)
  170.  
  171.     (msg "Comment formatted.")
  172.  
  173.     (switch-to-buffer code-buffer)(exchange-dot-and-mark)
  174.     (insert-register 0)
  175.  
  176.     ; clean up
  177.     (clear-buffer (attached-buffer scratch-buffer))
  178.   }
  179. )
  180.  
  181. (defun
  182.   delete-region-as-block HIDDEN
  183.   {
  184.     (byte type)(int left-edge width height)(INT size)
  185.  
  186.     (region-stats (loc type))
  187.  
  188.     (if (== type MARK-ABOVE-DOT)(exchange-dot-and-mark))
  189.     (beginning-of-line)
  190.     (arg-prefix height)(kill-line)
  191.   }
  192. )
  193.