comparison lisp/progmodes/compile.el @ 54854:eb5c70ae728c

(compilation-setup): Localize overlay-arrow-position. (compilation-sentinel): Restructure code equivalently. (compilation-next-error): Find message on same line after point if not found before point. (compile-mouse-goto-error): Restore function so that compilation buffer need not be current and use compile-goto-error. (compile-goto-error): Restore function. (next-error): Set overlay-arrow-position. (compilation-forget-errors): Don't localize already local compilation-locs and remove FIXME about refontifying.

54853:429f2746c125

	(let ((file (nth 1 item))
	      (line (nth 2 item))
	      (col (nth 3 item))
	      (type (nth 4 item))
	      end-line end-col fmt)
	  (if (consp file) (setq fmt (cdr file)	  file (car file)))
	  (if (consp line) (setq end-line (cdr line) line (car line)))
	  (if (consp col)	(setq end-col (cdr col)	  col (car col)))
	  
	  (if (functionp line)
	      ;; The old compile.el had here an undocumented hook that
	      ;; allowed `line' to be a function that computed the actual
	      ;; error location.  Let's do our best.
	      `(,(car item)

		    (funcall ',line (list* (match-string ,file)
					   default-directory
					   ',(nthcdr 4 item))
			     ,(if col `(match-string ,col)))))
		(,file compilation-error-face t))
		    
	    `(,(nth 0 item)

	      ,@(when (integerp file)
		  `((,file ,(if (consp type)
				`(compilation-face ',type)

      '("Next Error" . next-error))
    map))

(defvar compilation-minor-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [mouse-2] 'compile-goto-error)
    (define-key map "\C-c\C-c" 'compile-goto-error)
    (define-key map "\C-m" 'compile-goto-error)
    (define-key map "\C-c\C-k" 'kill-compilation)
    (define-key map "\M-n" 'compilation-next-error)
    (define-key map "\M-p" 'compilation-previous-error)

    map)
  "Keymap for `compilation-minor-mode'.")

(defvar compilation-shell-minor-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [mouse-2] 'compile-goto-error)
    (define-key map "\M-\C-m" 'compile-goto-error)
    (define-key map "\M-\C-n" 'compilation-next-error)
    (define-key map "\M-\C-p" 'compilation-previous-error)
    (define-key map "\M-{" 'compilation-previous-file)
    (define-key map "\M-}" 'compilation-next-file)

(defun compilation-setup (&optional minor)
  "Prepare the buffer for the compilation parsing commands to work."
  (make-local-variable 'compilation-current-error)
  (make-local-variable 'compilation-error-screen-columns)
  (setq compilation-last-buffer (current-buffer))
  (set (make-local-variable 'font-lock-extra-managed-props)
       '(directory message help-echo mouse-face debug))
  (set (make-local-variable 'compilation-locs)
       (make-hash-table :test 'equal :weakness 'value))

		    (funcall compilation-exit-message-function
			     process-status exit-status msg)
		  (cons msg exit-status)))
	(omax (point-max))
	(opoint (point)))
    ;; Record where we put the message, so we can ignore it
    ;; later on.
    (goto-char omax)
    (insert ?\n mode-name " " (car status))
    (if (and (numberp compilation-window-height)
	     (zerop compilation-window-height))
	(message "%s" (cdr status)))

	(setq functions (cdr functions))))))

;; Called when compilation process changes state.
(defun compilation-sentinel (proc msg)
  "Sentinel for compilation buffers."
  (let ((buffer (process-buffer proc)))
    (if (memq (process-status proc) '(signal exit))
	(progn
	  (if (null (buffer-name buffer))
	      ;; buffer killed
	      (set-process-buffer proc nil)
	    (with-current-buffer buffer
	      ;; Write something in the compilation buffer
	      ;; and hack its mode line.
	      (compilation-handle-exit (process-status proc)
				       (process-exit-status proc)
				       msg)
	      ;; Since the buffer and mode line will show that the
	      ;; process is dead, we can delete it now.  Otherwise it
	      ;; will stay around until M-x list-processes.
	      (delete-process proc)))
	  (setq compilation-in-progress (delq proc compilation-in-progress))
	  ))))

(defun compilation-filter (proc string)
  "Process filter for compilation buffers.
Just inserts the text, but uses `insert-before-markers'."
  (if (buffer-name (process-buffer proc))

	(unless (or msg			; find message near here
		    (setq msg (get-text-property (max (1- pt) (point-min))
						 'message)))
	  (setq pt (previous-single-property-change pt 'message nil
						    (line-beginning-position)))
	  (if pt	 ; FIXME: `pt' can never be nil here anyway.  --stef
	      (setq msg (get-text-property (max (1- pt) (point-min)) 'message))
	    (setq pt (next-single-property-change pt 'message nil
						  (line-end-position)))
	    (if pt	 ; FIXME: `pt' can never be nil here anyway.  --stef
		(setq msg (get-text-property pt 'message))
	      (setq pt (point)))))
      (setq last (nth 2 (car msg)))
      (if (>= n 0)
	  (compilation-loop > next-single-property-change 1-
			    (if (get-buffer-process (current-buffer))
				"No more %ss yet"

  (let ((buffer (compilation-find-buffer)))
    (if (get-buffer-process buffer)
	(interrupt-process (get-buffer-process buffer))
      (error "The compilation process is not running"))))

(defalias 'compile-mouse-goto-error 'compile-goto-error)

(defun compile-goto-error (&optional event)
  "Visit the source for the error message at point.
Use this command in a compilation log buffer.  Sets the mark at point there."
  (interactive (list last-input-event))
  (or (compilation-buffer-p (current-buffer))
      (error "Not in a compilation buffer"))
  (let* ((loc (event-end event))
	 (pos (posn-point loc)))
    (with-selected-window (posn-window loc)
      (if (get-text-property pos 'directory)
	  (dired-other-window (car (get-text-property pos 'directory)))
	(push-mark)
	(setq compilation-current-error pos)
	(next-error 0)))))

;; Return a compilation buffer.
;; If the current buffer is a compilation buffer, return it.
;; If compilation-last-buffer is set to a live buffer, use that.
;; Otherwise, look for a compilation buffer and signal an error

	 (loc (compilation-next-error (or n 1) nil
				      (or compilation-current-error (point-min))))
	 (end-loc (nth 2 loc))
	 (marker (point-marker)))
    (setq compilation-current-error (point-marker)
	  loc (car loc))
    ;; If loc contains no marker, no error in that file has been visited.  If
    ;; the marker is invalid the buffer has been killed.  So, recalculate all
    ;; markers for that file.
    (unless (and (nthcdr 3 loc) (marker-buffer (nth 3 loc)))

  nil)

(defun compilation-forget-errors ()
  ;; In case we hit the same file/line specs, we want to recompute a new
  ;; marker for them, so flush our cache.
  (set (make-local-variable 'compilation-locs)
       (make-hash-table :test 'equal :weakness 'value))
  ;; FIXME: the old code reset the directory-stack, so maybe we should
  ;; put a `directory change' marker of some sort, but where?  -stef
  ;; 
  ;; FIXME: The old code moved compilation-current-error (which was
  ;; virtually represented by a mix of compilation-parsing-end and
  ;; compilation-error-list) to point-min, but that was only meaningful for
  ;; the internal uses of compilation-forget-errors: all calls from external
  ;; packages seem to be followed by a move of compilation-parsing-end to
  ;; something equivalent to point-max.  So we speculatively move
  ;; compilation-current-error to point-max (since the external package
  ;; won't know that it should do it).  --stef
  (setq compilation-current-error (point-max))
  ;; FIXME the old code removed the mouse-face and help-echo properties.
  ;; Should we font-lock-fontify-buffer?  --stef
  )

(provide 'compile)

;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
;;; compile.el ends here

54854:eb5c70ae728c

	(let ((file (nth 1 item))
	      (line (nth 2 item))
	      (col (nth 3 item))
	      (type (nth 4 item))
	      end-line end-col fmt)
	  (if (consp file)	(setq fmt (cdr file)	  file (car file)))
	  (if (consp line)	(setq end-line (cdr line) line (car line)))
	  (if (consp col)	(setq end-col (cdr col)	  col (car col)))

	  (if (functionp line)
	      ;; The old compile.el had here an undocumented hook that
	      ;; allowed `line' to be a function that computed the actual
	      ;; error location.  Let's do our best.
	      `(,(car item)

		    (funcall ',line (list* (match-string ,file)
					   default-directory
					   ',(nthcdr 4 item))
			     ,(if col `(match-string ,col)))))
		(,file compilation-error-face t))

	    `(,(nth 0 item)

	      ,@(when (integerp file)
		  `((,file ,(if (consp type)
				`(compilation-face ',type)

      '("Next Error" . next-error))
    map))

(defvar compilation-minor-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [mouse-2] 'compile-mouse-goto-error)
    (define-key map "\C-c\C-c" 'compile-goto-error)
    (define-key map "\C-m" 'compile-goto-error)
    (define-key map "\C-c\C-k" 'kill-compilation)
    (define-key map "\M-n" 'compilation-next-error)
    (define-key map "\M-p" 'compilation-previous-error)

    map)
  "Keymap for `compilation-minor-mode'.")

(defvar compilation-shell-minor-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [mouse-2] 'compile-mouse-goto-error)
    (define-key map "\M-\C-m" 'compile-goto-error)
    (define-key map "\M-\C-n" 'compilation-next-error)
    (define-key map "\M-\C-p" 'compilation-previous-error)
    (define-key map "\M-{" 'compilation-previous-file)
    (define-key map "\M-}" 'compilation-next-file)

(defun compilation-setup (&optional minor)
  "Prepare the buffer for the compilation parsing commands to work."
  (make-local-variable 'compilation-current-error)
  (make-local-variable 'compilation-error-screen-columns)
  (make-local-variable 'overlay-arrow-position)
  (setq compilation-last-buffer (current-buffer))
  (set (make-local-variable 'font-lock-extra-managed-props)
       '(directory message help-echo mouse-face debug))
  (set (make-local-variable 'compilation-locs)
       (make-hash-table :test 'equal :weakness 'value))

		    (funcall compilation-exit-message-function
			     process-status exit-status msg)
		  (cons msg exit-status)))
	(omax (point-max))
	(opoint (point)))
    ;; Record where we put the message, so we can ignore it later on.
    (goto-char omax)
    (insert ?\n mode-name " " (car status))
    (if (and (numberp compilation-window-height)
	     (zerop compilation-window-height))
	(message "%s" (cdr status)))

	(setq functions (cdr functions))))))

;; Called when compilation process changes state.
(defun compilation-sentinel (proc msg)
  "Sentinel for compilation buffers."
  (if (memq (process-status proc) '(exit signal))
      (let ((buffer (process-buffer proc)))
	(if (null (buffer-name buffer))
	    ;; buffer killed
	    (set-process-buffer proc nil)
	  (with-current-buffer buffer
	    ;; Write something in the compilation buffer
	    ;; and hack its mode line.
	    (compilation-handle-exit (process-status proc)
				     (process-exit-status proc)
				     msg)
	    ;; Since the buffer and mode line will show that the
	    ;; process is dead, we can delete it now.  Otherwise it
	    ;; will stay around until M-x list-processes.
	    (delete-process proc)))
	(setq compilation-in-progress (delq proc compilation-in-progress)))))

(defun compilation-filter (proc string)
  "Process filter for compilation buffers.
Just inserts the text, but uses `insert-before-markers'."
  (if (buffer-name (process-buffer proc))

	(unless (or msg			; find message near here
		    (setq msg (get-text-property (max (1- pt) (point-min))
						 'message)))
	  (setq pt (previous-single-property-change pt 'message nil
						    (line-beginning-position)))
	  (unless (setq msg (get-text-property (max (1- pt) (point-min)) 'message))
	    (setq pt (next-single-property-change pt 'message nil
						  (line-end-position)))
	    (or (setq msg (get-text-property pt 'message))
		(setq pt (point)))))
      (setq last (nth 2 (car msg)))
      (if (>= n 0)
	  (compilation-loop > next-single-property-change 1-
			    (if (get-buffer-process (current-buffer))
				"No more %ss yet"

  (let ((buffer (compilation-find-buffer)))
    (if (get-buffer-process buffer)
	(interrupt-process (get-buffer-process buffer))
      (error "The compilation process is not running"))))

(defun compile-mouse-goto-error (event)
  "Visit the source for the error message the mouse is pointing at."
  (interactive "e")
  (mouse-set-point event)
  (compile-goto-error))

(defun compile-goto-error ()
  "Visit the source for the error message point is on.
Use this command in a compilation log buffer.  Sets the mark at point there."
  (interactive)
  (or (compilation-buffer-p (current-buffer))
      (error "Not in a compilation buffer"))
  (if (get-text-property (point) 'directory)
      (dired-other-window (car (get-text-property (point) 'directory)))
    (push-mark)
    (setq compilation-current-error (point))
    (next-error 0)))

;; Return a compilation buffer.
;; If the current buffer is a compilation buffer, return it.
;; If compilation-last-buffer is set to a live buffer, use that.
;; Otherwise, look for a compilation buffer and signal an error

	 (loc (compilation-next-error (or n 1) nil
				      (or compilation-current-error (point-min))))
	 (end-loc (nth 2 loc))
	 (marker (point-marker)))
    (setq compilation-current-error (point-marker)
	  overlay-arrow-position
	    (if (bolp)
		compilation-current-error
	      (save-excursion
		(beginning-of-line)
		(point-marker)))
	  loc (car loc))
    ;; If loc contains no marker, no error in that file has been visited.  If
    ;; the marker is invalid the buffer has been killed.  So, recalculate all
    ;; markers for that file.
    (unless (and (nthcdr 3 loc) (marker-buffer (nth 3 loc)))

  nil)

(defun compilation-forget-errors ()
  ;; In case we hit the same file/line specs, we want to recompute a new
  ;; marker for them, so flush our cache.
  (setq compilation-locs (make-hash-table :test 'equal :weakness 'value))
  ;; FIXME: the old code reset the directory-stack, so maybe we should
  ;; put a `directory change' marker of some sort, but where?  -stef
  ;;
  ;; FIXME: The old code moved compilation-current-error (which was
  ;; virtually represented by a mix of compilation-parsing-end and
  ;; compilation-error-list) to point-min, but that was only meaningful for
  ;; the internal uses of compilation-forget-errors: all calls from external
  ;; packages seem to be followed by a move of compilation-parsing-end to
  ;; something equivalent to point-max.  So we speculatively move
  ;; compilation-current-error to point-max (since the external package
  ;; won't know that it should do it).  --stef
  (setq compilation-current-error (point-max)))

(provide 'compile)

;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
;;; compile.el ends here