Path: utzoo!attcan!uunet!husc6!bbn!mit-eddie!bu-cs!purdue!i.cc.purdue.edu!j.cc.purdue.edu!pur-ee!uiucdcs!uiucdcsm!liberte From: liberte@uiucdcsm.cs.uiuc.edu Newsgroups: comp.emacs Subject: Re: Inverting text from GnuEmacs lisp Message-ID: <4300014@uiucdcsm> Date: 21 Jun 88 17:33:00 GMT References: <4748@hoptoad.uucp> Lines: 349 Nf-ID: #R:hoptoad.uucp:4748:uiucdcsm:4300014:000:8727 Nf-From: uiucdcsm.cs.uiuc.edu!liberte Jun 21 12:33:00 1988 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#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