home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / mult-compile.el < prev    next >
Encoding:
Text File  |  1991-06-14  |  31.5 KB  |  724 lines
  1. ; Path: dg-rtp!rock.concert.net!mcnc!stanford.edu!bu.edu!dimacs.rutgers.edu!mips!zaphod.mps.ohio-state.edu!wuarchive!uunet!wsrcc.com!wolfgang
  2. ; From: wolfgang@wsrcc.com (Wolfgang S. Rupprecht)
  3. ; Newsgroups: comp.emacs,comp.unix.aix,gnu.emacs.sources
  4. ; Subject: Re: GNU Emacs with xlc on AIX3.1 Was: Shutdown: EMACS vs. vi
  5. ; Date: 6 Jun 91 15:39:08 GMT
  6. ; References: <2995.9106031725@seq.hull.ac.uk> <1991Jun04.063328.21379@lynx.CS.ORST.EDU> <Q=4_#5@uzi-9mm.fulcrum.bt.co.uk>
  7. ; Organization: Wolfgang S Rupprecht Computer Consulting, Washington DC.
  8. ; 
  9. ; igb@fulcrum.bt.co.uk (Ian G Batten) writes:
  10. ; >> Speaking of line number and related stuff, is there a way to let the GNU
  11. ; >> Emacs 18.57 to understand the error messages from cc on AIX 3.1? 
  12. ; 
  13. ; >I'm on the point of writing the code to do this.  Has anyone else
  14. ; >started?
  15. ; 
  16. ; Ok, I'll bite.  
  17. ; 
  18. ; Here is a general error message parser that I have been using in
  19. ; various forms since 1987.  It is all table driven and adding another
  20. ; parser template is as trivial as adding one regexp to describe the
  21. ; error output.
  22. ; 
  23. ; It already knows about most errors that I have needed to parse.  In
  24. ; addition it does 3-window hacks for lint's inconsistent usage
  25. ; messages.  It can also hunt for files (as in make's "Make: error on
  26. ; line 31" type errors, or the brain damaged multi-line System V lint
  27. ; output.)
  28. ; 
  29. ; Unlike the normal emacs function, this next error is cursor-driven,
  30. ; and doesn't pre-parse any errors.  One can select an error message by
  31. ; moving the cursor to the line *above* the desired message and invoking
  32. ; next-error.
  33. ; 
  34. ; This file also contains a multiple *compilation* buffer hack.  This
  35. ; allows one to compile in one buffer, grep in another, and watch
  36. ; something else in a third.  One selects the current compilation buffer
  37. ; (for next-error use) by typing "C-u C-x `" from inside the buffer one
  38. ; wants to select.  (Anyone have any good ideas on how to input &optional
  39. ; args from (interactive)?  Perhaps a "M-x command<space>option" syntax?)
  40. ; 
  41. ; I normally start off a compilation and then rename the *compilation*
  42. ; buffer to be something more descriptive (eg. *make-dirname* ,
  43. ; *grep-dirname*, *lint-dirname*, etc.).  This is just the thing when
  44. ; one has greps of several source trees, and a few compiles active and
  45. ; needs to switch between them.
  46. ; 
  47. ; One can also have wrappers to start up compilations in different
  48. ; buffers as in:
  49. ; 
  50. ;     (defun gidbuild (command)
  51. ;       (interactive (list (read-input "Run gid (with args): "
  52. ;                      (symbol-around-point))))
  53. ;       (let ((default-directory (substitute-in-file-name "$BUILD")))
  54. ;       (compile1 (concat "gid " command)
  55. ;         "No more gidbuild hits" "gidbuild" "*gidbuild*")))
  56. ; 
  57. ; To install it just put the the rest of the message into a single file
  58. ; called 'compile.el' somewhere in your emacs load-path.
  59. ; 
  60. ; -wolfgang
  61. ; ---
  62. ; Wolfgang Rupprecht    wolfgang@wsrcc.com (or) uunet!wsrcc!wolfgang
  63. ; Snail Mail Address:   Box 6524, Alexandria, VA 22306-0524
  64. ; 
  65.  
  66. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  67. ;;                                                                           ;;
  68. ;;      File:     mult-compile.el                                            ;;
  69. ;;      Author:   Wolfgang S Rupprecht <wolfgang@wsrcc.com>                  ;;
  70. ;;      Created:  Wed Jan 30 15:51:48 EST 1991                               ;;
  71. ;;      Contents: Gnu compile.el with multiple process interface             ;;
  72. ;;                                                                           ;;
  73. ;;      Copyright (c) 1991 Wolfgang S Rupprecht.                             ;;
  74. ;;                                                                           ;;
  75. ;;      $Header$                                                             ;;
  76. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  77. ;; Run compiler as inferior of Emacs, and parse its error messages.
  78. ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
  79.  
  80. ;; This file is part of GNU Emacs.
  81.  
  82. ;; GNU Emacs is distributed in the hope that it will be useful,
  83. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  84. ;; accepts responsibility to anyone for the consequences of using it
  85. ;; or for whether it serves any particular purpose or works at all,
  86. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  87. ;; License for full details.
  88.  
  89. ;; Everyone is granted permission to copy, modify and redistribute
  90. ;; GNU Emacs, but only under the conditions described in the
  91. ;; GNU Emacs General Public License.   A copy of this license is
  92. ;; supposed to have been given to you along with GNU Emacs so you
  93. ;; can know your rights and responsibilities.  It should be in a
  94. ;; file named COPYING.  Among other things, the copyright notice
  95. ;; and this notice must be preserved on all copies.
  96.  
  97. (provide 'compile)
  98.  
  99. ;; make a more general purpose compilation interface.
  100. ;; 1. make compilation-process be buffer-local. (for buffer->process mapping)
  101. ;; 2. use the (process-buffer) for process->buffer mapping.
  102. ;; 3. make compilation-error-message be a buffer local variable.
  103.  
  104. ;; user preference configurations
  105.  
  106. (defvar compile-sets-error-buf t
  107.   "*A compile command will set the error buf.")
  108.  
  109. ;; end user configurations
  110.  
  111. (defvar compilation-process nil
  112.   "Process created by compile command, or nil if none exists now.
  113. Note that the process may have been \"deleted\" and still
  114. be the value of this variable.")
  115.  
  116. ;; this isn't used in any meaningful way - kept here for
  117. ;; reasons of minimum change.
  118.  
  119. (defvar compilation-error-list nil
  120.   "List of error message descriptors for visiting erring functions.
  121. Each error descriptor is a list of length two.
  122. Its car is a marker pointing to an error message.
  123. Its cadr is a marker pointing to the text of the line the message is about,
  124.   or nil if that is not interesting.
  125. The value may be t instead of a list;
  126. this means that the buffer of error messages should be reparsed
  127. the next time the list of errors is wanted.")
  128.  
  129. ;; not really used.
  130. (defvar compilation-parsing-end nil
  131.   "Position of end of buffer when last error messages parsed.")
  132.  
  133. ;; make this buffer local
  134. (defvar compilation-error-message nil
  135.   "Message to print when no more matches for compilation-error-regexp are found")
  136.  
  137. ;; The filename excludes colons to avoid confusion when error message
  138. ;; starts with digits.
  139. (defvar compilation-error-regexp
  140.   "\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\)"
  141.   "Regular expression for filename/linenumber in error in compilation log.")
  142.  
  143. (defvar last-compilation-buffer "*compilation*")
  144.  
  145. (defun compile (command &optional buf)
  146.  
  147.   "NEW COMPILE:Compile the program including the current buffer.
  148. Default: run `make'.  Runs COMMAND, a shell command, in a separate
  149. process asynchronously with output going a buffer (*compilation* by
  150. default).  You can then use the command \\[next-error] to find the
  151. next error message and move to the source code that caused it.
  152.  
  153. Optional ARG is the buffer or name of the buffer to use for output. If
  154. interactive, C-u will cause command to prompt for filename.  Default
  155. is the last compilation buffer's name."
  156.  
  157.   (interactive (list (read-string "Compile command: " compile-command)
  158.                      (if current-prefix-arg
  159.                          (read-string "Compilation buffer: "
  160.                                       last-compilation-buffer))))
  161.   (setq compile-command command)
  162.   (if buf
  163.       (setq last-compilation-buffer buf)
  164.     (setq buf last-compilation-buffer))
  165.    (compile1 compile-command "No more errors" nil buf))
  166.  
  167. ; (defun grep (command)
  168. ;   "Run grep, with user-specified args, and collect output in a buffer.
  169. ; While grep runs asynchronously, you can use the \\[next-error] command
  170. ; to find the text that grep hits refer to."
  171. ;   (interactive "sRun grep (with args): ")
  172. ;   (compile1 (concat "grep -n " command " /dev/null")
  173. ;           "No more grep hits" "grep")))
  174.  
  175. (defun compile1 (command error-message &optional name-of-mode comp-buf)
  176.   "Multi-Buffer version of compile1"
  177.   (save-some-buffers)
  178.   (setq comp-buf (get-buffer-create (or comp-buf "*compilation*")))
  179.   (let ((cwd default-directory)         ; catch that slipery animal
  180.         (regexp compilation-error-regexp)
  181.         (comp-buf-name (buffer-name comp-buf))
  182.     (watch-flag (eq comp-buf (current-buffer))))
  183.     (save-excursion
  184.       (set-buffer comp-buf)
  185.       (setq default-directory cwd)      ; and restore...
  186.       (if compilation-process
  187.           (if (or (not (eq (process-status compilation-process) 'run))
  188.                   (yes-or-no-p
  189.                    "A compilation process is running in this buffer; kill it? "
  190.                    ))
  191.               (condition-case ()
  192.                   (let ((comp-proc compilation-process))
  193.                     (interrupt-process comp-proc)
  194.                     (sit-for 1)
  195.                     (delete-process comp-proc))
  196.                 (error nil))
  197.             (error "Cannot have two processes in one buffer!")))
  198.  
  199.       (if compile-sets-error-buf
  200.       (setq last-error-buf comp-buf-name))
  201.  
  202.       (fundamental-mode)
  203.       (buffer-flush-undo comp-buf)
  204.  
  205.       (setq mode-name (or name-of-mode "Compilation"))
  206.       ;; Make log buffer's mode line show process state
  207.       (setq mode-line-process '(": %s"))
  208.  
  209.       (make-local-variable 'compilation-process)
  210.       (setq compilation-process nil)
  211.  
  212.       (make-local-variable 'compilation-error-message)
  213.       (setq compilation-error-message error-message)
  214.  
  215.       (make-local-variable 'compilation-error-regexp)
  216.       (setq compilation-error-regexp regexp)
  217.  
  218.       (compilation-forget-errors)
  219.       (setq compilation-error-list t)
  220.  
  221.       (setq compilation-process
  222.             (start-process "compilation" comp-buf
  223.                            shell-file-name
  224.                            "-c" (concat "exec " command)))
  225.       ;; side effects: erase buffer, pop up buffer in other window 
  226.       (with-output-to-temp-buffer comp-buf-name
  227.         (princ mode-name)
  228.         (princ " started at ")
  229.         (princ (substring (current-time-string) 0 -5))
  230.         (terpri)
  231.         (princ "cd ")
  232.         (princ default-directory)
  233.         (terpri)
  234.         (princ command)
  235.         (terpri))
  236.       (set-process-sentinel compilation-process 'compilation-sentinel))
  237.     (if watch-flag (goto-char (point-max)))))
  238.  
  239. ;; Called when compilation process changes state.
  240.  
  241. (defun compilation-sentinel (proc msg)
  242.   (cond ((null (buffer-name (process-buffer proc)))
  243.          ;; buffer killed
  244.          (set-process-buffer proc nil))
  245.         ((memq (process-status proc) '(signal exit))
  246.          (let* ((obuf (current-buffer))
  247.                 omax opoint)
  248.            ;; save-excursion isn't the right thing if
  249.            ;;  process-buffer is current-buffer
  250.            (unwind-protect
  251.                (progn
  252.                  ;; Write something in *compilation* and hack its mode line,
  253.                  (set-buffer (process-buffer proc))
  254.                  (setq omax (point-max) opoint (point))
  255.                  (goto-char (point-max))
  256.                  (insert ?\n mode-name " " msg)
  257.                  (forward-char -1)
  258.                  (insert " at "
  259.                          (substring (current-time-string) 0 -5))
  260.                  (forward-char 1)
  261.                  (setq mode-line-process
  262.                        (concat ": "
  263.                                (symbol-name (process-status proc))))
  264.                  ;; If buffer and mode line will show that the process
  265.                  ;; is dead, we can delete it now.  Otherwise it
  266.                  ;; will stay around until M-x list-processes.
  267.                  (delete-process proc))
  268.              (setq compilation-process nil)
  269.              ;; Force mode line redisplay soon
  270.              (set-buffer-modified-p (buffer-modified-p)))
  271.            (if (and opoint (< opoint omax))
  272.                (goto-char opoint))
  273.            (set-buffer obuf)))))
  274.  
  275. (defun kill-compilation ()
  276.   "Kill the process made by the \\[compile] command."
  277.   (interactive)
  278.   (if compilation-process
  279.       (interrupt-process compilation-process)
  280.     (error "This buffer doesn't have a compilation process!")))
  281.  
  282. (defun kill-grep ()
  283.   "Kill the process made by the \\[grep] command."
  284.   (interactive)
  285.   (if compilation-process
  286.       (interrupt-process compilation-process)
  287.     (error "This buffer doesn't have a compilation process!")))
  288.  
  289. (defun next-error (&optional argp)
  290.   "Visit next compilation error message and corresponding source code.
  291. This operates on the output from the \\[compile] command.
  292. If all preparsed error messages have been processed,
  293. the error message buffer is checked for new ones.
  294. A non-nil argument (prefix arg, if interactive)
  295. means reparse the error message buffer and start at the first error."
  296.   (interactive "P")
  297.   (if (or (eq compilation-error-list t)
  298.           argp)
  299.       (progn (compilation-forget-errors)
  300.              (setq compilation-parsing-end 1)))
  301.   (if compilation-error-list
  302.       nil
  303.     (save-excursion
  304.       (switch-to-buffer "*compilation*")
  305.       (set-buffer-modified-p nil)
  306.       (compilation-parse-errors)))
  307.   (let ((next-error (car compilation-error-list)))
  308.     (if (null next-error)
  309.         (error (concat compilation-error-message
  310.                        (if (and compilation-process
  311.                                 (eq (process-status compilation-process)
  312.                                     'run))
  313.                            " yet" ""))))
  314.     (setq compilation-error-list (cdr compilation-error-list))
  315.     (if (null (car (cdr next-error)))
  316.         nil
  317.       (switch-to-buffer (marker-buffer (car (cdr next-error))))
  318.       (goto-char (car (cdr next-error)))
  319.       (set-marker (car (cdr next-error)) nil))
  320.     (let* ((pop-up-windows t)
  321.            (w (display-buffer (marker-buffer (car next-error)))))
  322.       (set-window-point w (car next-error))
  323.       (set-window-start w (car next-error)))
  324.     (set-marker (car next-error) nil)))
  325.  
  326. ;; Set compilation-error-list to nil, and
  327. ;; unchain the markers that point to the error messages and their text,
  328. ;; so that they no longer slow down gap motion.
  329. ;; This would happen anyway at the next garbage collection,
  330. ;; but it is better to do it right away.
  331. (defun compilation-forget-errors ()
  332.   (if (eq compilation-error-list t)
  333.       (setq compilation-error-list nil))
  334.   (while compilation-error-list
  335.     (let ((next-error (car compilation-error-list)))
  336.       (set-marker (car next-error) nil)
  337.       (if (car (cdr next-error))
  338.           (set-marker (car (cdr next-error)) nil)))
  339.     (setq compilation-error-list (cdr compilation-error-list))))
  340.  
  341. (defun compilation-parse-errors ()
  342.   "Parse the current buffer as error messages.
  343. This makes a list of error descriptors, compilation-error-list.
  344. For each source-file, line-number pair in the buffer,
  345. the source file is read in, and the text location is saved in compilation-error-list.
  346. The function next-error, assigned to \\[next-error], takes the next error off the list
  347. and visits its location."
  348.   (setq compilation-error-list nil)
  349.   (message "Parsing error messages...")
  350.   (let (text-buffer
  351.         last-filename last-linenum)
  352.     ;; Don't reparse messages already seen at last parse.
  353.     (goto-char compilation-parsing-end)
  354.     ;; Don't parse the first two lines as error messages.
  355.     ;; This matters for grep.
  356.     (if (bobp)
  357.         (forward-line 2))
  358.     (while (re-search-forward compilation-error-regexp nil t)
  359.       (let (linenum filename
  360.             error-marker text-marker)
  361.         ;; Extract file name and line number from error message.
  362.         (save-restriction
  363.           (narrow-to-region (match-beginning 0) (match-end 0))
  364.           (goto-char (point-max))
  365.           (skip-chars-backward "[0-9]")
  366.           ;; If it's a lint message, use the last file(linenum) on the line.
  367.           ;; Normally we use the first on the line.
  368.           (if (= (preceding-char) ?\()
  369.               (progn
  370.                 (narrow-to-region (point-min) (1+ (buffer-size)))
  371.                 (end-of-line)
  372.                 (re-search-backward compilation-error-regexp)
  373.                 (skip-chars-backward "^ \t\n")
  374.                 (narrow-to-region (point) (match-end 0))
  375.                 (goto-char (point-max))
  376.                 (skip-chars-backward "[0-9]")))
  377.           ;; Are we looking at a "filename-first" or "line-number-first" form?
  378.           (if (looking-at "[0-9]")
  379.               (progn
  380.                 (setq linenum (read (current-buffer)))
  381.                 (goto-char (point-min)))
  382.             ;; Line number at start, file name at end.
  383.             (progn
  384.               (goto-char (point-min))
  385.               (setq linenum (read (current-buffer)))
  386.               (goto-char (point-max))
  387.               (skip-chars-backward "^ \t\n")))
  388.           (setq filename (compilation-grab-filename)))
  389.         ;; Locate the erring file and line.
  390.         (if (and (equal filename last-filename)
  391.                  (= linenum last-linenum))
  392.             nil
  393.           (beginning-of-line 1)
  394.           (setq error-marker (point-marker))
  395.           ;; text-buffer gets the buffer containing this error's file.
  396.           (if (not (equal filename last-filename))
  397.               (setq text-buffer
  398.                     (and (file-exists-p (setq last-filename filename))
  399.                          (find-file-noselect filename))
  400.                     last-linenum 0))
  401.           (if text-buffer
  402.               ;; Go to that buffer and find the erring line.
  403.               (save-excursion
  404.                 (set-buffer text-buffer)
  405.                 (if (zerop last-linenum)
  406.                     (progn
  407.                       (goto-char 1)
  408.                       (setq last-linenum 1)))
  409.                 (forward-line (- linenum last-linenum))
  410.                 (setq last-linenum linenum)
  411.                 (setq text-marker (point-marker))
  412.                 (setq compilation-error-list
  413.                       (cons (list error-marker text-marker)
  414.                             compilation-error-list)))))
  415.         (forward-line 1)))
  416.     (setq compilation-parsing-end (point-max)))
  417.   (message "Parsing error messages...done")
  418.   (setq compilation-error-list (nreverse compilation-error-list)))
  419.  
  420. (defun compilation-grab-filename ()
  421.   "Return a string which is a filename, starting at point.
  422. Ignore quotes and parentheses around it, as well as trailing colons."
  423.   (if (eq (following-char) ?\")
  424.       (save-restriction
  425.         (narrow-to-region (point)
  426.                           (progn (forward-sexp 1) (point)))
  427.         (goto-char (point-min))
  428.         (read (current-buffer)))
  429.     (buffer-substring (point)
  430.                       (progn
  431.                         (skip-chars-forward "^ :,\n\t(")
  432.                         (point)))))
  433.  
  434. ;; (define-key ctl-x-map "`" 'next-error)
  435. (define-key ctl-x-map "`" 'wsr:next-error)
  436. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  437. ;;                                                                           ;;
  438. ;;      File:     compile.el                                                 ;;
  439. ;;      Author:   Wolfgang S. Rupprecht <wolfgang@wsrcc.com>                 ;;
  440. ;;      Created:  March 1987                                                 ;;
  441. ;;      Contents: I did significant hacking to the error parser              ;;
  442. ;;              for next-error.  The parser now has a table that             ;;
  443. ;;              it scans for applicable rexexp templates.  If                ;;
  444. ;;              one of them fits, it uses that one to parse the              ;;
  445. ;;              line. If it doesn't fit, the scanner tries the               ;;
  446. ;;              next template. If all templates fail, the line               ;;
  447. ;;              is deemed a useless line and discarded.                      ;;
  448. ;;                                                                           ;;
  449. ;;      Copyright (c) 1989, 1987 Wolfgang Rupprecht.                         ;;
  450. ;;                                                                           ;;
  451. ;;      $Header$                                                             ;;
  452. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  453.  
  454. ;; This file is not really part of GNU Emacs, but is (hopefully)
  455. ;; useful in conjunction with it.  It is meant as a patch to the
  456. ;; distributed GnuEmacs lisp file by the same name.
  457.  
  458. ;; GNU Emacs and this compile.el is distributed in the hope that it
  459. ;; will be useful, but WITHOUT ANY WARRANTY.  No author or distributor
  460. ;; accepts responsibility to anyone for the consequences of using it
  461. ;; or for whether it serves any particular purpose or works at all,
  462. ;; unless he says so in writing.  Refer to the GNU Emacs General
  463. ;; Public License for full details.
  464.  
  465. ;; Everyone is granted permission to copy, modify and redistribute GNU
  466. ;; Emacs, but only under the conditions described in the GNU Emacs
  467. ;; General Public License.  A copy of this license is supposed to have
  468. ;; been given to you along with GNU Emacs so you can know your rights
  469. ;; and responsibilities.  It should be in a file named COPYING.  Among
  470. ;; other things, the copyright notice and this notice must be
  471. ;; preserved on all copies.
  472.  
  473. ;; First we load the real lib.  The original load-path should be stored
  474. ;; in the variable old-load-path.
  475.  
  476. ;(let ((load-path old-load-path))
  477. ;  (require 'compile))
  478.  
  479. ;; Now we patch it.
  480.  
  481. (define-key ctl-x-map "`" 'wsr:next-error)
  482.  
  483. ;; let's hope that nobody is stupid enough to put a colon or
  484. ;; parenthesis in their filenames, (these regexps desperately need to
  485. ;; cue off of them) -wsr
  486.  
  487. ;; for forced updating of the defvar definitions
  488. ;; (defmacro defvar-f (name val doc) (list 'setq name val))
  489.  
  490. (defvar error-parsing-regexp-list
  491.   ;; rule 0: 4.3bsd grep, cc, lint(part1 warnings)
  492.   ;; /users/wolfgang/foo.c(8): warning: w may be used before set
  493.   '(("^\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2)
  494.     ;; rule 1: 4.3bsd lint part2: inconsistant type warnings
  495.     ;; strcmp: variable # of args.      llib-lc(359)  ::  /users/wolfgang/foo.c(8)
  496.     ;; also sysV lint: from kamat@uceng.uc.edu
  497.     ;;     seekdir      llib-lc(345) :: uuq.c?(73)
  498.     ("^[^\n]*[ \t]+\\([^:( \t\n]+\\)[:(]+[ \t]*\\([0-9]+\\)[:) \t]+\\([^:?( \t\n]+\\)\\??[:(]+[ \t]*\\([0-9]+\\)[:) \t]+$"
  499.      3 4 1 2)
  500.  
  501. ;;;    ("[^\n]*[ \t:]+\\([^:( \t\n]+\\)[ \t]*[:(]+[ \t]*\\([0-9]+\\)[:) \t]*$"     1 2)
  502.     ;; rule 2: 4.3bsd lint part3: defined, but unused messages
  503.     ;; linthemorrhoids defined( /users/wolfgang/foo.c(4) ), but never used
  504.     ;; foo used( file.c(144) ), but not defined
  505.     ("[^\n]*\\(defined\\|used\\)[ \t(]+\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+"
  506.      2 3)
  507.     ;; rule 3: 4.3bsd compiler
  508.     ;; "foo.c", line 18: cc_cardiac_arrest undefined
  509.     ("^[\* \t]*[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+of[ \t]+\"\\([^\"\n]+\\)\":" 2 1)
  510.     ;; rule 4: apollo cc warnings, yuk -wsr
  511.     ("^[\* \t]*\"\\([^\"\n]+\\)\",?[ \t]+[Ll]ine[ \t]+\\([0-9]+\\):" 1 2)
  512.     ;; rule 5: as on a sun 3 under sunos 3.4
  513.     ;;(as) "spl.i", line 23:  Error:  syntax error.
  514.     ("^(.+)[ \t]+\"\\([^\"\n]+\\)\",[ \t]+line[ \t]+\\([0-9]+\\):" 1 2)
  515.     ;; rule 6: m88kcc
  516.     ;; "./foo.h" , line 128: redeclaration of bar
  517.     ;; note the extra space before the comma (after filename) : grotty
  518.     ("^\\((.+)[ \t]+\\)?\"\\([^\"\n]+\\)\" ?,[ \t]+line[ \t]+\\([0-9]+\\):"
  519.      2 3)
  520.     ;; rule 7: Make
  521.     ;; Make: line 20: syntax error.  Stop.
  522.     ;; Make: Must be a separator on rules line 84.  Stop.
  523.     ("^[\* \t]*[Mm]ake: [^\n]*[Ll]ine[ \t]+\\([0-9]+\\)[.:]"
  524.      scan-make 1)
  525.     ;; rule 8: /bin/sh 
  526.     ;; filename can only be parsed correctly if it is a full pathname, or
  527.     ;; is relative to this directory.
  528.     ;; ./binshscript: syntax error at line 5: `newline or ;' unexpected
  529.     ("^\\([^:\n]+\\):.*line[ \t]+\\([0-9]+\\):" 1 2)
  530.     ;; rule 9: sysV woes
  531.     ;;     rcmd         cico.c?(243)
  532.     ("^    [^: \t\n]+ +\t\\([^:?( \t\n]+\\)\\??(\\([0-9]+\\))$" 1 2)
  533.     ;; rule 10: sysV lint - "Reach out and confuse someone."
  534.     ;; cico.c
  535.     ;; ==============
  536.     ;; (88)  warning: alias unused in function main
  537.     ;; (656)  warning: main() returns random value to invocation environment
  538.     ;; cntrl.c:
  539.     ;;  
  540.     ;; uucpd.c
  541.     ;; ==============
  542.     ;; warning: argument unused in function:
  543.     ;;     (48)  argc in main
  544.     ;; warning: possible pointer alignment problem
  545.     ;;     (145)            (246)           (329)  
  546.     ;;     (367)        
  547.     ;; note: This regexp has to be incredibally weak.  There just isn't much
  548.     ;; to get a toe-hold on here.  Better keep this one on the end. -wsr
  549.     ("^[ \t]*(\\([0-9]+\\))[ \t]" scan-s5lint 1)
  550.     ;; rule 11: there is no rule 11
  551.     ;; (add other rules and explanations here)
  552.     )
  553.   "a list of lists consisting of:
  554. \((rexexp filename-match-index linenum-match-index)(...)(...))
  555. for parsing error messages")
  556.  
  557. (defun test-parse (pos)
  558.   "Test the line parsing code, attempts to parse the current line for
  559. filename and line number. Answer is returned in minibuffer."
  560.   (interactive "d")
  561.   (forward-line 0)
  562.   (let (filename linenum filename-2 linenum-2) ; set by compilation-parse-line
  563.     (let ((parserule (compilation-parse-line)))
  564.       (if parserule
  565.           (if filename-2
  566.               (message "Parses as: '%s(%d)' and '%s(%d)' [rule %d]"
  567.                        filename linenum
  568.                        filename-2 linenum-2 parserule)
  569.             (message "Parses as: '%s(%d)' [rule %d]"
  570.                      filename linenum parserule))
  571.         (message "Couldn't parse that line")))))
  572.  
  573. (defvar compilations-window-height 4 "*Height of compilations buffer window.")
  574.  
  575. ;; parse error msgs, find file or files, and position cursor on the
  576. ;; appropriate lines.
  577. ;; The "primary" file is always at the bottom of the screen.
  578. ;; The *compilations* buffer is always at the top, and reduced to
  579. ;;  a smaller height.
  580.  
  581. (defvar last-error-buf nil
  582.   "The last buffer that next error used.")
  583.  
  584. (defun wsr:next-error (&optional flag)
  585.   "This is the *new* NEXT ERROR: Visit next compilation error message
  586. and corresponding source code.  This operates on the output from the
  587. \\[compile] command.  This command uses the line after current point
  588. as the starting point of the next error search.
  589.  
  590. If optional FLAG is set (C-u for interactive), cause the current
  591. buffer to be the new compilation buffer."
  592.   (interactive "P")
  593.   (if flag
  594.       (setq last-error-buf (current-buffer)))
  595.   (pop-to-buffer (or last-error-buf last-compilation-buffer
  596.              "*compilation*"))
  597.   (let ((opoint (point))
  598.         (pwd default-directory)
  599.         filename linenum filename-2 linenum-2)
  600.     ;; note: compilation-parse-line will set the above 4 variables
  601.     ;; by side effect.
  602.     (while (and (zerop (forward-line 1))
  603.                 (null (compilation-parse-line))))
  604.     (if (null filename)
  605.     ;; this error will leave on in the compilation buffer.
  606.     ;; usually this is of benefit - one can now move the up
  607.     ;; point back up to bet back to the last error of interest.
  608.         (error (concat compilation-error-message
  609.                        (if (and compilation-process
  610.                                 (eq (process-status compilation-process)
  611.                                     'run))
  612.                            " yet" "")))
  613.       (recenter 0)
  614.       (if (file-exists-p filename)
  615.           (progn
  616.             (delete-other-windows)
  617.             (let ((wh (window-height)))
  618.               (find-file-other-window filename)
  619.               (shrink-window (- compilations-window-height (/ wh 2)))
  620.               )
  621.             (goto-line linenum)
  622.             (recenter (/ (window-height) 2))
  623.             (if filename-2              ; a two file match
  624.                 (let ((default-directory pwd)) ; get the pwd right!
  625.                   (if (file-exists-p filename-2)
  626.                       (progn
  627.                         (split-window-vertically nil)
  628.                         (find-file filename-2)
  629.                         (goto-line linenum-2)
  630.                         (recenter (/ (window-height) 2))
  631.                         ;; now back to file # 1
  632.                         (other-window 1)
  633.                         ;; needed if both windows are on the same file
  634.                         (recenter (/ (window-height) 2)))
  635.                     (message "Can't find file '%s(%d)'"
  636.                              filename-2 linenum-2)))))
  637.         ;; try filename-2 ... suggested by kamat
  638.         (if filename-2
  639.             (if (file-exists-p filename-2)
  640.                 (progn
  641.                   (message "Can't find file '%s(%d)'" filename linenum)
  642.                   (delete-other-windows)
  643.                   (let ((wh (window-height)))
  644.                     (find-file-other-window filename-2)
  645.                     (shrink-window (- compilations-window-height (/ wh 2))))
  646.                   (goto-line linenum-2)
  647.                   (recenter (/ (window-height) 2)))
  648.               (error "Can't find files '%s(%d)' or '%s(%d)'" 
  649.                      filename linenum filename-2 linenum-2))
  650.           (error "Can't find file '%s(%d)'" filename linenum))))))
  651.  
  652. (defun compilation-parse-line ()
  653.   "Parse this line, setq-ing filename and linenum."
  654.   (let ((parse-list error-parsing-regexp-list)
  655.         (rule-num 0))
  656.     (while parse-list
  657.       (let ((rule-list (car parse-list)))
  658.         (if (looking-at (car rule-list))
  659.             (let ((file-index (nth 1 rule-list))
  660.                   (line-index (nth 2 rule-list))
  661.                   (file-2-index (nth 3 rule-list))
  662.                   (line-2-index (nth 4 rule-list)))
  663.               (setq linenum (string-to-int
  664.                              (buffer-substring (match-beginning line-index)
  665.                                                (match-end line-index))))
  666.               (if file-2-index
  667.                   (progn
  668.                     (setq filename-2 (buffer-substring
  669.                                       (match-beginning file-2-index)
  670.                                       (match-end file-2-index)))
  671.                     (setq linenum-2 (string-to-int
  672.                                      (buffer-substring
  673.                                       (match-beginning line-2-index)
  674.                                       (match-end line-2-index))))))
  675.               (setq filename
  676.                     (cond ((integerp file-index)
  677.                            (buffer-substring (match-beginning file-index)
  678.                                              (match-end file-index)))
  679.                           ;; careful! this next funcall may mash
  680.                           ;; the match-data, so it must be done
  681.                           ;; after all the line numbers and names have been
  682.                           ;; extracted
  683.                           ((symbolp file-index) (funcall file-index))
  684.                           ((stringp file-index) file-index)
  685.                           (t (error "Parsing error: unknown action type: %s"
  686.                                     file-index))))
  687.               (setq parse-list nil))    ;we're done
  688.           (setq parse-list (cdr parse-list)
  689.                 rule-num (1+ rule-num)))))
  690.     (and linenum filename rule-num)))   ; return matching rule number
  691.  
  692. (defun scan-make ()
  693.   "Attempt to find the name of the Makefile used by this make run.
  694. This routine shouln't be used for anything drastic, since it just isn't
  695. that robust."
  696.   (cond ((save-excursion
  697.            (re-search-backward "make[^\n]+-f[ \t]+\\(\\sw\\|\\s_\\)+" nil t))
  698.          (buffer-substring (match-beginning 1)(match-end 1)))
  699.         ((file-exists-p "makefile") "makefile")
  700.         ((file-exists-p "Makefile") "Makefile")
  701.         (t nil)
  702.       ))
  703.  
  704. (defun scan-s5lint ()
  705.   "Attempt to find the name of the file that lint was griping about on
  706. this line.  This routine also has the side-effect of modifying the current
  707. buffer.  The current line will have the first gripe of a multi-gripe line 
  708. broken off onto a separate line."
  709.   (let (retval)
  710.     (if (save-excursion
  711.           (re-search-backward "^\\(\\sw\\|\\s_\\|\\s.\\)+\n======+$" nil t))
  712.         (progn
  713.           (setq retval (buffer-substring (match-beginning 1)(match-end 1)))
  714.           (save-excursion
  715.             (if (re-search-forward ")[ \t]*("
  716.                                    (save-excursion (end-of-line) (point)) t)
  717.                 (replace-match ")\n(")))))
  718.   retval))
  719.  
  720.  
  721. -- 
  722. Wolfgang Rupprecht    wolfgang@wsrcc.com (or) uunet!wsrcc!wolfgang
  723. Snail Mail Address:   Box 6524, Alexandria, VA 22306-0524
  724.