current-line.el
Hi,
I find useful sometimes to have the current line highlighted in some
major modes (vm-summary-mode, buffer-menu-mode, dired-mode,
compilation-mode, etc). If there is no code in XEmacs that does that
(I looked, but you never know :-)), the following will work fine, with
both XEmacs and GNU Emacs.
I would appreciate any comments. Would it make sense to have
different faces for different modes?
Regards,
Tudor
;; current-line.el -- Display the current line with a distinctive face.
;; Author: Tudor Hulubei <tudor(a)gnu.org>
;; Maintainer: Tudor Hulubei <tudor(a)gnu.org>
;;
;; Created: April 1999
;; Keywords: current line
;; Last modified: $Date: 1999/04/24 19:13:49 $ by $Author: tudor $
;; current-line.el is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.
;;
;; current-line.el is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; Documentation:
;;
;; In order to activate the `current-line' mode in the major modes
;; defined in `current-line-major-modes' you would have to put the
;; following code in your .emacs:
;;
;; (require 'current-line)
;; (current-line-mode t)
;;
;; `current-line-major-modes' can be modified to include other modes
;; as well. To deactivate the mode, execute (current-line-mode nil).
(provide 'current-line)
(defgroup current-line nil
"Variables dealing with the display of the current line."
:group 'environment)
(defface current-line-face
'((((class color)) (:foreground "white" :background "blue")))
"Face used to highlight the current line."
:group 'current-line)
(defcustom current-line-major-modes
(list 'Buffer-menu-mode
'dired-mode
'compilation-mode
'vm-summary-mode
'rmail-summary-mode)
"A list of major modes in which the current line is displayed with a
distinctive face. Modify this as needed."
:group 'current-line)
;; Internal variables.
(defvar current-line-extent/overlay nil)
;; Hide the difference between GNU Emacs (which uses overlays) and
;; XEmacs (which uses extents). XEmacs supports overlays too, maybe
;; it would be ok to use overlays for both Emacsen.
(defun clm-make-extent/overlay (begin end)
(if (fboundp 'make-extent)
(make-extent begin end)
(if (fboundp 'make-overlay)
(make-overlay begin end))))
(defun clm-set-extent/overlay-property (extent/overlay property value)
(if (fboundp 'make-extent)
(set-extent-property extent/overlay property value)
(if (fboundp 'make-overlay)
(overlay-put extent/overlay property value))))
(defun clm-set-extent/overlay-endpoints (extent/overlay begin end)
(if (fboundp 'make-extent)
(set-extent-endpoints extent/overlay begin end)
(if (fboundp 'make-overlay)
(move-overlay extent/overlay begin end))))
;;; GNU Emacs doesn't have `point-at-bol' and `point-at-eol'.
;;; These are somewhat restricted alternatives.
(when (not (fboundp 'point-at-bol))
(defun point-at-bol ()
(let ((current (point)) bol)
(beginning-of-line) (setq bol (point)) (goto-char current) bol)))
(when (not (fboundp 'point-at-eol))
(defun point-at-eol ()
(let ((current (point)) eol)
(end-of-line) (setq eol (point)) (goto-char current) eol)))
(defun current-line-update ()
(when (member major-mode current-line-major-modes)
(unless current-line-extent/overlay
(setq current-line-extent/overlay (clm-make-extent/overlay 1 1))
(clm-set-extent/overlay-property current-line-extent/overlay
'face 'current-line-face)
(clm-set-extent/overlay-property current-line-extent/overlay
'priority 1))
(clm-set-extent/overlay-endpoints current-line-extent/overlay
(point-at-bol) (point-at-eol))))
(defun current-line-mode (arg)
"Display the current line with a distinctive face (current-line-face).
If ARG is nil, the appearance of the current line is not changed."
(interactive "P")
(if arg
(add-hook 'post-command-hook 'current-line-update)
(remove-hook 'post-command-hook 'current-line-update))
nil)
;;; current-line.el ends here