home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34exe.zip / mutt / package / compile.mut < prev    next >
Text File  |  1995-01-14  |  13KB  |  481 lines
  1. ;; compile.mut 
  2. ;; 
  3. ;; Remote, multi-process compiles or greps.
  4. ;; Modeled after compile and grep in GNU Emacs.
  5. ;; See documentation in package.doc
  6. ;; Functions:
  7. ;;   compile
  8. ;;   grep
  9. ;;   compile-next-error        C-x`
  10.  
  11. ;; To do:
  12. ;;   Error parsing needs work.
  13. ;;   Add a buffer local compile string.  This way, when working on serveral
  14. ;;     programs at once, can M-x compile them with out having to lookup the
  15. ;;     proper compile string.
  16.  
  17. ;; C Durland 10/91, 1/92    Public Domain
  18.  
  19.  
  20. (include me.mh)
  21.  
  22. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23. ;;;;;;;;;;;;;; Run the Compile Process ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.  
  26. (const
  27.   COMPILE-BUFFER-NAME    "*Compile*"
  28. )
  29.  
  30. (int compilation-buffer compile-process-id)
  31. (bool compile-in-progress scroll-compile)
  32. (string last-compile-command)
  33.  
  34. (defun
  35.   MAIN
  36.   {
  37.     (register-hook PROCESS-HOOK "process-compile-hook")
  38.     (last-compile-command "make")
  39.   }
  40.   compile
  41.   {
  42.     (string command)
  43.  
  44.     (do-the-compile-thing 
  45.       (if (== ""
  46.         (command (ask "Compile command [" last-compile-command "]: ")))
  47.     last-compile-command
  48.         (last-compile-command command))
  49.       "No more errors")
  50.   }
  51.   stop-compile
  52.   {
  53.     (if (not compile-in-progress) { (msg "No compile to stop!") (done) })
  54.     (msg "Sorry, haven't got that implemented yet.")
  55.   }
  56.   grep
  57.   {
  58.     (string command)
  59.  
  60.     (command (ask "Run grep (with args): "))
  61.     (do-the-compile-thing (concat "grep -n " command " /dev/null")
  62.     "No more grep matches")
  63.   }
  64. )
  65.  
  66.  
  67. (string compile-done-message)    ;; used by the error parser
  68.  
  69. (defun
  70.   do-the-compile-thing (string compile-command done-message) HIDDEN
  71.   {
  72.     (int wid)
  73.  
  74.     (if compile-in-progress
  75.       {
  76.     (ask-user)        ;; !!!??? hmmmm
  77.     (if (yesno "Got a compilation process going!  Stop it")
  78.       {
  79.         (msg "Sorry, haven't got that implemented yet.")
  80.         (done)
  81.       }
  82.       (done))
  83.       })
  84.  
  85. ;    (compile-process-id (create-process compile-command))
  86.     (compile-process-id
  87.     (create-process (concat "/bin/sh -c <*> exec " compile-command)))
  88.  
  89.     (if (== -1 compile-process-id) (done))        ;; some kind of error
  90.  
  91.     (if (== -2 (compilation-buffer (attached-buffer COMPILE-BUFFER-NAME)))
  92.        (compilation-buffer
  93.      (create-buffer COMPILE-BUFFER-NAME (bit-or BFFoo BFHidden2))))
  94.  
  95. ;!!!??? why not use popup-buffer?
  96. ;    (if (!= compilation-buffer (current-buffer))
  97.     (if (!= -2 (wid (buffer-displayed compilation-buffer)))
  98.       {
  99.           (current-window wid)
  100.         (if (< (window-height -1) 5) (window-height -1 8))
  101.       }
  102.       {
  103.         (delete-other-windows)(split-window)
  104.     (current-window 0)        ;; move to top window
  105.     (window-height -1 8)
  106.       })
  107.  
  108.     (current-buffer compilation-buffer TRUE) (clear-buffer)
  109.  
  110.     (insert-text "Directory: " (current-directory) "^J")
  111.     (insert-text "Now computing: " '"' compile-command '"' "^J")
  112.  
  113.     (set-mark THE-MARK)            ;; used by (compile-next-error)
  114.  
  115.     (compile-in-progress TRUE)(scroll-compile TRUE)
  116.     (major-mode "Running")
  117.     (next-window)        ;; leave cursor in original buffer
  118.  
  119.     (compile-done-message done-message)
  120.  
  121.     (init-error-parser)
  122.   }
  123.   process-compile-hook (int pid event-type)(message)
  124.   {
  125.     (int wid1 wid2)
  126.  
  127.     (if (== PERROR event-type)
  128.     {
  129.       (if compile-in-progress
  130.         { (current-buffer compilation-buffer) (major-mode "Error") (update) })
  131.       (compile-in-progress FALSE)
  132.       (done)
  133.     })
  134.     (if (not compile-in-progress) (done))
  135.     (if (!= compile-process-id pid) (done))
  136.  
  137.     (current-buffer compilation-buffer)(end-of-buffer)
  138.     (previous-character)    ;; ???something fishy about this
  139.     (switch event-type
  140.       PROCESS-DONE
  141.       {
  142.     (compile-in-progress FALSE)
  143.     (newline)
  144.     (insert-text "Process done.  Exit status:  " message)
  145.     (major-mode (concat "Done: " message))
  146.       }
  147.       OUTPUT-STDOUT { (insert-text message)(beginning-of-line) }
  148.       OUTPUT-STDERR { (insert-text message)(beginning-of-line) }
  149.     )
  150.  
  151.     
  152.         ;; if displayed, update
  153.     (if (and scroll-compile
  154.          (!= -2 (wid2 (buffer-displayed compilation-buffer))))
  155.       {
  156.     (wid1 (current-window))
  157.     (current-window wid2)
  158.     (end-of-buffer)
  159.     (update FALSE)        ;; sync buffer and window dots
  160.     (arg-prefix -1)(reposition-window)
  161.     (current-window wid1)
  162.     (update)        ;; get it onto the screen
  163.       })
  164.   }
  165. )
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  176. ;;;;;;;;;;;;;; Process the Compile Errors ;;;;;;;;;;;;;;;;;;;;;;;;;;
  177. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  178.  
  179.  
  180. ;; Error list:  the stuff needed to find/mark errors in a file that has
  181. ;; been compiled and has errors/warnings.  These are:
  182. ;;   Name of the file with errors
  183. ;;   ?buffer id of the buffer holding the file
  184. ;;   List of tuples that mark each error.  These tuples are:  mark-id of
  185. ;;     the mark pointing to the error line, line number in the error list,
  186. ;;     number of lines of error message.
  187.  
  188. (list error-list)
  189.  
  190. (defun compile-next-error    ; display the next error or warning
  191. {
  192.   (int error-line-mark-id len-of-error-msg error-msg-line wid)
  193.   (string file-name)
  194.  
  195. ;  (if (arg-flag)
  196. ;    (init-error-parser) set-mark to top of compile buffer
  197.  
  198.  
  199.   (if (== 0 (length-of error-list))
  200.     (switch (parse-errors)
  201.       1 
  202.         {
  203.       (if (!= -2 (wid (buffer-displayed compilation-buffer)))
  204.         (free-window wid))
  205.       (msg compile-done-message)
  206.       (done)
  207.     }
  208.       2
  209.         {
  210.       (msg "Wait a sec while the process churns out some stuff.")
  211.       (scroll-compile TRUE)
  212.       (done)
  213.     }
  214.     ))
  215.  
  216.     ;; get info out of error-list
  217.   (file-name        (extract-element error-list 0))
  218.   (error-line-mark-id    (extract-element error-list 1))
  219.   (len-of-error-msg    (extract-element error-list 2))
  220.   (error-msg-line    (extract-element error-list 3))
  221.  
  222.   (remove-elements error-list 0 4)    ;; remove that tuple from the list
  223. ;(msg "ack: >" file-name "< " error-line-mark-id " " len-of-error-msg "  " error-msg-line)(get-key)
  224.  
  225.     ;; get the file and put the dot at the error line
  226.   (visit-file file-name)        ;; visit file with the error
  227. (msg "")
  228.   (goto-mark error-line-mark-id)    ;; put dot at error
  229. (update FALSE)
  230.  
  231.   (free-mark error-line-mark-id)    ;; do some cleanup
  232.  
  233.   (scroll-compile FALSE)
  234.  
  235.     ;; make a window to show error messages in
  236.   (delete-other-windows)(split-window)
  237.   (current-window 0)        ;; move to top window
  238.   (if (> len-of-error-msg 10)
  239.     {
  240.       (len-of-error-msg 10)
  241.       (msg "This line generated lots of errors!")
  242.     })
  243. ;(if (< len-of-error-msg 3) (len-of-error-msg 3))
  244.   (window-height -1 len-of-error-msg)
  245.     ;; display error message(s)
  246.   (current-buffer compilation-buffer TRUE)
  247.   (current-line error-msg-line)(reposition-window)
  248.   (update FALSE)
  249.  
  250.   (current-window 1)
  251. })
  252.  
  253. (int bb-line)
  254. (string bb-fname)
  255.  
  256. (defun
  257.   init-error-parser HIDDEN    MAIN    ;; main so I can debug
  258.   {
  259.     (bind-to-key "compile-next-error"    "C-x`")
  260.  
  261.     (bb-fname "")
  262.  
  263.     (if (!= 0 (length-of error-list)) (msg "Got garbage to clean up"))
  264.  
  265.     (remove-elements error-list 0 100000)
  266. ;;!!!??? free marks in error-list?
  267.   }
  268. )
  269.  
  270.     ;; Parse the compilation buffer
  271.     ;; Output:
  272.     ;;   Stuff added to error-list
  273.     ;; Returns:
  274.     ;;   0 :  parsed some errors or error in error-list
  275.     ;;   1 :  no errors left to parse and compile is done
  276.     ;;   2 :  no errors left to parse but compile not done
  277. (defun parse-errors HIDDEN
  278. {
  279.   (int buffer-size dot lines buffer-row wasted char-at-dot)    ;; BufferInfo
  280.  
  281.   (int error-line len-of-error-msg mark-id n)
  282.   (string current-file-name file-name)
  283.  
  284.   (current-file-name bb-fname)    ;; init file change checker
  285.  
  286.     ;; make sure compile buffer didn't get deleted
  287.   (if  (== -2 (n (attached-buffer COMPILE-BUFFER-NAME)))
  288.     { (msg "Somebody deleted the " COMPILE-BUFFER-NAME " buffer!") (halt) })
  289.  
  290.   (current-buffer n)
  291.   (compilation-buffer n)
  292.  
  293.   (goto-mark THE-MARK)        ;; pick up where we last left off
  294.  
  295. ;(int foo)
  296. (msg "parse-errors: " (buffer-name -1))
  297.  
  298.   (while TRUE        ;; parse lots of errors
  299.   {
  300.     (msg "Parsing error messages ...")
  301.  
  302.     (while (and             ;; skip over garbage
  303.         (not (booboo-line))
  304.         (forward-line 1))
  305.     ())
  306.  
  307.     (if (EoB)        ;; nothing left to parse
  308.       {
  309.     (previous-character)    ;; ???something fishy about this
  310.     (set-mark THE-MARK)
  311.  
  312.     (if (!= 0 (length-of error-list)) { 0 (done) })
  313.     (if compile-in-progress          { 2 (done) })
  314.                         1 (done)
  315.       })
  316.  
  317.     ;; dot at the start of an error line
  318.     (snarf-error-info)
  319.     (error-line bb-line)
  320.     (file-name  bb-fname)
  321. ;(msg "hoho1 >" bb-fname "< " bb-line "    (" current-file-name ")")(get-key)
  322.  
  323.     ;; check for change of file
  324.     (if (!= current-file-name file-name)
  325.       (if (!= 0 (length-of error-list))    ;; already got some errors parsed
  326.     { 0 (done) }
  327.     {
  328.       (current-file-name file-name)
  329. ;(msg "new file: " file-name )(get-key)
  330.     }))
  331.  
  332.     ;; figure out where in the error buffer this message is
  333.     (buffer-stats -1 (loc buffer-size))
  334.  
  335.     (len-of-error-msg 1)
  336.     (while TRUE        ;; see if this is a long message
  337.       {
  338.     (if (not (forward-line 1)) (break))    ;; EoF
  339.     (if (booboo-line)
  340.       {
  341.         (snarf-error-info)
  342.         (if (or (!= current-file-name bb-fname)
  343.             (!= error-line bb-line))
  344.            (break))
  345.        }
  346.        (if (not (looking-at '\ +.')) (break)))
  347.  
  348.     (+= len-of-error-msg 1)
  349.       })
  350.  
  351. ;;;!!!??? limit the number of errors per line
  352.  
  353.     (set-mark THE-MARK)        ;; start of next error message
  354.  
  355. ;(msg "hoho3 >" current-file-name "<  >" file-name "<  " bb-fname)(get-key)
  356.  
  357.  
  358.     (visit-file file-name)        ;; visit file with the error
  359.     (mark-id (create-mark TRUE))
  360.     (current-line error-line)(set-mark mark-id)
  361.  
  362.     (current-buffer compilation-buffer)
  363.  
  364. ;(msg "parsed: >"file-name "< " mark-id "  " len-of-error-msg "  " buffer-row " " error-line)(get-key)
  365.  
  366.     (insert-object error-list 10000
  367.     file-name mark-id len-of-error-msg buffer-row)
  368.  
  369. ;; if more than x errors ((length-of error-list) > x), 
  370. ;; skip over the rest of the error for this file
  371. ;; (while (or (and (booboo-line) { (snarf) file != current file })) (forward-line)
  372.  
  373.   })    ;; end while
  374.   ;; never gets here
  375. })
  376.  
  377. ;; Real life examples:
  378. ;;   HP-UX s300 8.x C:
  379. ;;     "foo.c", line 29: syntax error:
  380. ;;       static int client_socket = -1;
  381. ;;           ^
  382. ;;     "foo.c", line 180: 'client_socket' undefined
  383. ;;     "foo.c", line 198: warning: statement not reached
  384. ;;   HP-UX s800 7.x & 8.x C:
  385. ;;     cc: "xengine.c", line 70: error 1000: Unexpected symbol: "main".
  386. ;;     cc: error 2017: Cannot recover from earlier errors, terminating.
  387. ;;     *** Error code 1
  388. ;;     For some reason, the 800 seems to be sending the same error message
  389. ;;     to both stdout and stderr so I'm getting duplicates.
  390. ;;   Apollo 10.3 C:
  391. ;;     ******** Line 52 of "foo_bar.c": [Error #116]  Improper expression;
  392. ;;     ******** Line 109 of "buffer.c": [Error #060]  Improper use of "Buffer"
  393. ;;     buffer.c: 69: warning- extra characters on #endif.
  394. ;;   mc2
  395. ;;     compile.mut 381 Error: hoho is not a var.
  396.  
  397. ;; Problem lines:
  398. ;;   *"foo.c", line 208: syntax error:
  399. ;;    case 2: hoho(); break;        <<<<<< trys to parse this line
  400. ;;   *
  401.  
  402.  
  403. ;(defvar compilation-error-regexp
  404. ;  "Regular expression for filename/linenumber in error in compilation log.")
  405. ;  '\([^ \n]+\(: *\|, line \|(\)[0-9]+\)\|\([0-9]+.*of *[^ \n]+\)'
  406.  
  407. ;  \([^ \n]+\(: *        \|
  408. ;  , line             \|
  409. ;  (\)[0-9]+\)            \|
  410. ;  \([0-9]+.*of *[^ \n]+\)'
  411.  
  412. ;; Format of error messages:
  413. ;;   <file name>, line<white space><digits>
  414. ;;   <file name>:<maybe white space><digits>
  415. ;;   <file name><white space><digits><stuff>    ;; Mutt compiler
  416. ;;   <digits><stuff>of<white space><file name>
  417.  
  418.     ;; Check to see if the dot is on a line with a error message
  419.     ;; Input:
  420.     ;;   dot : at start of a line
  421.     ;; Returns:
  422.     ;;   TRUE if this is a error line
  423. (defun booboo-line HIDDEN
  424. {
  425.   (or
  426.     (looking-at '.+, line\ +[0-9]+')    ;; foo.c, line 123
  427.     (looking-at '.+: *[0-9]+.+')    ;; foo.c : 123 or foo: 123
  428.     (looking-at '[^ ]+\ +[0-9]+.+')    ;; foo.c 123
  429.     (looking-at '.* [0-9]+ +of ')    ;; 123 of foo.c
  430.   )
  431. })
  432.  
  433.     ;; Dig file name and line number out of error message
  434.     ;; Input:
  435.     ;;   Dot at start of error line.
  436.     ;; Output:
  437.     ;;   bb-fname: Name of file with error
  438.     ;;   bb-line:  Line number of error
  439.     ;; Returns: zip
  440. (defun
  441.   snarf-error-info    HIDDEN
  442.   {
  443.     (string text)
  444.  
  445.     (looking-at '.+')  
  446.     (text (get-matched "&"))
  447.  
  448.     (bb-line  (snarf-line-number text))
  449.     (bb-fname (snarf-file-name   text))
  450.   }
  451.   snarf-line-number (string error-msg) HIDDEN
  452.   {
  453.     (if
  454.       (or
  455.     (re-string '.*:\([0-9]+\):' error-msg)  ;; <stuff>:<digits>: - Grep
  456.         ;; <stuff> line <digits>:
  457.     (re-string '.* line \([0-9]+\):' error-msg)
  458.         ;; <stuff> line <digits> of
  459.     (re-string '.* line \([0-9]+\) of ' error-msg)
  460.     (re-string '.* +\([0-9]+\)' error-msg)  ;; <stuff><space><digits>
  461.     )
  462.       (convert-to NUMBER (get-matched '\1'))
  463.       { (msg "Can't find a line number in:  " error-msg) (halt) })
  464.   }
  465.   snarf-file-name (string error-msg) HIDDEN
  466.   {
  467.     (if (or
  468.         ;; <stuff>"file name", line   or (file name)
  469.       (re-string '.*["(]\([a-zA-Z0-9./_]+\)[")], line ' error-msg)
  470.         ;; "file name" or (file name)
  471.       (re-string '["(]\([a-zA-Z0-9./_]+\)[")]' error-msg)
  472.         ;; <file name><: or <space>><digits>
  473.       (re-string '\([a-zA-Z0-9./_]+\)[: ]+[0-9]' error-msg)
  474.         ;; <stuff><space><digits> of "file name" or (file name)
  475.       (re-string '.* [0-9]+ of ["(]\([a-zA-Z0-9./_]+\)[")]' error-msg)
  476.     )
  477.       (get-matched '\1')
  478.       { (msg "Can't find a file name in:  " error-msg) (halt) })
  479.   }
  480. )
  481.