home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
me34src.zip
/
me3
/
mutt
/
package
/
compile.mut
< prev
next >
Wrap
Text File
|
1995-01-14
|
13KB
|
481 lines
;; compile.mut
;;
;; Remote, multi-process compiles or greps.
;; Modeled after compile and grep in GNU Emacs.
;; See documentation in package.doc
;; Functions:
;; compile
;; grep
;; compile-next-error C-x`
;; To do:
;; Error parsing needs work.
;; Add a buffer local compile string. This way, when working on serveral
;; programs at once, can M-x compile them with out having to lookup the
;; proper compile string.
;; C Durland 10/91, 1/92 Public Domain
(include me.mh)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;; Run the Compile Process ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(const
COMPILE-BUFFER-NAME "*Compile*"
)
(int compilation-buffer compile-process-id)
(bool compile-in-progress scroll-compile)
(string last-compile-command)
(defun
MAIN
{
(register-hook PROCESS-HOOK "process-compile-hook")
(last-compile-command "make")
}
compile
{
(string command)
(do-the-compile-thing
(if (== ""
(command (ask "Compile command [" last-compile-command "]: ")))
last-compile-command
(last-compile-command command))
"No more errors")
}
stop-compile
{
(if (not compile-in-progress) { (msg "No compile to stop!") (done) })
(msg "Sorry, haven't got that implemented yet.")
}
grep
{
(string command)
(command (ask "Run grep (with args): "))
(do-the-compile-thing (concat "grep -n " command " /dev/null")
"No more grep matches")
}
)
(string compile-done-message) ;; used by the error parser
(defun
do-the-compile-thing (string compile-command done-message) HIDDEN
{
(int wid)
(if compile-in-progress
{
(ask-user) ;; !!!??? hmmmm
(if (yesno "Got a compilation process going! Stop it")
{
(msg "Sorry, haven't got that implemented yet.")
(done)
}
(done))
})
; (compile-process-id (create-process compile-command))
(compile-process-id
(create-process (concat "/bin/sh -c <*> exec " compile-command)))
(if (== -1 compile-process-id) (done)) ;; some kind of error
(if (== -2 (compilation-buffer (attached-buffer COMPILE-BUFFER-NAME)))
(compilation-buffer
(create-buffer COMPILE-BUFFER-NAME (bit-or BFFoo BFHidden2))))
;!!!??? why not use popup-buffer?
; (if (!= compilation-buffer (current-buffer))
(if (!= -2 (wid (buffer-displayed compilation-buffer)))
{
(current-window wid)
(if (< (window-height -1) 5) (window-height -1 8))
}
{
(delete-other-windows)(split-window)
(current-window 0) ;; move to top window
(window-height -1 8)
})
(current-buffer compilation-buffer TRUE) (clear-buffer)
(insert-text "Directory: " (current-directory) "^J")
(insert-text "Now computing: " '"' compile-command '"' "^J")
(set-mark THE-MARK) ;; used by (compile-next-error)
(compile-in-progress TRUE)(scroll-compile TRUE)
(major-mode "Running")
(next-window) ;; leave cursor in original buffer
(compile-done-message done-message)
(init-error-parser)
}
process-compile-hook (int pid event-type)(message)
{
(int wid1 wid2)
(if (== PERROR event-type)
{
(if compile-in-progress
{ (current-buffer compilation-buffer) (major-mode "Error") (update) })
(compile-in-progress FALSE)
(done)
})
(if (not compile-in-progress) (done))
(if (!= compile-process-id pid) (done))
(current-buffer compilation-buffer)(end-of-buffer)
(previous-character) ;; ???something fishy about this
(switch event-type
PROCESS-DONE
{
(compile-in-progress FALSE)
(newline)
(insert-text "Process done. Exit status: " message)
(major-mode (concat "Done: " message))
}
OUTPUT-STDOUT { (insert-text message)(beginning-of-line) }
OUTPUT-STDERR { (insert-text message)(beginning-of-line) }
)
;; if displayed, update
(if (and scroll-compile
(!= -2 (wid2 (buffer-displayed compilation-buffer))))
{
(wid1 (current-window))
(current-window wid2)
(end-of-buffer)
(update FALSE) ;; sync buffer and window dots
(arg-prefix -1)(reposition-window)
(current-window wid1)
(update) ;; get it onto the screen
})
}
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;; Process the Compile Errors ;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Error list: the stuff needed to find/mark errors in a file that has
;; been compiled and has errors/warnings. These are:
;; Name of the file with errors
;; ?buffer id of the buffer holding the file
;; List of tuples that mark each error. These tuples are: mark-id of
;; the mark pointing to the error line, line number in the error list,
;; number of lines of error message.
(list error-list)
(defun compile-next-error ; display the next error or warning
{
(int error-line-mark-id len-of-error-msg error-msg-line wid)
(string file-name)
; (if (arg-flag)
; (init-error-parser) set-mark to top of compile buffer
(if (== 0 (length-of error-list))
(switch (parse-errors)
1
{
(if (!= -2 (wid (buffer-displayed compilation-buffer)))
(free-window wid))
(msg compile-done-message)
(done)
}
2
{
(msg "Wait a sec while the process churns out some stuff.")
(scroll-compile TRUE)
(done)
}
))
;; get info out of error-list
(file-name (extract-element error-list 0))
(error-line-mark-id (extract-element error-list 1))
(len-of-error-msg (extract-element error-list 2))
(error-msg-line (extract-element error-list 3))
(remove-elements error-list 0 4) ;; remove that tuple from the list
;(msg "ack: >" file-name "< " error-line-mark-id " " len-of-error-msg " " error-msg-line)(get-key)
;; get the file and put the dot at the error line
(visit-file file-name) ;; visit file with the error
(msg "")
(goto-mark error-line-mark-id) ;; put dot at error
(update FALSE)
(free-mark error-line-mark-id) ;; do some cleanup
(scroll-compile FALSE)
;; make a window to show error messages in
(delete-other-windows)(split-window)
(current-window 0) ;; move to top window
(if (> len-of-error-msg 10)
{
(len-of-error-msg 10)
(msg "This line generated lots of errors!")
})
;(if (< len-of-error-msg 3) (len-of-error-msg 3))
(window-height -1 len-of-error-msg)
;; display error message(s)
(current-buffer compilation-buffer TRUE)
(current-line error-msg-line)(reposition-window)
(update FALSE)
(current-window 1)
})
(int bb-line)
(string bb-fname)
(defun
init-error-parser HIDDEN MAIN ;; main so I can debug
{
(bind-to-key "compile-next-error" "C-x`")
(bb-fname "")
(if (!= 0 (length-of error-list)) (msg "Got garbage to clean up"))
(remove-elements error-list 0 100000)
;;!!!??? free marks in error-list?
}
)
;; Parse the compilation buffer
;; Output:
;; Stuff added to error-list
;; Returns:
;; 0 : parsed some errors or error in error-list
;; 1 : no errors left to parse and compile is done
;; 2 : no errors left to parse but compile not done
(defun parse-errors HIDDEN
{
(int buffer-size dot lines buffer-row wasted char-at-dot) ;; BufferInfo
(int error-line len-of-error-msg mark-id n)
(string current-file-name file-name)
(current-file-name bb-fname) ;; init file change checker
;; make sure compile buffer didn't get deleted
(if (== -2 (n (attached-buffer COMPILE-BUFFER-NAME)))
{ (msg "Somebody deleted the " COMPILE-BUFFER-NAME " buffer!") (halt) })
(current-buffer n)
(compilation-buffer n)
(goto-mark THE-MARK) ;; pick up where we last left off
;(int foo)
(msg "parse-errors: " (buffer-name -1))
(while TRUE ;; parse lots of errors
{
(msg "Parsing error messages ...")
(while (and ;; skip over garbage
(not (booboo-line))
(forward-line 1))
())
(if (EoB) ;; nothing left to parse
{
(previous-character) ;; ???something fishy about this
(set-mark THE-MARK)
(if (!= 0 (length-of error-list)) { 0 (done) })
(if compile-in-progress { 2 (done) })
1 (done)
})
;; dot at the start of an error line
(snarf-error-info)
(error-line bb-line)
(file-name bb-fname)
;(msg "hoho1 >" bb-fname "< " bb-line " (" current-file-name ")")(get-key)
;; check for change of file
(if (!= current-file-name file-name)
(if (!= 0 (length-of error-list)) ;; already got some errors parsed
{ 0 (done) }
{
(current-file-name file-name)
;(msg "new file: " file-name )(get-key)
}))
;; figure out where in the error buffer this message is
(buffer-stats -1 (loc buffer-size))
(len-of-error-msg 1)
(while TRUE ;; see if this is a long message
{
(if (not (forward-line 1)) (break)) ;; EoF
(if (booboo-line)
{
(snarf-error-info)
(if (or (!= current-file-name bb-fname)
(!= error-line bb-line))
(break))
}
(if (not (looking-at '\ +.')) (break)))
(+= len-of-error-msg 1)
})
;;;!!!??? limit the number of errors per line
(set-mark THE-MARK) ;; start of next error message
;(msg "hoho3 >" current-file-name "< >" file-name "< " bb-fname)(get-key)
(visit-file file-name) ;; visit file with the error
(mark-id (create-mark TRUE))
(current-line error-line)(set-mark mark-id)
(current-buffer compilation-buffer)
;(msg "parsed: >"file-name "< " mark-id " " len-of-error-msg " " buffer-row " " error-line)(get-key)
(insert-object error-list 10000
file-name mark-id len-of-error-msg buffer-row)
;; if more than x errors ((length-of error-list) > x),
;; skip over the rest of the error for this file
;; (while (or (and (booboo-line) { (snarf) file != current file })) (forward-line)
}) ;; end while
;; never gets here
})
;; Real life examples:
;; HP-UX s300 8.x C:
;; "foo.c", line 29: syntax error:
;; static int client_socket = -1;
;; ^
;; "foo.c", line 180: 'client_socket' undefined
;; "foo.c", line 198: warning: statement not reached
;; HP-UX s800 7.x & 8.x C:
;; cc: "xengine.c", line 70: error 1000: Unexpected symbol: "main".
;; cc: error 2017: Cannot recover from earlier errors, terminating.
;; *** Error code 1
;; For some reason, the 800 seems to be sending the same error message
;; to both stdout and stderr so I'm getting duplicates.
;; Apollo 10.3 C:
;; ******** Line 52 of "foo_bar.c": [Error #116] Improper expression;
;; ******** Line 109 of "buffer.c": [Error #060] Improper use of "Buffer"
;; buffer.c: 69: warning- extra characters on #endif.
;; mc2
;; compile.mut 381 Error: hoho is not a var.
;; Problem lines:
;; *"foo.c", line 208: syntax error:
;; case 2: hoho(); break; <<<<<< trys to parse this line
;; *
;(defvar compilation-error-regexp
; "Regular expression for filename/linenumber in error in compilation log.")
; '\([^ \n]+\(: *\|, line \|(\)[0-9]+\)\|\([0-9]+.*of *[^ \n]+\)'
; \([^ \n]+\(: * \|
; , line \|
; (\)[0-9]+\) \|
; \([0-9]+.*of *[^ \n]+\)'
;; Format of error messages:
;; <file name>, line<white space><digits>
;; <file name>:<maybe white space><digits>
;; <file name><white space><digits><stuff> ;; Mutt compiler
;; <digits><stuff>of<white space><file name>
;; Check to see if the dot is on a line with a error message
;; Input:
;; dot : at start of a line
;; Returns:
;; TRUE if this is a error line
(defun booboo-line HIDDEN
{
(or
(looking-at '.+, line\ +[0-9]+') ;; foo.c, line 123
(looking-at '.+: *[0-9]+.+') ;; foo.c : 123 or foo: 123
(looking-at '[^ ]+\ +[0-9]+.+') ;; foo.c 123
(looking-at '.* [0-9]+ +of ') ;; 123 of foo.c
)
})
;; Dig file name and line number out of error message
;; Input:
;; Dot at start of error line.
;; Output:
;; bb-fname: Name of file with error
;; bb-line: Line number of error
;; Returns: zip
(defun
snarf-error-info HIDDEN
{
(string text)
(looking-at '.+')
(text (get-matched "&"))
(bb-line (snarf-line-number text))
(bb-fname (snarf-file-name text))
}
snarf-line-number (string error-msg) HIDDEN
{
(if
(or
(re-string '.*:\([0-9]+\):' error-msg) ;; <stuff>:<digits>: - Grep
;; <stuff> line <digits>:
(re-string '.* line \([0-9]+\):' error-msg)
;; <stuff> line <digits> of
(re-string '.* line \([0-9]+\) of ' error-msg)
(re-string '.* +\([0-9]+\)' error-msg) ;; <stuff><space><digits>
)
(convert-to NUMBER (get-matched '\1'))
{ (msg "Can't find a line number in: " error-msg) (halt) })
}
snarf-file-name (string error-msg) HIDDEN
{
(if (or
;; <stuff>"file name", line or (file name)
(re-string '.*["(]\([a-zA-Z0-9./_]+\)[")], line ' error-msg)
;; "file name" or (file name)
(re-string '["(]\([a-zA-Z0-9./_]+\)[")]' error-msg)
;; <file name><: or <space>><digits>
(re-string '\([a-zA-Z0-9./_]+\)[: ]+[0-9]' error-msg)
;; <stuff><space><digits> of "file name" or (file name)
(re-string '.* [0-9]+ of ["(]\([a-zA-Z0-9./_]+\)[")]' error-msg)
)
(get-matched '\1')
{ (msg "Can't find a file name in: " error-msg) (halt) })
}
)