Re: Overlay arrow in *compilation* and *grep* buffers

[Nick Roberts]

Richard Stallman writes:
 >      > 1. New defcustom compilation-current-message-highlight.
 > 
 > Please don't add this option.  It isn't necessary to fix a problem.

Here's a patch that will hopefully keep everyone happy ;-)

1) No new option.

1) Overlay arrow and no scrolling with left-hand fringe
   e.g. graphical terminal.

2) No overlay arrow and scrolling with no left-hand fringe 
   e.g. text terminal.

The best way to test for a left-hand fringe (absence of) seems to be:

  (if (equal (car (window-fringes)) 0)...

Its about the simplest patch I could think of that meets the requirements.
Shall I install it?

Nick


*** /home/nick/emacs/lisp/progmodes/compile.el.~1.353~  2005-05-15 
14:40:42.000000000 +1200
--- /home/nick/emacs/lisp/progmodes/compile.el  2005-05-15 14:42:19.000000000 
+1200
***************
*** 1247,1254 ****
    (make-local-variable 'compilation-messages-start)
    (make-local-variable 'compilation-error-screen-columns)
    (make-local-variable 'overlay-arrow-position)
!   (set (make-local-variable 'overlay-arrow-string)
!        (if (display-graphic-p) "=>" ""))
    (setq next-error-overlay-arrow-position nil)
    (add-hook 'kill-buffer-hook
            (lambda () (setq next-error-overlay-arrow-position nil)) nil t)
--- 1247,1253 ----
    (make-local-variable 'compilation-messages-start)
    (make-local-variable 'compilation-error-screen-columns)
    (make-local-variable 'overlay-arrow-position)
!   (set (make-local-variable 'overlay-arrow-string) "")
    (setq next-error-overlay-arrow-position nil)
    (add-hook 'kill-buffer-hook
            (lambda () (setq next-error-overlay-arrow-position nil)) nil t)
***************
*** 1575,1595 ****
        (setcdr loc (list line file marker)))
      loc))
  
! (defcustom compilation-context-lines 0
    "*Display this many lines of leading context before message.
! If nil, don't scroll the compilation output window."
    :type '(choice integer (const :tag "No window scrolling" nil))
    :group 'compilation
    :version "22.1")
  
  (defsubst compilation-set-window (w mk)
    "Align the compilation output window W with marker MK near top."
!   (if (integerp compilation-context-lines)
        (set-window-start w (save-excursion
!                             (goto-char mk)
!                             (beginning-of-line (- 1 
compilation-context-lines))
!                             (point))))
!   (set-window-point w mk))
  
  (defvar next-error-highlight-timer)
  
--- 1574,1602 ----
        (setcdr loc (list line file marker)))
      loc))
  
! (defcustom compilation-context-lines nil
    "*Display this many lines of leading context before message.
! If nil, don't scroll the compilation output window unless there
! is no left-hand fringe. In this case, the message displays at the
! top of the window because no overlay arrow is present."
    :type '(choice integer (const :tag "No window scrolling" nil))
    :group 'compilation
    :version "22.1")
  
  (defsubst compilation-set-window (w mk)
    "Align the compilation output window W with marker MK near top."
!   (if (equal (car (window-fringes)) 0)
        (set-window-start w (save-excursion
!                           (goto-char mk)
!                           (beginning-of-line 1)
!                           (point)))
!     (if (integerp compilation-context-lines)
!       (set-window-start w (save-excursion
!                             (goto-char mk)
!                             (beginning-of-line
!                              (- 1 compilation-context-lines))
!                             (point)))))
!     (set-window-point w mk))
  
  (defvar next-error-highlight-timer)