home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / rs-compile.el < prev    next >
Encoding:
Text File  |  1993-04-11  |  51.1 KB  |  1,340 lines
  1. ;$modified: Fri Apr  9 19:10:05 1993 by rshouman $
  2. (provide 'rs-compile)
  3. (provide 'compile)
  4.  
  5. ;; LCD Archive Entry:
  6. ;; rs-compile|Radey Shouman|rshouman@chpc.utexas.edu|
  7. ;; More convenient compiler interface; replaces compile.el.|
  8. ;; 09-Apr-1993|1.0|~/misc/rs-compile.el.Z|
  9.  
  10. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11. ;;
  12. ;; rs-compile--Run possibly remote compiler process.  Parse its error messages
  13. ;;             using an extensible table.  Find selected error locations, 
  14. ;;             searching for files in tags table and/or search path.
  15. ;; author:  Radey Shouman         rshouman@chpc.utexas.edu
  16. ;; 
  17. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18. ;;
  19. ;; This file is not part of GNU emacs, but it is based in part on the 18.58
  20. ;; distribution compile.el, and is released on the same terms as GNU emacs.
  21. ;;
  22. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23. ;;
  24. ;; This package is largely based on on mult-compile.el, by Wolfgang Rupprecht.
  25. ;; the following is taken from the header to that package:
  26. ;;           -------------------------------------------
  27. ;; Make a more general purpose compilation interface.
  28. ;;
  29. ;; 1. Make compilation-process be buffer-local. (for buffer->process mapping)
  30. ;; 2. Use the (process-buffer) for process->buffer mapping.
  31. ;; 3. Make compilation-error-message be a buffer local variable.
  32. ;;           --------------------------------------------
  33. ;;
  34. ;; The mult-compile list of regexps and error message parser survive
  35. ;; more or less intact here, as does the idea of following the
  36. ;; error message point is on in the compilation buffer.  However I've
  37. ;; included a few more features to make it more general, and potentially
  38. ;; faster:
  39. ;;
  40. ;; 4.  Follow the error message on the line point is in, in the 
  41. ;;     compilation buffer, so you can pick and choose which errors
  42. ;;     you want to see.  (mult-compile uses the line after point.)
  43. ;; 5.  Use markers to save locations in target files, so editing a file
  44. ;;     doesn't throw later error locations off. 
  45. ;;     Only visit and mark files when they are actually needed, instead of 
  46. ;;     visiting them all at once, as the original compile.el did.
  47. ;; 6.  If a file is not found in the current directory, look in the 
  48. ;;     tags-table for it, if that doesn't work, search through the
  49. ;;     directories in the local variable compilation-vpath, This approach
  50. ;;     doesn't require grubbing around in make output for pwd's and can 
  51. ;;     work with any make.
  52. ;; 7.  Make the compilation buffer scroll in its window, whether point is
  53. ;;     there or not.  If the compilation buffer window isn't visible when
  54. ;;     its process exits, pop it up.
  55. ;; 8.  If the default-directory is an ange-ftp style remote directory,
  56. ;;     use rsh to run the compilation process remotely.
  57. ;; 9.  Provide a symbolic name for each rule, and a compile-hook so that
  58. ;;     rules can be selected on the fly, minimizing unnecessary regexp
  59. ;;     searches -- no need to look for 3 kinds of lint error messages in
  60. ;;     a grep buffer.  Provide an interactive command to add rules by name
  61. ;;     in the compilation buffer.
  62. ;; 10. Provide next-error-find-file-hook so that file opening by next-error
  63. ;;     may be customized.
  64. ;; 11. Add a keymap for the compilation buffer.
  65. ;;
  66. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  67. ;;
  68. ;; Installation:
  69. ;;    byte-compile rs-compile.el and put it somewhere in your load path,
  70. ;;    in your .emacs, use:
  71. ;;
  72. ;;(autoload (fmakunbound 'compile) "rs-compile" 
  73. ;;      "Run compiler as inferior process" t)
  74. ;;(autoload (fmakunbound 'grep) "rs-compile" "Run grep as inferior process" t)
  75. ;;(autoload 'find-grep "rs-compile"
  76. ;;      "Execute grep with find command as inferior process" t)
  77. ;;
  78. ;;     This is meant as a drop-in replacement for compile.el, except for
  79. ;;     the behavior of next-error with a prefix arg, the new next-error
  80. ;;     goes to the first error message in a different file from the one
  81. ;;     pointed to in the compilation buffer.  It should not be necessary
  82. ;;     to force reparsing of the compilation buffer, which is what the
  83. ;;     old next-error did when given a prefix arg.  If you really want to
  84. ;;     force reparsing, you can call compilation-forget-errors interactively.
  85. ;;
  86. ;;;;;;;;;;;;;; user preference configurations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  87. ;;
  88. ;; In order to use only a subset of the regexp rules available in the list
  89. ;; call the function compilation-regexp-list with a symbol in the argument
  90. ;; list for each rule you want to use.
  91. ;;       for example:
  92. ;;(setq compilation-regexp-list
  93. ;;      (compilation-regexp-list 'rule0 'grep 'cray 'convex 'bsdcc 'sh 'make))
  94. ;;
  95. ;; If you do this somewhere other than a compilation buffer, the effect will
  96. ;; be global.
  97. ;;
  98. ;; compile-hook is run whenever a new compilation process is started, so you
  99. ;; can customize local variables according to the process.  Whenever a file
  100. ;; is visited by next-error, it temporarily appends the functions in 
  101. ;; next-error-find-file-hook to those already in find-file-hook.
  102.  
  103. ;; You could use different patterns on different remote hosts this way,
  104. ;;      for example:
  105. ;;(defun compilation-by-host-hook ()
  106. ;;  "Map compilation-regexp-list to remote hostnames. "
  107. ;;  (let ((host (nth 0 (ange-ftp-ftp-path default-directory))))
  108. ;;    (cond ((its-a-cray-p host)
  109. ;;       (compilation-regexp-list 'cray))
  110. ;;      ((its-a-convex-p host)
  111. ;;       (compilation-regexp-list 'convex))
  112. ;;      (t ))))
  113. ;;
  114. ;;  To control window configuration and display, see the variables:
  115. ;;  compilation-window-height, compilation-context-lines,
  116. ;;  compilation-scroll-window, and compilation-select-window.
  117. ;;
  118. ;;  Variables controlling how error files are found are:
  119. ;;  compilation-use-tags-table, and compilation-vpath.
  120. ;;
  121. ;;  Normally, error messages will be parsed by the compilation filter
  122. ;;  as they arrive, if this causes too many delays for other editing,
  123. ;;  this behavior can be disabled by setting the variable
  124. ;;  compilation-background-parse to nil.
  125. ;;
  126. ;;  If next-error cannot parse error messages from a compiler, it should
  127. ;;  probably be sufficient to change compilation-regexp-list, as long as
  128. ;;  each error message has the file name and line number both on one line
  129. ;;  and can be recognized by a regexp.
  130. ;;
  131. ;;  CHANGES:
  132. ;;   9-4-93 Applied patch from Rod Whitby <rwhitby@research.canon.oz.au>
  133. ;;          to fix test-parse, changed name to compilation-test-parse.
  134. ;;          Added find-grep, miscellaneous documentation.
  135. ;;   6-4-93 Fixed compilation-window-height so nil values worked correctly,
  136. ;;          suggestion from Curtis Bingham <bingh@sibelius.cs.byu.edu>
  137. ;;   21-3-93 Added compilation-select-window, fixed compile so that a
  138. ;;           buffer local compile-command would work properly, suggestions by
  139. ;;           Harald Fuchs <hf@telematik.informatik.uni-karlsruhe.de>
  140.  
  141.  
  142.  
  143. (defvar compile-command "make -k"
  144.   "*Default command for compilation, this variable is local in compilation
  145. buffers, if no local value is defined, the global value will be used, the
  146. global value is changed by each new compilation.
  147.  
  148. If the default directory of the compilation buffer is an ange-ftp style 
  149. pathname, then the compile-command will be run on the indicate remote host
  150. using compilation-remote-shell-file-name, (normally rsh).  If compile-command
  151. is of the form user@host:command or host:command, then the command will
  152. liekwise be run on `host'. ")
  153.  
  154. (defvar compilation-use-tags-table 'maybe
  155.   "*If t, next-error will search the current tags table for any files not
  156. found in the default directory.  If not nil and not t, next-error will ask
  157. once in each compilation buffer whether to use a tags table when a file is
  158. not found. ")
  159.  
  160. (defvar compilation-vpath nil
  161.   "*If a list, list of directories next-error will search for any
  162. files not found in the default directory; if a string, a directory to
  163. search.  This variable is buffer local in compilation buffers.
  164.  
  165. If compilation-use-tags is non-nil, next-error will search
  166. the tags table first. ")
  167.  
  168. (defvar compilation-window-height 8 
  169.   "*Height of compilation buffer window.  If nil, don't change window sizes. ")
  170.  
  171. (defvar compilation-context-lines 4
  172.   "*Number of lines of continuity when scrolling compilation window with
  173. next-error. ")
  174.  
  175. (defvar compilation-scroll-window t
  176.   "*If non-nil, scroll the compilation buffer window as new output arrives. ")
  177.  
  178. (defvar compilation-select-window t
  179.   "*If non-nil, starting the compilation process will select the compilation
  180. window, otherwise, it will display the window, but not select it. ")
  181.  
  182. (defvar compilation-sets-error-buf t
  183.   "*A compile command will set the error buf.")
  184.  
  185. (defvar grep-command "egrep -n "
  186.   "*The default grep command.")
  187.  
  188. (defvar find-grep-format "find . -type f %s -exec egrep -n %s {} /dev/null \\;"
  189.   "*Format for producing the find-grep command. ")
  190.  
  191. (defvar compile-hook nil
  192.   "*Function or list of functions to be called before starting a compilation
  193. process with \\[compile].  This might be a good place to set
  194. compilation-regexp-list or compilation-vpath. ")
  195.  
  196. (defvar next-error-find-file-hook nil
  197.   "*Function or list of functions to be added to the end of find-file-hooks
  198. when finding a file with \\[next-error]. ")
  199.  
  200. (defvar compilation-expert nil
  201.   "*If non-nil, don't print fancy error messages. ")
  202.  
  203. (defvar compilation-background-parse t
  204.   "*If non-nil, parse error messages while they are being received, this
  205. may cause slow response if you are editing another buffer at the same time. ")
  206.  
  207. (defvar compilation-mode-map nil
  208.   "Local keymap for compilation buffer. ")
  209. (if compilation-mode-map
  210.     nil
  211.   (setq compilation-mode-map (make-sparse-keymap))
  212.   (define-key compilation-mode-map "\C-c\C-b" 'rename-buffer)
  213.   (define-key compilation-mode-map "\C-c\C-c" 'compile-again)
  214.   (define-key compilation-mode-map "\C-c\C-d" 'compilation-cd)
  215.   (define-key compilation-mode-map "\C-c\C-f" 'this-error)
  216.   (define-key compilation-mode-map "\C-c\C-k" 'kill-compilation)
  217.   (define-key compilation-mode-map "\C-c\C-n" 'next-error-next-line)
  218.   (define-key compilation-mode-map "\C-c\C-p" 'next-error-previous-line)
  219.   (define-key compilation-mode-map "\C-c\C-r" 'compilation-add-rule)
  220.   (define-key compilation-mode-map "\C-c\C-t" 'compilation-use-tags-table)
  221.   (define-key compilation-mode-map "\C-c\C-v" 'compilation-add-vpath)
  222.   (define-key compilation-mode-map "\C-^" 'compilation-enlarge-window)
  223.   (define-key ctl-x-map "`" 'next-error)
  224.   (define-key ctl-x-map "~" 'next-error-backward))
  225.  
  226. ;; let's hope that nobody is stupid enough to put a colon or
  227. ;; parenthesis in their filenames, (these regexps desperately need to
  228. ;; cue off of them) -wsr
  229.  
  230. (defvar compilation-regexp-list
  231. '(
  232.   ;; rule 0: if it doesn't have any numbers, it isn't an error message.
  233.   (rule0
  234.    "\\[^0-9]*$" nil nil)
  235.  
  236.   ;; rule 1: 4.3bsd grep, cc, lint(part1 warnings)
  237.   ;; /users/wolfgang/foo.c(8): warning: w may be used before set
  238.   (grep
  239.    "\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2)
  240.  
  241.   ;; added rule 2 for CRAY compiler messages  --ars
  242.   (cray
  243.    "[^\n:]*:[^\n]*File = \\([^,]+\\), *Line = \\([0-9]+\\)" 1 2)
  244.  
  245.   ;; added rule 3 for ConvexOS compiler messages --ars
  246.   (convex
  247.    "[^\n:]*:[^\n]*on line \\([0-9]+\\)[.0-9]* of \\([^:\n]+\\):" 2 1)
  248.  
  249.   ;; Thanks to Richard Everson <rme@cfm.brown.edu>
  250.   ;; sgi C compiler.
  251.   (sgi
  252.    "[^\n:]*: [^\n:]*: \\([^,\n]+\\), line \\([0-9]+\\):.*" 1 2 )
  253.  
  254.   ;; rule 4: 4.3bsd lint part2: inconsistant type warnings
  255.   ;; strcmp: variable # of args.     llib-lc(359)  ::  /users/wolfgang/foo.c(8)
  256.   ;; also sysV lint: from kamat@uceng.uc.edu
  257.   ;;     seekdir      llib-lc(345) :: uuq.c?(73)
  258.   (lint2
  259.    "[^\n]*[ \t]+\\([^:( \t\n]+\\)[:(]+[ \t]*\\([0-9]+\\)[:) \t]+\\([^:?( \t\n]+\\)\\??[:(]+[ \t]*\\([0-9]+\\)[:) \t]+$"
  260.    3 4 1 2)
  261.  
  262.   ;; rule 5: 4.3bsd lint part3: defined, but unused messages
  263.   ;; linthemorrhoids defined( /users/wolfgang/foo.c(4) ), but never used
  264.   ;; foo used( file.c(144) ), but not defined
  265.   (lint3
  266.    "[^\n]*\\(defined\\|used\\)[ \t(]+\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+"
  267.    2 3)
  268.  
  269.   ;; rule 6: 4.3bsd compiler
  270.   ;; "foo.c", line 18: cc_cardiac_arrest undefined
  271.   (bsdcc
  272.    "[\* \t]*[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+of[ \t]+\"\\([^\"\n]+\\)\":"
  273.    2 1)
  274.  
  275.   ;; rule 7: apollo cc warnings, yuk -wsr
  276.   (apollo
  277.    "[\* \t]*\"\\([^\"\n]+\\)\",?[ \t]+[Ll]ine[ \t]+\\([0-9]+\\):"
  278.    1 2)
  279.  
  280.   ;; rule 8: as on a sun 3 under sunos 3.4
  281.   ;;(as) "spl.i", line 23:  Error:  syntax error.
  282.   (sun3
  283.    "(.+)[ \t]+\"\\([^\"\n]+\\)\",[ \t]+line[ \t]+\\([0-9]+\\):"
  284.    1 2)
  285.  
  286.   ;; rule 9: m88kcc
  287.   ;; "./foo.h" , line 128: redeclaration of bar
  288.   ;; note the extra space before the comma (after filename) : grotty
  289.   (m88kcc
  290.    "\\((.+)[ \t]+\\)?\"\\([^\"\n]+\\)\" ?,[ \t]+line[ \t]+\\([0-9]+\\):"
  291.    2 3)
  292.  
  293.   ;; rule 10: Make
  294.   ;; Make: line 20: syntax error.  Stop.
  295.   ;; Make: Must be a separator on rules line 84.  Stop.
  296.   (make 
  297.    "[\* \t]*[Mm]ake: [^\n]*[Ll]ine[ \t]+\\([0-9]+\\)[.:]"
  298.    scan-make 1)
  299.  
  300.   ;; rule 11: /bin/sh 
  301.   ;; filename can only be parsed correctly if it is a full pathname, or
  302.   ;; is relative to this directory.
  303.   ;; ./binshscript: syntax error at line 5: `newline or ;' unexpected
  304.   (sh
  305.    "\\([^:\n]+\\):.*line[ \t]+\\([0-9]+\\):"
  306.    1 2)
  307.  
  308.   ;; rule 12: sysV woes
  309.   ;;     rcmd         cico.c?(243)
  310.   (sysv
  311.    "     [^: \t\n]+ +\t\\([^:?( \t\n]+\\)\\??(\\([0-9]+\\))$"
  312.    1 2)
  313.  
  314.   ;; rule 13: AIX
  315.   (aix
  316.    "\"\\([^\"]+\\)\", line \\([0-9]+\\)\\.[0-9]+:" 
  317.    1 2)
  318.  
  319.   ;; rule 14: sysV lint - "Reach out and confuse someone."
  320.   ;; cico.c
  321.   ;; ==============
  322.   ;; (88)  warning: alias unused in function main
  323.   ;; (656)  warning: main() returns random value to invocation environment
  324.   ;; cntrl.c:
  325.   ;;  
  326.   ;; uucpd.c
  327.   ;; ==============
  328.   ;; warning: argument unused in function:
  329.   ;;     (48)  argc in main
  330.   ;; warning: possible pointer alignment problem
  331.   ;;     (145)            (246)           (329)  
  332.   ;;     (367)        
  333.   ;; note: This regexp has to be incredibly weak.  There just isn't much
  334.   ;; to get a toe-hold on here.  Better keep this one on the end. -wsr
  335.   (lintv
  336.    "[ \t]*(\\([0-9]+\\))[ \t]" scan-s5lint 1)
  337.  
  338.   ;; rule 15: there is no rule 15
  339.   ;; \(add other rules and explanations here\)
  340.   )
  341.   "List of rules for parsing compilation buffer error messages.  Each
  342. rule is a list:
  343. \(symbol regexp filename-index-1 linenum-index-1 
  344.                  filename-index-2 linenum-index-2\)
  345. symbol is the name of the rule, used in making the local variable
  346. compilation-regexp-list, regexp is a regular expression matching
  347. the error message, filename-index-1 is the subexpression of the regexp
  348. matching the first filename mentioned, and similarly for filename-index-2,
  349. and the linenum indexes. ")
  350.  
  351. (defvar compilation-remote-shell-file-name "rsh"
  352.   "The name of the program used to run a program on a remote machine,
  353. should be the same as ange-ftp-remote-shell-file-name if you are using
  354. ange-ftp.")
  355.  
  356. ;;;;;;;;;;;;;;;;;;;;;;;; end user configuration ;;;;;;;;;;;;;;;;;;;;;;;;;;
  357.  
  358. (defvar compilation-process nil
  359.   "Process created by compile command, or nil if none exists now.
  360. Note that the process may have been \"deleted\" and still
  361. be the value of this variable.")
  362.  
  363. (defvar compilation-error-type nil
  364.   "*What to call error messages when we report how many there are. This
  365. is local in compilation buffers. ")
  366.  
  367. (defvar compilation-regexp-list nil
  368.   "A subset of compilation-master-regexp-list, but without symbols in car
  369. of each sublist, used by next-error for parsing error-messages.  This is
  370. be local in compilation buffers.  See compilation-master-regexp-list. ")
  371.  
  372. (defvar compile-last-compilation-buffer "*compilation*"
  373.   "Last buffer used for compilation. ")
  374.  
  375. (defvar compilation-last-error-buf nil
  376.   "Last compilation buffer from which the \\[next-error] command was 
  377. executed. ")
  378.  
  379. (defvar compilation-last-command nil
  380.   "Last compile command used in this buffer. ")
  381.  
  382. (defvar compilation-parsing-end-marker nil
  383.   "Marks the end of the part of the compilation buffer that has been parsed.")
  384.  
  385. (defvar compilation-error-list  nil
  386.   "Alist of error location alists for each file, the car is a file name, the
  387. cdr is an alist, the car of which is a line number and the cdr is a marker if
  388. the file has been visited, or nil if it has not.
  389.  
  390. ((filename1 (num1 . mark1) (num2 . mark2)) (filename2 (num1 . mark1)) ... )")
  391.  
  392. ;; This function is here to make it easy to drop rules before parsing the 
  393. ;; buffer, if it is clear that some of them aren't going to be necessary.
  394. (defun compilation-regexp-list (&rest args)
  395.   "For each ARG, define a rule in the local compilation-regexp-list.
  396. If ARG is a symbol, it is the car of a rule in the global 
  397. compilation-regexp-list.
  398. If it is a list, copy it into the local list, each list should look like:
  399.  
  400. \(symbol regexp filename-match-index-1 linenum-match-index-1 
  401.     filename-match-index-2 linenum-match-index-2\)
  402.  
  403. symbol is the name of the rule, for a local rule, it can be anything,
  404. regexp is a regular expression matching the error message, filename-index-1
  405. is the subexpression of the regexp matching the first filename mentioned, 
  406. and similarly for filename-index-2, and the linenum indexes. 
  407.  
  408. With no args, or nil, use all the rules in the global compilation-regexp-list."
  409.   (setq compilation-regexp-list (default-value 'compilation-regexp-list))
  410.   (if (null args)
  411.       compilation-regexp-list
  412.     (setq compilation-regexp-list
  413.       (mapcar '(lambda (arg) 
  414.              (cond ((symbolp arg)
  415.                 (or 
  416.                  (assq arg compilation-regexp-list)
  417.                  (error "rule %s not in compilation-regexp-list"
  418.                     arg)))
  419.                ((listp arg)
  420.                 (if (stringp (car (cdr arg)))
  421.                 arg
  422.                   (error "%s is not a regexp" (car (cdr arg)))))
  423.                (t nil)))
  424.           args))))
  425.  
  426. (defun compilation-add-rule (rule &optional last interactive)
  427.   "Add a parsing rule from the global definition of compilation-regexp-list
  428. to the local definition, the rule will be the one given by the list whose
  429. car is the symbol RULE.  With optional LAST or interactive prefix arg, put
  430. rule at the end of the current list, instead of the beginning. "
  431.   (interactive
  432.    (let (alist)
  433.      (mapcar '(lambda (arg) 
  434.         (or (assq (car arg) compilation-regexp-list)
  435.             (setq alist
  436.               (cons (list (symbol-name (car arg))) alist))))
  437.          (default-value 'compilation-regexp-list))
  438.      (list
  439.       (if alist
  440.       (intern (completing-read "rule? " alist nil t))
  441.     (error "All rules already used."))
  442.       current-prefix-arg t)))
  443.  
  444.   (setq compilation-regexp-list
  445.     (if last
  446.         (append compilation-regexp-list
  447.             (list
  448.              (assq rule (default-value 'compilation-regexp-list))))
  449.       (cons (assq rule (default-value 'compilation-regexp-list))
  450.         compilation-regexp-list)))
  451.   (if interactive
  452.       (message "rule list: %s" (mapcar 'car compilation-regexp-list))))
  453.  
  454. (defun compile (command &optional buf)
  455.   "Run COMMAND asynchronously, putting output in the buffer named BUF 
  456. (default *compilation*).  When invoked interactively, command will be
  457. prompted for (default is \"make -k\"); if invoked with prefix arg, the
  458. buffer name is prompted for as well.
  459.  
  460. \\<compilation-mode-map>\\
  461. The output from COMMAND is scanned for error messages from compilers;
  462. you can then use the command \\[next-error] to jump to the location in 
  463. a source file indicated by an first error message.  The error message will
  464. be the first one on or after the line point is in in the compilation
  465. buffer, so you can choose which messages you want to follow.
  466.  
  467. Commands:
  468.  
  469. These are available anywhere, and use the last active compilation buffer:
  470.   \\[next-error] finds the error indicated by point in the compilation buffer
  471.          with prefix arg, finds an error in another file.
  472.  
  473.   \\[next-error-backward\\] finds the first error before the one that \\[next-error\\]
  474.          would jump to.
  475.  
  476. These are available only in the compilation buffer:
  477.  
  478.   \\[this-error] finds the source code corresponding to the error message
  479.          on the line point is in.
  480.  
  481.   \\[next-error-next-line] skips to the next error message, but doesn't find the 
  482.          file, with prefix arg, skips to an error message about another file.
  483.  
  484.   \\[next-error-previous-line] skips to the previous error message, with prefix
  485.          arg, the previous file.
  486.  
  487.   \\[compilation-add-vpath]  adds a directory to the beginning of the search 
  488.          path for error files, with prefix arg adds it to the end or the path.
  489.  
  490.   \\[compilation-use-tags-table]  tells next-error to use the current tags table
  491.          to find files, prompting for it if necessary.
  492.  
  493.   \\[rename-buffer]  renames the current buffer.
  494.  
  495.   \\[compilation-cd]  changes the default directory. 
  496.  
  497.   \\[compilation-add-rule]  adds an error message parsing rule from the global
  498.          list to the local one. "
  499.   (interactive (let ((dir default-directory)
  500.              (buffer-command (if (string= compile-command 
  501.                          (default-value 'compile-command))
  502.                      nil
  503.                        compile-command))
  504.              command buf)
  505.          (setq buf
  506.                (if current-prefix-arg
  507.                (read-buffer "Compilation buffer: "
  508.                     compile-last-compilation-buffer)
  509.              ;; Use current buffer if it is a compilation buffer
  510.              (if (eq major-mode 'compile)
  511.                  (buffer-name (current-buffer))
  512.                compile-last-compilation-buffer)))
  513.          (set-buffer (get-buffer-create buf))
  514.          (setq default-directory dir)
  515.          (setq command
  516.                (let ((host 
  517.                   (and (fboundp 'ange-ftp-ftp-path)
  518.                    (nth 0 (ange-ftp-ftp-path 
  519.                        default-directory)))))
  520.              (read-string 
  521.               (concat (if host (concat "(" host ") "))
  522.                   "Compile command: ")
  523.               (or buffer-command
  524.                   compilation-last-command
  525.                   compile-command))))
  526.          (list command buf)))
  527.  
  528.   (setq-default compilation-last-command command)
  529.   (setq compile-last-compilation-buffer buf)
  530.   (compile1 command "error" nil buf 'compile))
  531.  
  532. (defun grep (command)
  533.   "Run grep, with user-specified args, and collect output in a buffer.
  534. While grep runs asynchronously, you can use the \\[next-error] command
  535. to find the text that grep hits refer to."
  536.   (interactive 
  537.    (let ((dir default-directory))
  538.      (set-buffer (get-buffer-create "*grep*"))
  539.      (setq default-directory dir)
  540.      (let ((host (and (fboundp 'ange-ftp-ftp-path)
  541.               (nth 0 (ange-ftp-ftp-path default-directory))))
  542.        cmd)
  543.        (list (read-string 
  544.           (concat (if host (concat "(" host ") ")) "Grep command: ")
  545.           grep-command)))))
  546.   (setq grep-command command)
  547.   (compile1 (concat command " /dev/null")
  548.         "grep hit" "grep" "*grep*" 'grep '(grep)))
  549.  
  550. (defun find-grep (command)
  551.   "Run find, executing egrep, with a user-specified expression, and collect
  552. output in a buffer.
  553. While grep runs asynchronously, you can use the \\[next-error] command
  554. to find the text that grep hits refer to."
  555.   (interactive 
  556.    (let ((dir default-directory))
  557.      (set-buffer (get-buffer-create "*grep*"))
  558.      (setq default-directory dir)
  559.      (let ((find-args (read-string "find arguments: "))
  560.        (grep-args (read-string "Grep arguments: ")))
  561.        (list (format find-grep-format find-args grep-args)))))
  562.   (compile1 command "grep hit" "find-grep" "*find-grep*" 'find-grep '(grep)))
  563.  
  564. (defun compile-again ()
  565.   "Runs compile or grep again from a compilation buffer. "
  566.   (interactive)
  567.   (call-interactively
  568.    (if compilation-revert-function
  569.        compilation-revert-function
  570.      'compile)))
  571.  
  572. ;; error-type is a string describing the errors, or grep hits, or whatever.
  573. ;; revert-function is the function to call when compile-again is executed.
  574. (defun compile1 (command error-type &optional name-of-mode comp-buf 
  575.              revert-function regexp-list)
  576.   "All-singing, all-dancing, multi-buffer, ange-ftpified, ever-scrolling,
  577. smart-file-finding, customizable version of compile1.  It slices, it dices,
  578. it crawls on its belly like a reptile and rubs up against you leg ...
  579. but wait, there's MORE ... "
  580.   (save-some-buffers)
  581.   (setq comp-buf (get-buffer-create (or comp-buf "*compilation*")))
  582.   (let ((cwd default-directory)         ; catch that slippery animal
  583.         (comp-buf-name (buffer-name comp-buf)))
  584.     (set-buffer comp-buf)
  585.     (setq default-directory cwd)      ; and restore...
  586.     (if compilation-process
  587.     (if (or (not (eq (process-status compilation-process) 'run))
  588.         (yes-or-no-p
  589.          "A compilation process is running in this buffer; kill it? "
  590.          ))
  591.         (condition-case ()
  592.         (let ((comp-proc compilation-process))
  593.           (interrupt-process comp-proc)
  594.           (sit-for 1)
  595.           (delete-process comp-proc))
  596.           (error nil))
  597.       (error "Cannot have two processes in one buffer!")))
  598.  
  599.     (if compilation-sets-error-buf
  600.     (setq compilation-last-error-buf comp-buf-name))
  601.     (fundamental-mode)
  602.     (use-local-map compilation-mode-map)
  603.     (buffer-flush-undo comp-buf)
  604.     (setq mode-name (or name-of-mode "Compilation"))
  605.     (setq major-mode 'compile)
  606.  
  607.     ;; Make log buffer's mode line show process state
  608.     (setq mode-line-process '(": %s"))
  609.  
  610.     (make-local-variable 'compilation-regexp-list)
  611.     (make-local-variable 'compilation-last-command)
  612.     (make-local-variable 'compilation-process)
  613.     (make-local-variable 'compilation-error-type)
  614.     (make-local-variable 'compilation-parsing-end-marker)
  615.     (make-local-variable 'compilation-error-list)
  616.     (make-local-variable 'compilation-use-tags-table)
  617.     (make-local-variable 'compilation-vpath)
  618.     (make-local-variable 'next-error-find-file-hook)
  619.     (make-local-variable 'compilation-revert-function)
  620.     (setq compilation-last-command command
  621.       compilation-error-type error-type
  622.       compilation-parsing-end-marker (make-marker)
  623.       compilation-revert-function (symbol-function revert-function)
  624.       compilation-regexp-list (if regexp-list
  625.                       (apply 'compilation-regexp-list
  626.                          regexp-list)
  627.                     (default-value 'compilation-regexp-list)))
  628.  
  629.     (run-hooks 'compile-hook)
  630.     (compilation-forget-errors)
  631.     (with-output-to-temp-buffer comp-buf-name
  632.       (princ mode-name)
  633.       (princ " started at ")
  634.       (princ (substring (current-time-string) 0 -5))
  635.       (terpri)
  636.       (princ "cd ")
  637.       (princ default-directory)
  638.       (terpri)
  639.       (princ command)
  640.       (terpri))
  641.     (if compilation-select-window
  642.     (pop-to-buffer (current-buffer) nil)
  643.       (set-window-point (get-buffer-window (current-buffer))
  644.             (point-max)))
  645.  
  646.     ;; I've altered this bit to run remote processes if that seems to 
  647.     ;; be necessary.  --ars
  648.     (let ((arglst (or (compilation-rsh-arglst command t)
  649.               (list shell-file-name "-c" command))))
  650.       (setq compilation-process
  651.         (apply 'start-process "compilation" comp-buf
  652.                (car arglst) (cdr arglst))))
  653.     (set-process-sentinel compilation-process 'compilation-sentinel)
  654.     (set-process-filter compilation-process 'compilation-filter)
  655.     (and compilation-scroll-window (goto-char (point-max)))))
  656.  
  657. (defun compilation-filter (process string)
  658.   (save-excursion
  659.     (set-buffer (process-buffer process))
  660.     (save-excursion
  661.       (let* ((p-mark (process-mark process))
  662.          (win (get-buffer-window (current-buffer)))
  663.          (move-point (and compilation-scroll-window
  664.                   win
  665.                   (equal 
  666.                    (window-point win) (marker-position p-mark))))
  667.          (buffer-read-only nil))
  668.     (or (marker-position p-mark)
  669.         (set-marker p-mark (point-max)))
  670.     (goto-char (marker-position p-mark))
  671.     (insert-before-markers string)
  672.     (if compilation-background-parse
  673.         (compilation-parse-buffer))
  674.     (and move-point
  675.          (goto-char (marker-position p-mark))
  676.          (set-window-point (get-buffer-window (current-buffer)) (point)))))
  677.     ))
  678.  
  679. ;; Called when compilation process changes state.
  680. (defun compilation-sentinel (process message)
  681.   (let ((buf (process-buffer process))
  682.     move-point)
  683.     (save-excursion
  684.       (set-buffer buf)
  685.       (let ((buffer-read-only nil))
  686.     ;; If point is at the end of the buffer, we'll keep it there and
  687.     ;; scroll the buffer.
  688.     (setq move-point (and (get-buffer-window buf)
  689.                   (eobp)))
  690.     (save-excursion
  691.       (cond ((null (buffer-name buf))
  692.            ;; buffer killed
  693.          (set-process-buffer process nil))
  694.         ((memq (process-status process) '(signal exit))
  695.          ;; Write something in *compilation* and hack its mode line,
  696.          (goto-char (point-max))
  697.          (or (= (process-exit-status process) 0)
  698.              (setq message "failed "))
  699.          (insert ?\n mode-name " " message)
  700.          (forward-char -1)
  701.          (insert " at "
  702.              (substring (current-time-string) 0 -5))
  703.          (setq mode-line-process
  704.                (concat ": "
  705.                    (symbol-name (process-status process))))
  706.          ;; If buffer and mode line will show that the process
  707.          ;; is dead, we can delete it now.  Otherwise it
  708.          ;; will stay around until M-x list-processes.
  709.          (delete-process process)
  710.          (setq compilation-process nil)
  711.          ;; Force mode line redisplay soon
  712.          (set-buffer-modified-p (buffer-modified-p))
  713.          (if compilation-background-parse
  714.              ;; Parse error messages in buffer, and report.
  715.              (let ((data (match-data))
  716.                (n 0))
  717.                (unwind-protect 
  718.                (compilation-parse-buffer)
  719.              (store-match-data data))
  720.                (mapcar '(lambda (arg)
  721.                   (setq n (+ n (length (cdr arg)))))
  722.                    compilation-error-list)
  723.                (cond ((= n 0)
  724.                   (insert "  no " 
  725.                       compilation-error-type "s found."))
  726.                  ((= n 1)
  727.                   (insert "  one "
  728.                       compilation-error-type " found."))
  729.                  (t 
  730.                   (insert (format "  %d %ss found." n
  731.                           compilation-error-type)))))))))))
  732.     (let ((comp-win (get-buffer-window buf)))
  733.       (if comp-win
  734.       (if move-point
  735.           (if (eq comp-win (selected-window))
  736.           (goto-char (point-max))
  737.         (save-excursion
  738.           (set-buffer buf)
  739.           (set-window-point comp-win (point-max)))))
  740.     (let* ((win (get-largest-window))
  741.            (height (- (window-height win)
  742.               (if (numberp compilation-window-height)
  743.                   compilation-window-height
  744.                 5))))
  745.       (split-window win (if (> height 2) height nil)))
  746.     (display-buffer buf)
  747.     (set-window-point (get-buffer-window buf) (point-max)))
  748.       (message "compilation in buffer %s finished" (buffer-name buf)))))
  749.  
  750. (defun compilation-cd (dir)
  751.   "Set the default directory to DIR for the current buffer. "
  752.   (interactive (list (expand-file-name
  753.               (compilation-read-dir-name "Directory? " 
  754.                          default-directory
  755.                          default-directory t))))
  756.   (setq default-directory dir)
  757.   (message "default directory now %s ." default-directory))
  758.  
  759. (defun kill-compilation ()
  760.   "Kill the process made by the \\[compile] command. "
  761.   (interactive)
  762.   (if compilation-process
  763.       (if (eq last-command 'kill-compilation)
  764.       (kill-process compilation-process)
  765.     (interrupt-process compilation-process))
  766.     (error "This buffer doesn't have a compilation process!")))
  767.  
  768. ;; Set compilation-error-list to nil, and
  769. ;; unchain the markers that point to the error messages and their text,
  770. ;; so that they no longer slow down gap motion.
  771. (defun compilation-forget-errors ()
  772.   (interactive)
  773.   (set-marker compilation-parsing-end-marker (point-min))
  774.   (while compilation-error-list
  775.     (let ((file-error-list (car compilation-error-list)))
  776.       (setq file-error-list (cdr file-error-list))
  777.       (while file-error-list
  778.     (set-marker (cdr (car file-error-list)) nil)
  779.     (setq file-error-list (cdr file-error-list))))
  780.     (setq compilation-error-list (cdr compilation-error-list))))
  781.       
  782. ;; Set all markers in file-error-list to point at the appropriate lines.
  783. (defun compilation-set-markers (file-error-list)
  784.   (let (linenumber this-marker)
  785.     (while (setq file-error-list (cdr file-error-list))
  786.       (setq linenumber (car (car file-error-list)))
  787.       (setq this-marker (cdr (car file-error-list)))
  788.       (goto-line linenumber)
  789.       (set-marker this-marker (point)))))
  790.       
  791. ;; Find all error messages in this buffer after compilation-parsing-end-marker,
  792. ;; and build  compilation-error-list with the filenames and line numbers,
  793. ;; but do not visit any of the files, we don't know whether the user
  794. ;; wants to see them or not.
  795. (defun compilation-parse-buffer ()
  796.   (save-excursion
  797.     (goto-char (marker-position compilation-parsing-end-marker))
  798.     ;; Don't parse the first two lines as error messages.
  799.     ;; This matters for grep.
  800.     (if (bobp)
  801.     (progn
  802.       (setq compilation-error-list nil)
  803.       (forward-line 2)
  804.       (set-marker compilation-parsing-end-marker (point))))
  805.     (let ((n-errors 0)
  806.       filename linenumber errinfo file-error-list)
  807.       (while (looking-at ".*\n")
  808.     (setq errinfo (compilation-parse-line))
  809.     (if errinfo
  810.         (progn
  811.           (setq n-errors (1+ n-errors))
  812.           (setq filename (nth 0 errinfo))
  813.           (setq linenumber (nth 1 errinfo))
  814.           (setq file-error-list
  815.             (or (assoc filename compilation-error-list)
  816.             (progn
  817.               (setq compilation-error-list
  818.                 (cons (list filename) compilation-error-list))
  819.               (car compilation-error-list))))
  820.           
  821.           (if (assoc linenumber file-error-list)
  822.           nil
  823.         (setcdr file-error-list
  824.             (cons (cons linenumber (make-marker)) 
  825.                   (cdr file-error-list))))))
  826.     (set-marker compilation-parsing-end-marker (point))
  827.     (beginning-of-line 2))
  828.       n-errors)))
  829.  
  830. ;; Parse current line for error messages, return a list like:
  831. ;; (filename linenumber filename-2 linenumber-2)
  832. (defun compilation-parse-line ()
  833.   (let ((parse-list compilation-regexp-list)
  834.     filename linenum filename-2 linenum-2 rule)
  835.     (save-excursion
  836.       (beginning-of-line)
  837.       (skip-chars-forward "[ ]")
  838.       (while parse-list
  839.     (let ((rule-list (car parse-list)))
  840.       (if (looking-at (car (cdr rule-list)))
  841.           (let ((file-index (nth 2 rule-list))
  842.             (line-index (nth 3 rule-list))
  843.             (file-2-index (nth 4 rule-list))
  844.             (line-2-index (nth 5 rule-list)))
  845.         (setq linenum (string-to-int
  846.                    (buffer-substring (match-beginning line-index)
  847.                          (match-end line-index))))
  848.         (if file-2-index
  849.             (progn
  850.               (setq filename-2 (buffer-substring
  851.                     (match-beginning file-2-index)
  852.                     (match-end file-2-index)))
  853.               (setq linenum-2 (string-to-int
  854.                        (buffer-substring
  855.                     (match-beginning line-2-index)
  856.                     (match-end line-2-index))))))
  857.         (setq filename
  858.               (cond ((integerp file-index)
  859.                  (buffer-substring (match-beginning file-index)
  860.                            (match-end file-index)))
  861.                 ;; careful! this next funcall may mash
  862.                 ;; the match-data, so it must be done
  863.                 ;; after all the line numbers and names have been
  864.                 ;; extracted
  865.                 ((symbolp file-index) (funcall file-index))
  866.                 ((stringp file-index) file-index)
  867.                 (t (error "Parsing error: unknown action type: %s"
  868.                       file-index))))
  869.         (setq rule (car rule-list))
  870.         (setq parse-list nil))    ;we're done
  871.         (setq parse-list (cdr parse-list)))))
  872.       (and filename linenum
  873.        (list filename linenum filename-2 linenum-2 rule)))))
  874.  
  875. (defun compilation-test-parse (pos)
  876.   "Test the line parsing code, attempts to parse the current line for
  877. filename and line number. Answer is returned in minibuffer."
  878.   (interactive "d")
  879.   (forward-line 0)
  880.   (let (filename linenum filename-2 linenum-2 rule)
  881.     ;; (filename linenum filename-2 linenum-2 rule) is returned by
  882.     ;; compilation-parse-line
  883.     (let ((parselist (compilation-parse-line)))
  884.       (if parselist
  885.           (if (nth 2 parselist)
  886.               (message "Parses as: '%s(%d)' and '%s(%d)' [rule %s]"
  887.                        (nth 0 parselist) (nth 1 parselist)
  888.                        (nth 2 parselist) (nth 3 parselist)
  889.                (princ (nth 4 parselist)))
  890.             (message "Parses as: '%s(%d)' [rule %s]"
  891.                      (nth 0 parselist) (nth 1 parselist)
  892.              (princ (nth 4 parselist))))
  893.     (message "Couldn't parse that line")))))
  894.  
  895. (defun compilation-use-tags-table ()
  896.   "*Set the variable compilation-use-tags-table to t, so that next-error
  897. will use a tags table.  If tags-file-name is nil, then set it.  If the 
  898. function visit-tags-table-locally is bound, use it, otherwise call
  899. visit-tags-table.  (harris-tags.el defines visit-tags-table-locally.) "
  900.   (interactive)
  901.   (setq compilation-use-tags-table t)
  902.   (or tags-file-name
  903.       (call-interactively (if (fboundp 'visit-tags-table-locally)
  904.                   'visit-tags-table-locally
  905.                 'visit-tags-table))))
  906.  
  907. (defun compilation-add-vpath (dir &optional last interactive)
  908.   "*Add DIR to the front of vpath used by next-error, if in a compilation 
  909. buffer, this will be buffer local, otherwise it will be global.  With
  910. optional LAST or interactive prefix argument add dir to end of vpath.
  911. Return dir. "
  912.   (interactive
  913.    (list (expand-file-name
  914.       (compilation-read-dir-name "Add directory: "
  915.                      default-directory
  916.                      default-directory t))
  917.      current-prefix-arg t))
  918.  
  919.   (if (member dir compilation-vpath)
  920.       (if (y-or-n-p (format "%s already in vpath, continue? " dir))
  921.       (setq dir (compilation-read-dir-name "Directory? "
  922.                            default-directory
  923.                            dir t))
  924.     (error)))
  925.   (setq compilation-vpath
  926.     (cond ((listp compilation-vpath)
  927.            (if last (append compilation-vpath (list dir))
  928.          (cons dir compilation-vpath)))
  929.           ((stringp compilation-vpath)
  930.            (list dir compilation-vpath))
  931.           (t dir)))
  932.   (if interactive 
  933.       (message "compilation-vpath: %s" compilation-vpath))
  934.   dir)
  935.  
  936. (defun compilation-enlarge-window (&optional arg)
  937.   "Enlarge the compilation buffer window, remembering its size in a local
  938. variable. "
  939.   (interactive "p")
  940.   (let ((change (and (numberp compilation-window-height)
  941.              (= (window-height) compilation-window-height))))
  942.   (enlarge-window (or arg 1))
  943.   (if change
  944.       (setq compilation-window-height (window-height)))))
  945.  
  946. (defun next-error-next-line (&optional next-file)
  947.   "In a compilation buffer, go to the first line after the one point
  948. is in that contains an error message, and move forward one line.
  949. Returns a list containing the filename and linenumber according to the
  950. error message. "
  951.   (interactive "P")
  952.   (next-error-line 1 next-file))
  953.  
  954. (defun next-error-previous-line (&optional next-file)
  955.   "In a compilation buffer, go to the first line before the one point
  956. is in that contains an error message, and move backward one more line.
  957. Returns a list containing the filename and linenumber according to the
  958. error message. "
  959.   (interactive "P")
  960.   (next-error-line -1 next-file))
  961.  
  962. ;; If we're looking at an error message, skip forward until we find an
  963. ;; error message with different filename and linenumber, otherwise search
  964. ;; forward until we find any error message.  If we're at bob or eob, wrap.
  965. (defun next-error-line (skip &optional next-file)
  966.   (let ((opoint (point))
  967.     oldinfo errinfo)
  968.     (save-excursion
  969.       (setq oldinfo (compilation-parse-line))
  970.       (cond ((and (eobp) (> skip 0))
  971.          (goto-char (point-min)))
  972.         ((and (bobp) (< skip 0))
  973.          (goto-char (point-max))
  974.          (beginning-of-line))
  975.         (t nil))
  976.       (while (and (or (null (setq errinfo (compilation-parse-line)))
  977.               (if next-file
  978.               (and (equal (nth 0 errinfo) (nth 0 oldinfo))
  979.                    (equal (nth 2 errinfo) (nth 2 oldinfo)))
  980.             (equal errinfo oldinfo)))
  981.           (zerop (forward-line skip)))
  982.     (setq opoint (point))))
  983.     (goto-char opoint)
  984.     (and (boundp 'compilation-debug) compilation-debug (message "%s" errinfo))
  985.     errinfo))
  986.  
  987. (defun next-error (&optional next-file)
  988.   "Visit source code corresponding to the next error message, i.e.
  989. the first one after the line point is on in the compilation buffer.  
  990. The compilation buffer is produced by the \\[compile] command.
  991. With prefix arg, skip to the next file. "
  992.   (interactive "P")
  993.   (setq compilation-last-error-buf
  994.     (or (if (eq major-mode 'compile) (current-buffer))
  995.         compilation-last-error-buf
  996.         compile-last-compilation-buffer
  997.         "*compilation*"))
  998.   (set-buffer (get-buffer compilation-last-error-buf))
  999.   (let ((win (get-buffer-window compilation-last-error-buf)))
  1000.     (if win
  1001.     (select-window win)))
  1002.   (next-error-next-line next-file)
  1003.   (this-error))
  1004.  
  1005. (defun next-error-backward (&optional next-file)
  1006.   "Visit source code corresponding to the previous error message, i.e.
  1007. the first one before the line point is on in the compilation buffer. 
  1008. The compilation buffer is produced by the \\[compile] command.
  1009. With prefix arg, skip to the previous file. "
  1010.   (interactive "P")
  1011.   (setq compilation-last-error-buf
  1012.     (or (if (eq major-mode 'compile) (current-buffer))
  1013.         compilation-last-error-buf
  1014.         compile-last-compilation-buffer
  1015.         "*compilation*"))
  1016.   (set-buffer (get-buffer compilation-last-error-buf))
  1017.   (let ((win (get-buffer-window compilation-last-error-buf)))
  1018.     (if win
  1019.     (select-window win)))
  1020.   (next-error-previous-line next-file)
  1021.   (this-error))
  1022.  
  1023. ;; Parse error msgs, find file or files, and position cursor on the
  1024. ;; appropriate lines.
  1025. ;; The "primary" file is always at the top of the screen.
  1026. ;; The *compilation* buffer is at the bottom, and reduced to
  1027. ;; a smaller height, unless compilation-window-height is nil,
  1028. ;; in which case existing windows are used without resizing them.
  1029. (defun this-error ()
  1030.   "Visit the source code corresponding to the line point is in in the 
  1031. compilation buffer.  This operates on the output from the
  1032. \\[compile] command, and should be invoked from the compilation 
  1033. buffer. "
  1034.   (interactive)
  1035.   (setq compilation-last-error-buf
  1036.     (or (if (eq major-mode 'compile) (current-buffer))
  1037.         compilation-last-error-buf
  1038.         compile-last-compilation-buffer
  1039.         "*compilation*"))
  1040.   (let ((errinfo (compilation-parse-line)))
  1041.     (if (null errinfo)
  1042.     ;; this error will leave one in the compilation buffer.
  1043.     ;; usually this is of benefit - one can now move the up
  1044.     ;; point back up to get back to the last error of interest.
  1045.     (error (concat "No more " compilation-error-type "s"
  1046.              (if (and compilation-process
  1047.                   (eq (process-status compilation-process)
  1048.                       'run))
  1049.                  " yet" "")))
  1050.  
  1051.       (let* ((filename (nth 0 errinfo))
  1052.          (linenumber (nth 1 errinfo))
  1053.          (filename-2 (nth 2 errinfo))
  1054.          (linenumber-2 (nth 3 errinfo)))
  1055.     (if filename
  1056.         (let ((error-marker (compilation-get-marker filename linenumber)))
  1057.           (if error-marker
  1058.           (progn
  1059.             (if compilation-window-height
  1060.             (progn
  1061.               (pop-to-buffer
  1062.                (get-buffer compilation-last-error-buf))
  1063.               (delete-other-windows)
  1064.               (split-window-vertically
  1065.                (- (window-height) 
  1066.                   compilation-window-height))
  1067.               (other-window 1)))
  1068.               ;; recenter refreshes screen, very annoying on slow
  1069.               ;; terminals, so do it ourselves.
  1070.             (if (get-buffer-window compilation-last-error-buf)
  1071.             (progn
  1072.               (save-excursion
  1073.                 (beginning-of-line 
  1074.                  (if compilation-context-lines
  1075.                  (- 1 compilation-context-lines)
  1076.                    (- 2 (/ (window-height) 2))))
  1077.                 (set-window-start (selected-window) (point) t))
  1078.               (pop-to-buffer (marker-buffer error-marker)))
  1079.               (switch-to-buffer (marker-buffer error-marker)))
  1080.             (goto-char (marker-position error-marker))))))
  1081.  
  1082.     (if filename-2                          ; a two file match
  1083.         (progn
  1084.           (set-buffer compilation-last-error-buf)
  1085.           (let ((error-marker
  1086.              (compilation-get-marker filename-2 linenumber-2)))
  1087.         (if error-marker
  1088.             (progn
  1089.               (if (null compilation-window-height)
  1090.               (pop-to-buffer (marker-buffer error-marker))
  1091.             (split-window-vertically nil)
  1092.             (switch-to-buffer-other-window
  1093.              (marker-buffer error-marker)))
  1094.               (goto-char (marker-position error-marker))
  1095.               (other-window 1))))))))))
  1096.  
  1097. ;; Return a marker to the beginning of linenumber in file filename,
  1098. ;; visiting the file with compilation-find-file if necessary.
  1099. ;; Call compilation-find-file-help and return nil if the file can't be found.
  1100. (defun compilation-get-marker (filename linenumber &optional list-hosed)
  1101.   (let* ((file-error-list (assoc filename compilation-error-list))
  1102.      (error-marker (cdr (assoc linenumber file-error-list))))
  1103.  
  1104.     (if (not (and file-error-list error-marker))
  1105.     (cond ((not list-hosed)
  1106.            (message "Parsing error messages...")
  1107.            (compilation-parse-buffer)
  1108.            (message "Parsing error messages...done")
  1109.            (compilation-get-marker filename linenumber 'maybe))
  1110.           ((eq list-hosed 'maybe)
  1111.            (message "Parsing error messages again...")
  1112.            (compilation-forget-errors)
  1113.            (compilation-parse-buffer)
  1114.            (message "Parsing error messages again...done")
  1115.            (compilation-get-marker filename linenumber t))
  1116.           (t (error "Can't parse buffer ")))
  1117.       (if (marker-buffer error-marker)
  1118.       error-marker
  1119.     (save-excursion
  1120.       (if (compilation-find-file filename)
  1121.           (progn
  1122.         (setq file-error-list (assoc filename compilation-error-list))
  1123.         (cdr (assoc linenumber file-error-list)))
  1124.         (if compilation-expert
  1125.         (error "File %s not found." filename))
  1126.         (ding)
  1127.         (compilation-find-file-help filename)
  1128.         nil))))))
  1129.  
  1130. ;; Try to find and open file filename, searching the tags table and/or 
  1131. ;; the path in compilation-vpath if necessary.  Set the markers to errors
  1132. ;; in the file by calling compilation-set-markers.  Returns t if the file
  1133. ;; was found, nil if not (no error).
  1134. (defun compilation-find-file (filename)
  1135.   (catch 'not-found
  1136.     (setq filename
  1137.       (or (if (file-exists-p filename)
  1138.           filename
  1139.         nil)
  1140.           (and compilation-use-tags-table
  1141.            (if (eq compilation-use-tags-table t)
  1142.                t
  1143.              (yes-or-no-p (format "File %s not found, use tags table? "
  1144.                       filename)))
  1145.            (let ((flist (tag-table-files))
  1146.              (fregexp (concat ".*/" (regexp-quote filename) "$")))
  1147.              (while (and flist
  1148.                  (not (string-match fregexp (car flist))))
  1149.                (setq flist (cdr flist)))
  1150.              (car flist)))
  1151.           (if compilation-vpath
  1152.           (let ((dirlist (cond ((listp compilation-vpath)
  1153.                     compilation-vpath)
  1154.                      ((stringp compilation-vpath)
  1155.                       (list compilation-vpath))
  1156.                      (t nil))))
  1157.           (while (and dirlist
  1158.                   (not (file-exists-p 
  1159.                     (expand-file-name filename 
  1160.                               (car dirlist)))))
  1161.             (setq dirlist (cdr dirlist)))
  1162.           (if dirlist
  1163.               (expand-file-name filename (car dirlist))
  1164.             nil)))
  1165.         (throw 'not-found nil)))
  1166.  
  1167.   (let* ((tags (and compilation-use-tags-table
  1168.             (fboundp 'visit-tags-table-locally)
  1169.             tags-file-name))
  1170.      (hook next-error-find-file-hook)
  1171.      (find-file-hooks (cond ((listp hook)
  1172.                  (append find-file-hooks hook))
  1173.                 ((symbolp hook)
  1174.                  (append find-file-hooks
  1175.                      (list hook)))
  1176.                 (t find-file-hooks))))
  1177.     (save-excursion
  1178.       (set-buffer (find-file-noselect filename))
  1179.                     ; If we're using a local tags-table,
  1180.                     ; propagate it to all files we visit.
  1181.       (if tags (visit-tags-table-locally tags))
  1182.       (compilation-set-markers file-error-list)
  1183.       (setq error-marker (cdr (assoc linenumber file-error-list))))
  1184.   t)))
  1185.  
  1186. ;; Pop up a *Help* buffer explaining the file-not-found situation.
  1187. (defun compilation-find-file-help (filename)
  1188.   (save-excursion
  1189.     (set-buffer compilation-last-error-buf)
  1190.     (with-output-to-temp-buffer "*Help*"
  1191.       (princ "************** next-error **************************")
  1192.       (terpri) (terpri)
  1193.       (princ (format "   File %s was not found." filename))
  1194.       (terpri) (terpri)
  1195.       (if compilation-use-tags-table
  1196.       (progn
  1197.         (princ (format
  1198.             "   The current tags file is %s" tags-file-name))
  1199.         (terpri)
  1200.         (princ (substitute-command-keys 
  1201.             "   Use the command \\[visit-tags-table] to change it. ")))
  1202.     (princ "   Searching the tags table is not enabled,")
  1203.     (terpri)
  1204.     (princ (substitute-command-keys "   Use the command \\[compilation-use-tags-table] from the compilation buffer to enable. ")))
  1205.       (terpri) (terpri)
  1206.       (princ (format "   The current search path is %s" compilation-vpath))
  1207.       (terpri)
  1208.       (princ (substitute-command-keys "   Use the command \\[compilation-add-vpath] from the compilation buffer
  1209.    to add directories to this path."))
  1210.       (terpri) (terpri)
  1211.       (princ "   If you don't want to see this message again:  ") (terpri)
  1212.       (princ "      (setq compilation-expert t)") (terpri)
  1213.       (princ "*****************************************************")
  1214.       (print-help-return-message 'message))))
  1215.     
  1216. (defun scan-make ()
  1217.   "Attempt to find the name of the Makefile used by this make run.
  1218. This routine shouln't be used for anything drastic, since it just isn't
  1219. that robust."
  1220.   (cond ((save-excursion
  1221.            (re-search-backward "make[^\n]+-f[ \t]+\\(\\sw\\|\\s_\\)+" nil t))
  1222.          (buffer-substring (match-beginning 1)(match-end 1)))
  1223.         ((file-exists-p "makefile") "makefile")
  1224.         ((file-exists-p "Makefile") "Makefile")
  1225.         (t nil)
  1226.       ))
  1227.  
  1228. (defun scan-s5lint ()
  1229.   "Attempt to find the name of the file that lint was griping about on
  1230. this line.  This routine also has the side-effect of modifying the current
  1231. buffer.  The current line will have the first gripe of a multi-gripe line 
  1232. broken off onto a separate line."
  1233.   (let (retval)
  1234.     (if (save-excursion
  1235.           (re-search-backward "^\\(\\sw\\|\\s_\\|\\s.\\)+\n======+$" nil t))
  1236.         (progn
  1237.           (setq retval (buffer-substring (match-beginning 1)(match-end 1)))
  1238.           (save-excursion
  1239.             (if (re-search-forward ")[ \t]*("
  1240.                                    (save-excursion (end-of-line) (point)) t)
  1241.                 (replace-match ")\n(")))))
  1242.   retval))
  1243.  
  1244. (defun compilation-rsh-arglst (command &optional directory &rest args)
  1245.   "Return a list of arguments to call process, including the program
  1246. name as the first element, to run COMMAND in a subshell on a remote
  1247. host.  If optional DIRECTORY is present, add a \"cd\" command to that
  1248. directory, t means use default directory.
  1249.  
  1250. If COMMAND is of the form \"user@host:command\" then the command
  1251. is run on \"host\" as \"user\"; otherwise, if the buffer file name is
  1252. an ange-ftp style remote pathname then the indicated user and host
  1253. will be used; if neither of these is true then nil is returned. "
  1254.   (let* ((path (and (fboundp 'ange-ftp-ftp-path)
  1255.             (ange-ftp-ftp-path default-directory)))
  1256.      (remote-host (nth 0 path))
  1257.      (logname (nth 1 path)))
  1258.  
  1259.     (and (eq directory t)
  1260.      (setq directory (or (nth 2 path) default-directory)))
  1261.       
  1262.     (if (string-match
  1263.      "^\\(\\([^@: \t\n]*\\)@\\)?\\([^@: \t\n]+\\):\\([^ ]+.*\\)"
  1264.      command)
  1265.     (setq
  1266.      remote-host (substring command (match-beginning 3) (match-end 3))
  1267.      logname (if  (equal (match-beginning 2) (match-end 2))
  1268.              nil
  1269.            (substring command (match-beginning 2) (match-end 2)))
  1270.      command (substring command (match-beginning 4) (match-end 4))))
  1271.     
  1272.     (if remote-host
  1273.     (let ((arglst (list (concat 
  1274.                  (and directory (concat "cd " directory "; "))
  1275.                  command))))
  1276.       ;; Ange says remsh doesn't like -l, so we'll try to avoid it.
  1277.       (and logname
  1278.            (not (string-equal logname (user-login-name)))
  1279.            (setq arglst (cons "-l" (cons logname arglst))))
  1280.       (setq arglst (cons remote-host arglst))
  1281.       (append (cons compilation-remote-shell-file-name arglst)
  1282.           args))
  1283.       nil)))
  1284.  
  1285. (defun compilation-read-dir-name (prompt &optional dir default mustmatch)
  1286.   "Read directory name, prompting with PROMPT and completing in directory
  1287. DIR (optional, default is default-directory).  Optional DEFAULT is the
  1288. default in case user enters the null string.  Fourth arg MUSTMATCH non-nil
  1289. means require existing directory's name. "
  1290.   (completing-read prompt 'compilation-read-dir-name-internal
  1291.            (or dir default-directory) 
  1292.            mustmatch
  1293.            (or default "")))
  1294.  
  1295. (defun compilation-read-dir-name-internal (string dir action)
  1296.   (if (eq action 'lambda)
  1297.       (and (stringp string)
  1298.        (> (length string) 0)
  1299.        (file-directory-p (expand-file-name string dir)))
  1300.     (let* ((name (file-name-nondirectory string))
  1301.        (subdir (or (file-name-directory string) "."))
  1302.        (realdir (expand-file-name subdir dir))
  1303.        accepted)
  1304.       (setq accepted 
  1305.         (delq nil
  1306.           (mapcar (function 
  1307.                (lambda (arg)
  1308.                  (if (string= (file-name-directory arg) arg)
  1309.                  arg)))
  1310.               (file-name-all-completions name realdir))))
  1311.       (if action
  1312.       accepted
  1313.     (if (null accepted)
  1314.         nil
  1315.       (if (and (subset '("./" "../") accepted)
  1316.            (subset accepted '("./" "../")))
  1317.           string
  1318.         (let ((comp-name
  1319.            (try-completion name (mapcar 'list accepted))))
  1320.           (concat (file-name-as-directory subdir) comp-name))))))))
  1321.  
  1322. ;; Stolen from emacs-19, from the tree-dired distribution.
  1323. (or (fboundp 'member)
  1324.     (defun member (x y)
  1325.       "Like memq, but uses `equal' for comparison.
  1326. This is a subr in Emacs 19."
  1327.       (while (and y (not (equal x (car y))))
  1328.     (setq y (cdr y)))
  1329.       y))
  1330.  
  1331. (defun subset (set1 set2)
  1332.   "Returns t if list SET1 is a subset of list SET2, nil otherwise. 
  1333. Membership is tested with member. "
  1334.   (catch 'exit
  1335.     (mapcar (function (lambda (arg)
  1336.             (or (member arg set2)
  1337.                 (throw 'exit nil))))
  1338.         set1)
  1339.     t))
  1340.