hugh@hoptoad.uucp (Hugh Daniel) (06/20/88)
I would like to highlight some text from lisp in GnuEmacs,
haveing looked at the code all I found was the code to highlight
the status line.
Many weeks ago I think someone was asking much the same
question as I. So, does anyone have the code to extend GnuEmacs
to let one highlight text?
(If not, sigh what fun!)
Thanks for your time.
||ugh Daniel
hugh@toad.com Grasshopper Groupsteiner@topaz.rutgers.edu (Dave Steiner) (06/21/88)
Got this off the net a while ago:
;;; Highlight a region
;;; From: lrs@esl.UUCP (Lynn Slater)
;;; Date: 24 Feb 88 21:05:21 GMT
(defun highlight-region (p1 p2)
"Highlight the current region."
(interactive "r")
(let ((s (buffer-substring p1 p2))
(inverse-video t)
(modified-flag (buffer-modified-p)) ; Do not change the modified flag
(buffer-read-only nil) ; shadow the true local value of read-only
;; Prevent the generation of autosave files
;; Don't you just love dynamic variable binding?
;; we do not have to worry about backup files because
;; they are not generated unless the buffer is saved.
(buffer-auto-save-file-name nil))
(delete-region p1 p2)
;; force a redisplay, so that the screen image of the line "changes" later
(if (fboundp 'update-display)
(update-display)
(sit-for 0))
(insert s)
(if (fboundp 'update-display)
(update-display)
(sit-for 0))
(set-buffer-modified-p modified-flag)))
ds
--
arpa: Steiner@TOPAZ.RUTGERS.EDU
uucp: ...{ames, cbosgd, harvard, moss}!rutgers!topaz.rutgers.edu!steinerliberte@uiucdcsm.cs.uiuc.edu (06/22/88)
Here is a considerably more complex temporarily-highlight-region
which depends on update-display to force update even with
input-pending. Mods to 18.50 (and probably 18.51) sunfns.c and
xdisp.c are included.
Dan LaLiberte
uiucdcs!liberte
liberte@cs.uiuc.edu
liberte%a.cs.uiuc.edu@uiucvmd.bitnet
------------
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# highlight.el
# update-display.diff
# This archive created: Tue Jun 21 12:31:30 1988
export PATH; PATH=/bin:$PATH
if test -f 'highlight.el'
then
echo shar: will not over-write existing file "'highlight.el'"
else
cat << \SHAR_EOF > 'highlight.el'
;;; highlight.el - fake highlighting with inverse-video
;;; Contains highlight-region, temporarily-highlight-region,
;;; and utilities wait-for-key, gobble-input, and interp-string
;;; Depends on update-display command. But if you can make
;;; interp-string work with prefix keys, sit-for could be used.
(global-set-key "\eT" 'temporarily-highlight-region)
(global-set-key "\eH" 'highlight-region)
(defun temporarily-highlight-region (start end)
"Temporarily highlight region from START to END until a keystroke is hit.
Works even if START and END are not in the display, but it
doesn't necessarily work if the buffer is displayed in more than one window.
Doesn't always work with selective display.
Gets into the undo stream.
Probably has a some other problems."
(interactive "r")
(let ((buffer-read-only nil)
(modified (buffer-modified-p))
(buffer-auto-save-file-name nil)
(name buffer-file-name)
(old-pnt (point))
did-highlight
)
;; (message "start: %d end: %d" start end) (sit-for 2)
(if (> start end)
(setq start (prog1 end
(setq end start))))
;; (message "start: %d end: %d" start end) (sit-for 2)
(unwind-protect
(progn
(save-excursion
;; defeat file locking... don't try this at home, kids!
(setq buffer-file-name nil)
(highlight-region start end t)
(wait-for-key old-pnt)
(setq did-highlight t)
))
(if did-highlight
(highlight-region start end))
(setq buffer-file-name name)
(set-buffer-modified-p modified)
)
(goto-char old-pnt)
))
(defun wait-for-key (where)
"Wait at WHERE until input is pending."
(let ((old-pnt (point)))
(goto-char where)
;; (message "waiting at %d" (point))
(sit-for 1)
(while (not (input-pending-p)) ; wait for input
; (message "waiting ...")
(goto-char where)
(sit-for 1) ; quits when input comes in
; (message "...")
)
(goto-char old-pnt)
)
)
(defun highlight-region (start end &optional invert)
"Highlight or unhighlight region between START and END by using
inverse-video if INVERT is t."
(interactive "r")
(update-display)
(let* ((old-pnt (point))
(inverse-video
(if invert
(not inverse-video)
inverse-video))
(temp start)
(start (min start end))
(end (max temp end))
(start (save-excursion
(move-to-window-line 0)
(max start (point))))
(end (save-excursion
(move-to-window-line -1)
(end-of-line)
(min end (point))))
(text (if (< start end) ; anything in region?
(buffer-substring start end)))
)
;; (message "highlight start: %d end: %d" start end) (sit-for 1)
(if text
(let ((i start)
j k start-col end-col)
(setq j i) ; remember last point
(goto-char i)
; white out the region line by line
(while (< i end)
(setq start-col (current-column))
; (forward-char 1)
; (if selective-display
; (skip-chars-forward "^\n\r")
(end-of-line)
; )
(if (> (point) end)
(goto-char end)
)
(setq j (point))
(setq end-col (current-column)) ; to end of line or text
; (message "insert from %d to %d" i j) ; debug
; (sit-for 2) ; debug
(goto-char i)
(delete-region i j)
(setq k (- end-col start-col)) ; number of spaces
; (message "insert %d spaces" k) ; debug
; (sit-for 1) ; debug
(insert-char ?\_ k) ; use _ instead to keep indentation
(end-of-line) ; for selective-display
(if (/= (point) (point-max))
(forward-char 1)) ; move to start of next line
(setq end (+ end (- k (- j i)))) ; adjust for extra spaces
(setq i (point)) ; start of next line
; (message "i=%d j=%d k=%d" i j k) ; debug
; (sit-for 1) ; debug
) ; while
) ; let
) ; if
(goto-char old-pnt) ; make sure point is back to initial position
; (sit-for 0) ; force update to erase text
(update-display) ; (sit-for 0) doesnt work if input is pending
; delete white space and reinsert text with inverse-video on
; (message "about to delete spaces") ; debug
(delete-region start end)
; (message "about to reinsert %s" text) ; debug
(goto-char start)
(if text
(insert text))
(goto-char old-pnt)
; (sit-for 0) ; force update to show inverted text
(update-display)
) ; let
)
;; The following is not used
(defun gobble-input ()
"Return all pending input chars in a string"
(let ((keys ""))
(while (input-pending-p)
(setq keys (concat keys (char-to-string (read-char))))
)
keys
)
)
(defun interp-string (str)
"Interpret the STRING as if it were from input using execute-kbd-macro.
Doesn't execute a prefix sequence correctly since
it ignores keys if not a complete key sequence."
(let (tempfunc)
(fset tempfunc str)
(execute-kbd-macro tempfunc)
)
)
; The following version of highlight-region does not work because
; narrow-to-region works very strangely with large buffers.
(defun highlight-region-bad (start end)
"Temporarily highlight region by using inverse-video."
(interactive "r")
(let ((text (buffer-substring start end))
(old-pnt (point))
)
(narrow-to-region start end)
(goto-char start)
(replace-regexp "[^ \t\n]" " ") ; this is slow and not even complete
(widen)
(goto-char old-pnt)
(sit-for 0)
; delete white space and reinsert text inverted
(delete-region start end)
; (message "about to reinsert %s" text)
; (sit-for 0)
(goto-char start)
(setq inverse-video (not inverse-video))
(insert text)
(goto-char old-pnt)
(sit-for 0)
)
)
SHAR_EOF
fi # end of overwriting check
if test -f 'update-display.diff'
then
echo shar: will not over-write existing file "'update-display.diff'"
else
cat << \SHAR_EOF > 'update-display.diff'
*** /tmp/,RCSt1003494 Fri Dec 4 13:09:31 1987
--- sunfns.c Tue Dec 1 18:34:38 1987
***************
*** 24,29 ****
--- 24,39 ----
who first discovered the Menu_Base_Kludge.
*/
+ /* Local changes were made to support Leif.
+ $Header: sunfns.c,v 1.2 87/12/01 18:34:38 liberte Exp $
+
+ $Log: sunfns.c,v $
+ * Revision 1.2 87/12/01 18:34:38 liberte
+ * Disable the update_display function so that the one in xdisp.c is used.
+ * However, forced update may not be the right thing to do.
+ *
+ */
+
/*
* Emacs Lisp-Callable functions for sunwindows
*/
***************
*** 182,187 ****
--- 192,198 ----
return(Qt);
}
+ /* Included in xdisp.c
DEFUN ("update-display", Fupdate_display, Supdate_display, 0, 0, 0,
"Perform redisplay.")
()
***************
*** 189,194 ****
--- 200,206 ----
DoDsp(1);
return(Qt);
}
+ */
/*
***************
*** 492,498 ****
defsubr(&Ssun_window_init);
defsubr(&Ssit_for_millisecs);
defsubr(&Ssleep_for_millisecs);
! defsubr(&Supdate_display);
defsubr(&Ssun_change_cursor_icon);
defsubr(&Ssun_set_selection);
defsubr(&Ssun_get_selection);
--- 504,510 ----
defsubr(&Ssun_window_init);
defsubr(&Ssit_for_millisecs);
defsubr(&Ssleep_for_millisecs);
! /* defsubr(&Supdate_display); */
defsubr(&Ssun_change_cursor_icon);
defsubr(&Ssun_set_selection);
defsubr(&Ssun_get_selection);
and this notice must be preserved on all copies. */
+ /* Local changes were made to support Leif.
+ $Header: editfns.c,v 1.2 87/12/04 13:31:50 liberte Exp $
+ $Log: editfns.c,v $
+ * Revision 1.2 87/12/04 13:31:50 liberte
+ * Add call to signal_after_change.
+ *
+ */
+
#include "config.h"
#include <pwd.h>
#include "lisp.h"
***************
*** 666,671 ****
--- 674,681 ----
if (NULL (noundo))
record_change (pos, 1);
CharAt (pos) = XINT (tochar);
+ if (NULL (noundo))
+ signal_after_change (2, pos, 1);
}
pos++;
}
SHAR_EOF
fi # end of overwriting check
# End of shell archive
exit 0