home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #3 / NN_1993_3.iso / spool / comp / emacs / 4056 < prev    next >
Encoding:
Text File  |  1993-01-24  |  15.8 KB  |  475 lines
  1. Newsgroups: comp.emacs
  2. Path: sparky!uunet!panther!mothost!merlin.dev.cdx.mot.com!fendahl.dev.cdx.mot.com!mcook
  3. From: mcook@fendahl.dev.cdx.mot.com (Michael Cook)
  4. Subject: enhancements to compile.el
  5. Message-ID: <mcook.727827362@fendahl.dev.cdx.mot.com>
  6. Sender: news@merlin.dev.cdx.mot.com (Merlin News System)
  7. Nntp-Posting-Host: fendahl.dev.cdx.mot.com
  8. Organization: Motorola Codex, Canton, Massachusetts
  9. Date: Sat, 23 Jan 1993 22:16:02 GMT
  10. Lines: 463
  11.  
  12. I've made some enhancements to compile.el to overcome some of its limitations.
  13.  
  14.  - Added (previous-error)
  15.  - Added (rename-compilation-buffer) and made most variables buffer-local
  16.    (to the *compilation* buffer) so that you can have multiple compilation
  17.    processes active simultaneously.
  18.  - "No more errors yet" also moves window-start to EOF (so that it becomes
  19.    easier to see that new output is available).
  20.  - (grep) remembers its last command, just like (compile) always did.
  21.  
  22. Bug fixes:
  23.  - Won't try to read a file named "" (the null string).
  24.  - Gracefully handles the situation where a buffer that had markers in
  25.    it has been deleted.
  26.  
  27. Michael.
  28.  
  29. #!/bin/sh
  30. # to extract, remove the header and type "sh filename"
  31. if `test ! -s ./compile.el`
  32. then
  33. echo "writing ./compile.el"
  34. cat > ./compile.el << '\End\Of\Shar\'
  35. ;; Run compiler as inferior of Emacs, and parse its error messages.
  36. ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
  37.  
  38. ;; This file is part of GNU Emacs.
  39.  
  40. ;; GNU Emacs is distributed in the hope that it will be useful,
  41. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  42. ;; accepts responsibility to anyone for the consequences of using it
  43. ;; or for whether it serves any particular purpose or works at all,
  44. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  45. ;; License for full details.
  46.  
  47. ;; Everyone is granted permission to copy, modify and redistribute
  48. ;; GNU Emacs, but only under the conditions described in the
  49. ;; GNU Emacs General Public License.   A copy of this license is
  50. ;; supposed to have been given to you along with GNU Emacs so you
  51. ;; can know your rights and responsibilities.  It should be in a
  52. ;; file named COPYING.  Among other things, the copyright notice
  53. ;; and this notice must be preserved on all copies.
  54.  
  55. ;;
  56. ;; mcook@merlin.dev.mot.com
  57. ;; January 22, 1993
  58. ;;
  59. ;; Enhancements:
  60. ;; - Added (previous-error)
  61. ;; - Added (rename-compilation-buffer) and made most variables buffer-local
  62. ;;   (to the *compilation* buffer) so that you can have multiple compilation
  63. ;;   processes active simultaneously.
  64. ;; - "No more errors yet" also moves window-start to EOF (so that it becomes
  65. ;;   easier to see that new output is available).
  66. ;; - (grep) remembers its last command, just like (compile) always did.
  67. ;;
  68. ;; Bug fixes:
  69. ;; - Won't try to read a file named "" (the null string).
  70. ;; - Gracefully handles the situation where a buffer that had markers in
  71. ;;   it has been deleted.
  72. ;;
  73.  
  74. (provide 'compile)
  75.  
  76. (defvar compilation-process nil
  77.   "Process created by compile command, or nil if none exists now.
  78. Note that the process may have been \"deleted\" and still
  79. be the value of this variable.")
  80. (make-variable-buffer-local 'compilation-process)
  81.  
  82. (defvar compilation-error-list nil
  83.   "List of error message descriptors for visiting erring functions.
  84. Each error descriptor is a list of length two.
  85. Its car is a marker pointing to an error message.
  86. Its cadr is a marker pointing to the text of the line the message is about,
  87.   or nil if that is not interesting.
  88. The value may be t instead of a list;
  89. this means that the buffer of error messages should be reparsed
  90. the next time the list of errors is wanted.")
  91. (make-variable-buffer-local 'compilation-error-list)
  92.  
  93. (defvar compilation-error-index nil
  94.   "Index into compilation-error-list of the current error.")
  95. (make-variable-buffer-local 'compilation-error-index)
  96.  
  97. (defvar compilation-parsing-end nil
  98.   "Position of end of buffer when last error messages parsed.")
  99. (make-variable-buffer-local 'compilation-parsing-end)
  100.  
  101. (defvar compilation-error-message nil
  102.   "Message to print when no more matches for compilation-error-regexp are found")
  103. (make-variable-buffer-local 'compilation-error-message)
  104.  
  105. (defvar compilation-error-regexp
  106.   "\\([^ \n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\)"
  107.   "Regular expression for filename/linenumber in error in compilation log.")
  108.  
  109. (defun compile (command)
  110.   "Compile the program including the current buffer.  Default: run make.
  111. Runs COMMAND, a shell command, in a separate process asynchronously
  112. with output going to the buffer *compilation*.
  113. You can then use the command \\[next-error] to find the next error message
  114. and move to the source code that caused it."
  115.   (interactive (list (read-string "Compile command: " compile-command)))
  116.   (setq compile-command command)
  117.   (compile1 compile-command "errors"))
  118.  
  119. (defvar grep-command "grep -n "
  120.   "*Last shell command used to do a grep class command;
  121. default for next grep class command.")
  122.  
  123. (defun grep (command)
  124.   "Run grep, with user-specified args, and collect output in a buffer.
  125. While grep runs asynchronously, you can use the \\[next-error] command
  126. to find the text that grep hits refer to."
  127.   (interactive (list (read-string "Run grep (with args) " grep-command)))
  128.   (setq grep-command command)
  129.   (require 'compile)
  130.   (compile1 (concat command " /dev/null") "grep hits" "grep"))
  131.  
  132. (defun compile1 (command error-message &optional name-of-mode)
  133.   (save-some-buffers)
  134.   (let ((obuf (current-buffer))
  135.     (this-dir default-directory)
  136.     (cbuf (get-buffer-create "*compilation*")))
  137.     (unwind-protect
  138.     (progn
  139.       (set-buffer cbuf)
  140.  
  141.       (if compilation-process
  142.           (if (or (not (eq (process-status compilation-process) 'run))
  143.               (yes-or-no-p
  144.                "A compilation process is running; kill it? "))
  145.           (condition-case ()
  146.               (let ((comp-proc compilation-process))
  147.             (interrupt-process comp-proc)
  148.             (sit-for 1)
  149.             (delete-process comp-proc))
  150.             (error nil))
  151.         (error "Cannot have two compilation processes")))
  152.       (setq compilation-process nil)
  153.  
  154.       ;;
  155.       ;; Setup the *compilation* buffer.
  156.       ;;
  157.       (buffer-flush-undo cbuf)
  158.       (compilation-forget-errors)
  159.       (setq compilation-error-list t)
  160.       (setq compilation-error-index nil)
  161.       (setq compilation-error-message error-message)
  162.       (setq mode-name (or name-of-mode "Compilation"))
  163.       (setq default-directory this-dir)
  164.       (with-output-to-temp-buffer "*compilation*"
  165.         (princ "cd ")
  166.         (princ this-dir)
  167.         (terpri)
  168.         (princ command)
  169.         (terpri))
  170.       ;;
  171.       ;; For all windows displaying the *compilation* buffer, set the
  172.       ;; window-start and window-point attributes.
  173.       ;;
  174.       (let* ((orig-win (selected-window))
  175.          (this-win orig-win)
  176.          (pmin (point-min))
  177.          (pmax (point-max)))
  178.         (while (progn
  179.              (if (eq (window-buffer this-win) cbuf)
  180.              (progn
  181.                (set-window-point this-win pmax)
  182.                (set-window-start this-win pmin)))
  183.              (setq this-win (next-window this-win t))
  184.              (not (eq this-win orig-win)))))
  185.  
  186.       ;;
  187.       ;; Start the process.
  188.       ;;
  189.       (setq compilation-process
  190.         (start-process "compilation" cbuf
  191.                    shell-file-name
  192.                    "-c" (concat "exec " command)))
  193.       (set-process-sentinel compilation-process 'compilation-sentinel)
  194.  
  195.       ;; Make log buffer's mode line show process state
  196.       (setq mode-line-process '(": %s")))
  197.       (set-buffer obuf))))
  198.  
  199. (defun compilation-sentinel (proc msg)
  200.   ;;
  201.   ;; Called when compilation process changes state.
  202.   ;;
  203.   (cond ((null (buffer-name (process-buffer proc)))
  204.      ;;
  205.      ;; buffer killed
  206.      ;;
  207.      (set-process-buffer proc nil))
  208.     ((memq (process-status proc) '(signal exit))
  209.      (let* ((obuf (current-buffer))
  210.         (omax (point-max))
  211.         (opoint (point)))
  212.        (unwind-protect
  213.            (progn
  214.          ;;
  215.          ;; Write something in *compilation* and hack its mode line,
  216.          ;;
  217.          (set-buffer (process-buffer proc))
  218.          (setq compilation-process nil)
  219.          (goto-char (point-max))
  220.          (insert ?\n mode-name " " msg)
  221.          (forward-char -1)
  222.          (insert " at "
  223.              (substring (current-time-string) 0 -5))
  224.          (forward-char 1)
  225.          (if (< opoint omax)
  226.              (goto-char opoint))
  227.          (setq mode-line-process
  228.                (concat ": "
  229.                    (symbol-name (process-status proc))))
  230.          ;; Force mode line redisplay soon
  231.          (set-buffer-modified-p (buffer-modified-p))
  232.          ;;
  233.          ;; If buffer and mode line will show that the process is
  234.          ;; dead, we can delete it now.  Otherwise it will stay around
  235.          ;; until M-x list-processes.
  236.          ;;
  237.          (delete-process proc))
  238.          (set-buffer obuf))))))
  239.  
  240. (defun kill-compilation ()
  241.   "Kill the process made by the \\[compile] command."
  242.   (interactive)
  243.   (save-excursion
  244.     (set-buffer "*compilation*")
  245.     (if compilation-process
  246.     (interrupt-process compilation-process))))
  247.  
  248. (defun kill-grep ()
  249.   "Kill the process made by the \\[grep] command."
  250.   (interactive)
  251.   (save-excursion
  252.     (set-buffer "*compilation*")
  253.     (if compilation-process
  254.     (interrupt-process compilation-process))))
  255.  
  256. (defun next-error (&optional argp)
  257.   "Visit next compilation error message and corresponding source code.  This
  258. operates on the output from the \\[compile] command.
  259. If all preparsed error messages have been processed, the error message buffer
  260. is checked for new ones.  A non-nil argument (prefix arg, if interactive)
  261. means reparse the error message buffer and start at the first error."
  262.   (interactive "P")
  263.   (compilation-next-error argp 1))
  264.  
  265. (defun previous-error (&optional argp)
  266.   "See \\[next-error]."
  267.   (interactive "P")
  268.   (compilation-next-error argp -1))
  269.  
  270. (defun compilation-next-error (restart direction)
  271.   "See \\[next-error]."
  272.   (let ((obuf (current-buffer)))
  273.     (unwind-protect
  274.       (progn
  275.     (set-buffer "*compilation*")
  276.     (if (or (eq compilation-error-list t)
  277.         restart)
  278.         (compilation-forget-errors))
  279.     (let ((i compilation-error-index))
  280.       (while (progn
  281.            (setq i (if i (+ i direction) 0))
  282.            (if (< i 0)
  283.                (error (concat "No previous "
  284.                       compilation-error-message)))
  285.            (let ((n (length compilation-error-list)))
  286.              (if (< i n)
  287.              nil
  288.                (set-buffer-modified-p nil)
  289.                (compilation-parse-errors)
  290.                (or (> (length compilation-error-list) n)
  291.                (error (concat
  292.                    "No more "
  293.                    compilation-error-message
  294.                    (if (and compilation-process
  295.                         (eq (process-status
  296.                          compilation-process) 'run))
  297.                        (let ((w (get-buffer-window
  298.                          (current-buffer))))
  299.                      (if (not w)
  300.                          nil
  301.                        (set-window-point w (point-max))
  302.                        (set-window-start w (point-max)))
  303.                      " yet")))))))
  304.            (not (marker-buffer
  305.              (nth 1 (nth i compilation-error-list))))))
  306.       (setq compilation-error-index i))
  307.     (let ((e (nth compilation-error-index compilation-error-list)))
  308.       (if (car (cdr e))
  309.           (progn
  310.         (setq obuf (marker-buffer (car (cdr e))))
  311.         (switch-to-buffer obuf)
  312.         (goto-char (car (cdr e)))))
  313.       (let* ((pop-up-windows t)
  314.          (w (display-buffer (marker-buffer (car e)))))
  315.         (set-window-point w (car e))
  316.         (set-window-start w (car e)))))
  317.       (set-buffer obuf))))
  318.  
  319. ;;
  320. ;; Set compilation-error-list to nil, and unchain the markers that point to
  321. ;; the error messages and their text, so that they no longer slow down gap
  322. ;; motion.  This would happen anyway at the next garbage collection, but it is
  323. ;; better to do it right away.
  324. ;;
  325. (defun compilation-forget-errors ()
  326.   (if (eq compilation-error-list t)
  327.       (setq compilation-error-list nil))
  328.   (while compilation-error-list
  329.     (let ((e (car compilation-error-list)))
  330.       (set-marker (car e) nil)
  331.       (if (car (cdr e))
  332.       (set-marker (car (cdr e)) nil)))
  333.     (setq compilation-error-list (cdr compilation-error-list)))
  334.   (setq compilation-error-index nil)
  335.   (setq compilation-parsing-end 1))
  336.  
  337. (defun compilation-parse-errors ()
  338.   "Parse the current buffer as error messages.  This makes a list of error
  339. descriptors, compilation-error-list.  For each source-file, line-number pair
  340. in the buffer, the source file is read in, and the text location is saved in
  341. compilation-error-list.  The function next-error, assigned to
  342. \\[next-error], takes the next error off the list and visits its location."
  343.   (message "Parsing error messages...")
  344.   (let (text-buffer last-filename last-linenum error-list)
  345.     ;;
  346.     ;; Don't reparse messages already seen at last parse.
  347.     ;;
  348.     (goto-char compilation-parsing-end)
  349.     ;;
  350.     ;; Don't parse the first two lines as error messages.  This matters for
  351.     ;; grep.
  352.     ;;
  353.     (if (bobp)
  354.     (forward-line 2))
  355.     (while (re-search-forward compilation-error-regexp nil t)
  356.       (let (linenum filename error-marker)
  357.     ;;
  358.     ;; Extract file name and line number from error message.
  359.     ;;
  360.     (save-restriction
  361.       (narrow-to-region (match-beginning 0) (match-end 0))
  362.       (goto-char (point-max))
  363.       (skip-chars-backward "[0-9]")
  364.       ;;
  365.       ;; If it's a lint message, use the last file(linenum) on the line.
  366.       ;; Normally we use the first on the line.
  367.       ;;
  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.       ;;
  378.       ;; Are we looking at a "filename-first" or "line-number-first" form?
  379.       ;;
  380.       (if (looking-at "[0-9]")
  381.           (progn
  382.         (setq linenum (read (current-buffer)))
  383.         (goto-char (point-min)))
  384.         ;;
  385.         ;; Line number at start, file name at end.
  386.         ;;
  387.         (goto-char (point-min))
  388.         (setq linenum (read (current-buffer)))
  389.         (goto-char (point-max))
  390.         (skip-chars-backward "^ \t\n"))
  391.       (setq filename (compilation-grab-filename)))
  392.     ;; Locate the erring file and line.
  393.     (if (or (and (equal filename last-filename)
  394.              (= linenum last-linenum))
  395.         (zerop (length filename)))
  396.         nil
  397.       (beginning-of-line 1)
  398.       (setq error-marker (point-marker))
  399.       ;; text-buffer gets the buffer containing this error's file.
  400.       (if (equal filename last-filename)
  401.           nil
  402.         (setq last-filename filename
  403.           last-linenum 0)
  404.         (setq text-buffer
  405.           (and (file-exists-p filename)
  406.                (find-file-noselect filename))))
  407.       (if (not text-buffer)
  408.           nil
  409.         ;; Go to that buffer and find the erring line.
  410.         (setq error-list
  411.           (cons (save-excursion
  412.               (set-buffer text-buffer)
  413.               (if (zerop last-linenum)
  414.                   (progn
  415.                 (goto-char 1)
  416.                 (setq last-linenum 1)))
  417.               (forward-line (- linenum last-linenum))
  418.               (setq last-linenum linenum)
  419.               (list error-marker (point-marker)))
  420.             error-list))
  421.         (message "Parsing error messages...%d" (length error-list))))
  422.     (forward-line 1)))
  423.     (setq compilation-parsing-end (point-max))
  424.     (setq compilation-error-list
  425.       (nconc compilation-error-list (nreverse error-list))))
  426.   (message "Parsing error messages...done"))
  427.  
  428. (defun compilation-grab-filename ()
  429.   "Return a string which is a filename, starting at point.
  430. Ignore quotes and parentheses around it, as well as trailing colons."
  431.   (if (eq (following-char) ?\")
  432.       (save-restriction
  433.     (narrow-to-region (point)
  434.               (progn (forward-sexp 1) (point)))
  435.     (goto-char (point-min))
  436.     (read (current-buffer)))
  437.     (buffer-substring (point)
  438.               (progn
  439.             (skip-chars-forward "^ :,\n\t(")
  440.             (point)))))
  441.  
  442. (defun rename-compilation-buffer (arg)
  443.   "Rename the *compilation* buffer (e.g. to *compilation-1*) so that
  444. a second compilation process may be started.  If ARG is non-nil,
  445. rename the current buffer to *compilation*."
  446.   (interactive "P")
  447.   (let ((buf (get-buffer "*compilation*")))
  448.     (if buf
  449.     (let ((i 1) new-name)
  450.       (while (get-buffer (setq new-name (concat "*compilation-" i "*")))
  451.         (setq i (1+ i)))
  452.       (save-excursion
  453.         (set-buffer buf)
  454.         (rename-buffer new-name))
  455.       (message "Buffer *compilation* has been renamed %s" new-name))
  456.       (or arg
  457.       (error "There is no *compilation* buffer."))))
  458.   (if (not arg)
  459.       nil
  460.     (or (not buffer-file-name)
  461.     (y-or-n-p (format
  462.            "Buffer \"%s\" is attached to a file; rename anyhow? "
  463.            (buffer-name)))
  464.     (error "Buffer \"%s\" is attached to a file." (buffer-name)))
  465.     (rename-buffer "*compilation*"))
  466.   (set-buffer-modified-p (buffer-modified-p))) ;force modeline update
  467.  
  468. (define-key ctl-x-map "`" 'next-error)
  469. \End\Of\Shar\
  470. else
  471.   echo "will not over write ./compile.el"
  472. fi
  473. echo "Finished archive 1 of 1"
  474. exit
  475.