🚀 go-pugleaf

     Here's a little package to provide Lisp-machine-style highlighting
of the region (ie, between point and mark) for Epoch 4.0.  It's not
quite perfect, but it does a creditable job.  The region is highlighted,
using drag-zone, on mark-setting commands;  the highlighting is updated
as point moves during motion and searching commands;  the highlighting
is removed by most other commands.
     In addition, replacement commands are modified so they narrow to
the region if it's active, otherwise they work on the whole buffer.
Kill-region and copy-region-as-kill are modified so they only operate
(interactively) when the region is active.
     I made this patch against 4.0p1, and I haven't picked up 4.0p2, so
I don't know if there are any conflicts.  I also have a 3.2 version if
anyone's interested.
     There are two files in the shar below:  One is a patch to
src/keyboard.c to create a variable, after-command-hook, and to funcall
it after each command with one argument, the command.  The other file is
the elisp that actually does the work.
     I had to patch the C code because there isn't any other way to have
a function called after every command.  Even modifying the definition of
every command wouldn't do it, because self-insert-command, forward-char,
and backward-char are inlined in the command-loop.  Epoch's after-modify
hook (whatever it's called) and 4.0p2's after-movement-function aren't
sufficient, either, because I also want to know about commands that
don't modify and don't move.
     Anyway, I hope this is useful.  Our users like it.  Combined with
some other code, we make Epoch look rather like Zmacs.

Paul Fuqua                     pf@hc.ti.com, ti-csl!pf
Texas Instruments, Dallas, Texas

"You get what you settle for." -- Thelma & Louise

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  highlight-region-patch-4.0 highlight-region-hack.el
# Wrapped by pf@ninja on Thu Jun  4 16:43:50 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'highlight-region-patch-4.0' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'highlight-region-patch-4.0'\"
else
echo shar: Extracting \"'highlight-region-patch-4.0'\" \(1850 characters\)
sed "s/^X//" >'highlight-region-patch-4.0' <<'END_OF_FILE'
X*** keyboard.c.ORIG	Fri Apr 24 11:03:24 1992
X--- keyboard.c	Fri Apr 24 11:10:16 1992
X***************
X*** 177,182 ****
X--- 177,184 ----
X  /* User-supplied string to translate input characters through */
X  Lisp_Object Vkeyboard_translate_table;
X  
X+ Lisp_Object Vafter_command_hook;
X+ 
X  FILE *dribble;			/* File in which we write all commands we read */
X  
X  /* Nonzero if input is available */
X***************
X*** 792,797 ****
X--- 794,804 ----
X  	  this_command_key_count = 0;
X  	  cancel_echoing ();
X  	}
X+ 
X+       /*  +++ Hack for playing with region-marking.  */
X+       if (!NIL(Vafter_command_hook))
X+ 	call1(Vafter_command_hook, cmd);
X+ 
X      }
X  }
X  
X***************
X*** 1728,1733 ****
X--- 1735,1741 ----
X    char buf[40];
X    Lisp_Object saved_keys;
X    struct gcpro gcpro1;
X+   Lisp_Object return_value;
X  
X    saved_keys = Fthis_command_keys ();
X    GCPRO1 (saved_keys);
X***************
X*** 1766,1772 ****
X    Vprefix_arg = prefixarg;
X    this_command = function;
X  
X!   return Fcommand_execute (function, Qt);
X  }
X  
X  detect_input_pending ()
X--- 1774,1786 ----
X    Vprefix_arg = prefixarg;
X    this_command = function;
X  
X!   return_value = Fcommand_execute (function, Qt);
X! 
X!   /*  +++ Hack for playing with region-marking.  */
X!   if (!NIL(Vafter_command_hook))
X!     call1(Vafter_command_hook, function);
X! 
X!   return(return_value);
X  }
X  
X  detect_input_pending ()
X***************
X*** 2279,2284 ****
X--- 2293,2304 ----
X  Each character is looked up in this string and the contents used instead.\n\
X  If string is of length N, character codes N and up are untranslated."); 
X    Vkeyboard_translate_table = Qnil;
X+ 
X+   DEFVAR_LISP ("after-command-hook", &Vafter_command_hook,
X+     "Function of one argument, the command just executed,\n\
X+ or NIL to disable.");
X+   Vafter_command_hook = Qnil;
X+ 
X  }
X  
X  keys_of_keyboard ()
END_OF_FILE
if test 1850 -ne `wc -c <'highlight-region-patch-4.0'`; then
    echo shar: \"'highlight-region-patch-4.0'\" unpacked with wrong size!
fi
# end of 'highlight-region-patch-4.0'
fi
if test -f 'highlight-region-hack.el' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'highlight-region-hack.el'\"
else
echo shar: Extracting \"'highlight-region-hack.el'\" \(12640 characters\)
sed "s/^X//" >'highlight-region-hack.el' <<'END_OF_FILE'
X;;  Try to do lispm-style region-highlighting, using a special hook
X;;  in the emacs command loop.
X;;
X;;  The biggest lack is that many emacs commands still act on the
X;;  region even if it isn't highlighted, and some never act on the
X;;  region (like replaces), highlighted or not.  It also doesn't
X;;  unhighlight quite properly on c-g, which doesn't go through
X;;  the command loop -- it sometimes unhighlights on the next input.
X;;
X;;  Note that 3.2 uses drag-button, while 4.0 uses drag-zone, so this
X;;  code needs some slight changes to work with 3.2.
X
X;;  Usual is (set-region-style (foreground) (background) (foreground)).
X;;  Inverse is (set-region-style (background) (foreground) nil).
X;;  Try (set-region-style (foreground) "light blue" nil) or
X;;  (set-region-style (foreground) (background) "green").
X(defun set-region-style (fg bg underline)
X  (if (null motion::style)
X      (setq motion::style (make-style)))
X  (set-style-foreground motion::style fg)
X  (set-style-background motion::style bg)
X;;  Need a better way to make the cursor show up in inverse mode.
X;  (set-style-cursor-foreground motion::style bg)
X;  (set-style-cursor-background motion::style fg)
X  (set-style-underline motion::style underline))
X
X(defun region-highlighting-hook (command)
X  (let* ((history (recent-keys))
X	 (history-length (length history)))
X    ;;  Since we can't really catch ^G, fake it by looking in the
X    ;;  keystroke history (ugh) and turning off the region if we find
X    ;;  it.  While we'll get fooled by ^Q ^G, it doesn't matter,
X    ;;  because that would turn off the region, too.
X    (when (and (> history-length 1)
X	       (char-equal (aref history (- history-length 2))
X			   ?\C-g))
X      (if drag-zone
X	  (delete-button drag-zone))
X      (setq drag-zone nil)))
X  (when (and (zerop (minibuffer-depth))	; Do nothing when in minibuffer.
X	     (symbolp command))		; Cope with Rob's lambdas-as-commands.
X    (let ((mark-prop (get command 'mark-state)))
X      (cond ((eq mark-prop 'sm)		; Set mark.
X	     (cond ((and (eq command 'set-mark-command)
X			 (consp current-prefix-arg))
X		    ;;  Special-case c-u c-space.
X		    ;;  I want to do this, but it doesn't work right.
X		    ;(move-button drag-zone (point) (point))
X		    (if drag-zone
X			(delete-button drag-zone))
X		    (setq drag-zone nil))
X		   (t
X		    (if drag-zone
X			(delete-button drag-zone))
X		    (setq drag-zone (add-button (mark) (point) motion::style)))))
X	    ((and (eq mark-prop 'km)	; Keep mark.
X		  drag-zone)		; Don't bother if no highlighting.
X	     (move-button drag-zone (mark) (point)))
X	    (t				; Default is to reset mark.
X	     (if drag-zone
X		 (delete-button drag-zone))
X	     (setq drag-zone nil)
X	     )))))
X
X(setq after-command-hook 'region-highlighting-hook)
X
X;;  Most of these, if not all, are taken from the corresponding Zmacs
X;;  functions.
X(put 'set-mark-command 'mark-state 'sm)	; Don't highlight when popping mark.
X(put 'exchange-point-and-mark 'mark-state 'sm) ; Not quite right.
X(put 'mark-beginning 'mark-state 'sm)	; c-<
X(put 'mark-end 'mark-state 'sm)		; c->
X(put 'mark-word 'mark-state 'sm)
X(put 'mark-sexp 'mark-state 'sm)
X(put 'mark-page 'mark-state 'sm)
X(put 'mark-whole-buffer 'mark-state 'sm)
X(put 'mark-paragraph 'mark-state 'sm)
X(put 'mark-defun 'mark-state 'sm)
X
X(put 'forward-char 'mark-state 'km)
X(put 'backward-char 'mark-state 'km)
X(put 'next-line 'mark-state 'km)
X(put 'previous-line 'mark-state 'km)
X(put 'recenter 'mark-state 'km)
X(put 'beginning-of-line 'mark-state 'km)
X(put 'end-of-line 'mark-state 'km)
X(put 'set-goal-column 'mark-state 'km)
X(put 'scroll-up 'mark-state 'km)
X(put 'scroll-down 'mark-state 'km)
X(put 'scroll-up-by-screens 'mark-state 'km)
X(put 'scroll-down-by-screens 'mark-state 'km)
X(put 'scroll-other-window 'mark-state 'km)
X(put 'enlarge-window 'mark-state 'km)
X(put 'move-to-window-line 'mark-state 'km)
X(put 'beginning-of-buffer 'mark-state 'km) ; Not quite right.
X(put 'end-of-buffer 'mark-state 'km)
X(put 'universal-argument 'mark-state 'km)
X(put 'digit-argument 'mark-state 'km)
X(put 'negative-argument 'mark-state 'km)
X(put 'forward-word 'mark-state 'km)
X(put 'backward-word 'mark-state 'km)
X(put 'forward-sexp 'mark-state 'km)
X(put 'backward-sexp 'mark-state 'km)
X(put 'forward-list 'mark-state 'km)
X(put 'backward-list 'mark-state 'km)
X(put 'forward-sentence 'mark-state 'km)
X(put 'backward-sentence 'mark-state 'km)
X(put 'forward-paragraph 'mark-state 'km)
X(put 'backward-paragraph 'mark-state 'km)
X(put 'forward-line 'mark-state 'km)
X(put 'forward-page 'mark-state 'km)
X(put 'backward-page 'mark-state 'km)
X(put 'beginning-of-defun 'mark-state 'km)
X(put 'end-of-defun 'mark-state 'km)
X(put 'beginning-of-defun-lisp 'mark-state 'km)
X(put 'end-of-defun-lisp 'mark-state 'km)
X(put 'down-list 'mark-state 'km)
X(put 'backward-up-list 'mark-state 'km)
X(put 'set-fill-column 'mark-state 'km)
X(put 'forward-to-indentation 'mark-state 'km)
X(put 'back-to-indentation 'mark-state 'km)
X(put 'eval-expression 'mark-state 'km)
X(put 'execute-extended-command 'mark-state 'km)
X(put 'register-to-point 'mark-state 'km)
X(put 'view-register 'mark-state 'km)
X(put 'reposition-window 'mark-state 'km) ; Hypothetical.
X(put 'reposition-window-lisp 'mark-state 'km)
X(put 'view-lossage 'mark-state 'km)
X(put 'count-lines-region 'mark-state 'km)
X(put 'count-lines-page 'mark-state 'km)
X(put 'what-cursor-position 'mark-state 'km)
X(put 'isearch-forward 'mark-state 'km)	; The isearches need work.
X(put 'isearch-backward 'mark-state 'km)
X(put 'isearch-forward-regexp 'mark-state 'km)
X(put 'isearch-backward-regexp 'mark-state 'km)
X(put 're-search-forward 'mark-state 'km)
X(put 're-search-backward 'mark-state 'km)
X(put 'search-forward 'mark-state 'km)
X(put 'search-backward 'mark-state 'km)
X(put 'word-search-forward 'mark-state 'km)
X(put 'word-search-backward 'mark-state 'km)
X(put 'undo 'mark-state 'km)
X(put 'append-next-kill 'mark-state 'km)
X(put 'dired-next-line 'mark-state 'km)
X(put 'dired-previous-line 'mark-state 'km)
X(put 'comint-bol 'mark-state 'km)
X(put 'help-command 'mark-state 'km)
X
X;;  Roughly analogous to lispm mouse-left commands?  Anyway,
X;;  they already drag like they're supposed to, and on the lispm
X;;  they clear the mark.
X;(put 'start-mouse-drag 'mark-state 'km)
X;(put 'end-mouse-drag 'mark-state 'km)
X;(put 'extend-mouse-drag 'mark-state 'km)
X
X;;  Mouse-middle, which may need some coordination with this code.
X;(put 'mark-thing-at-point 'mark-state 'sm)
X
X;;  mouse::paste-cut-buffer should maybe set point mark around the
X;;  new text, too?
X
X;;  Not yet implemented.
X;(put 'mouse-indent-rigidly 'mark-state 'km)
X;(put 'mouse-indent-under 'mark-state 'km)
X
X
X;;  Hack to clear the region on ^G -- doesn't work all the time.
X(defun keyboard-quit ()
X  "Signal a  quit  condition."
X  (interactive)
X  (let ((region-p drag-zone))
X    (if drag-zone
X	(delete-button drag-zone))
X    (setq drag-zone nil)
X    (if (not region-p)
X	(signal 'quit nil))))
X
X;;  Special hack for incremental search updating (which otherwise
X;;  wouldn't happen until the command is finished).
X(if (not (fboundp 'real-isearch-search))
X    (fset 'real-isearch-search (symbol-function 'isearch-search)))
X(defun isearch-search ()
X  (prog1 (real-isearch-search)
X	 (if drag-zone
X	     (move-button drag-zone (mark) (point)))))
X
X;;  Redefine this core replacing function to narrow to the region,
X;;  if drag-zone is active, before replacing, widening afterwards,
X;;  much like Zmacs.  Also updates drag-zone as it moves along.
X(defun perform-replace (from-string to-string
X		        query-flag regexp-flag delimited-flag)
X  (save-restriction
X    (if (and drag-zone
X	     (eq (zone-buffer drag-zone) (current-buffer)))
X	(narrow-to-region (zone-start drag-zone) (zone-end drag-zone)))
X    (let ((nocasify (not (and case-fold-search case-replace
X			      (string-equal from-string
X					    (downcase from-string)))))
X	  (literal (not regexp-flag))
X	  (search-function (if regexp-flag 're-search-forward 'search-forward))
X	  (search-string from-string)
X	  (keep-going t)
X	  (lastrepl nil))		;Position after last match considered.
X      (if delimited-flag
X	  (setq search-function 're-search-forward
X		search-string (concat "\\b"
X				      (if regexp-flag from-string
X					  (regexp-quote from-string))
X				      "\\b")))
X      (push-mark)
X      (push-mark)
X      (while (and keep-going
X		  (not (eobp))
X		  (progn
X		    (set-mark (point))
X		    (funcall search-function search-string nil t)))
X	;; Don't replace the null string 
X	;; right after end of previous replacement.
X	(if (eq lastrepl (point))
X	    (forward-char 1)
X	    (undo-boundary)
X	    (if (not query-flag)
X		(replace-match to-string nocasify literal)
X		(let (done replaced)
X		  (while (not done)
X
X		    (if drag-zone
X			(move-button drag-zone (point) (zone-end drag-zone)))
X
X		    ;; Preserve the match data.  Process filters and sentinels
X		    ;; could run inside read-char..
X		    (let ((data (match-data))
X			  (help-form
X			   '(concat "Query replacing "
X			     (if regexp-flag "regexp " "")
X			     from-string " with " to-string ".\n\n"
X			     (substitute-command-keys query-replace-help))))
X		      (setq char help-char)
X		      (while (= char help-char)
X			(message "Query replacing %s with %s: " from-string to-string)
X			(setq char (read-char))
X			(if (= char ??)
X			    (setq unread-command-char help-char char help-char)))
X		      (store-match-data data))
X		    (cond ((or (= char ?\e)
X			       (= char ?q))
X			   (setq keep-going nil)
X			   (setq done t))
X			  ((= char ?^)
X			   (goto-char (mark))
X			   (setq replaced t))
X			  ((or (= char ?\ )
X			       (= char ?y))
X			   (or replaced
X			       (replace-match to-string nocasify literal))
X			   (setq done t))
X			  ((= char ?\.)
X			   (or replaced
X			       (replace-match to-string nocasify literal))
X			   (setq keep-going nil)
X			   (setq done t))
X			  ((= char ?\,)
X			   (if (not replaced)
X			       (progn
X				 (replace-match to-string nocasify literal)
X				 (setq replaced t))))
X			  ((= char ?!)
X			   (or replaced
X			       (replace-match to-string nocasify literal))
X			   (setq done t query-flag nil))
X			  ((or (= char ?\177)
X			       (= char ?n))
X			   (setq done t))
X			  ((= char ?\C-l)
X			   (recenter nil))
X			  ((= char ?\C-r)
X			   (store-match-data
X			    (prog1 (match-data)
X			      (save-excursion (recursive-edit)))))
X			  ((= char ?\C-w)
X			   (delete-region (match-beginning 0) (match-end 0))
X			   (store-match-data
X			    (prog1 (match-data)
X			      (save-excursion (recursive-edit))))
X			   (setq replaced t))
X			  (t
X			   (setq keep-going nil)
X			   (setq unread-command-char char)
X			   (setq done t))))))
X	    (setq lastrepl (point))))
X      (pop-mark)
X      keep-going)))
X
X;;  Idea to handle some region-using commands -- wrap a macro around
X;;  them that insists that drag-zone be on before operating.
X(require 'backquote)
X(defmacro insist-on-highlighted-region (fcn &optional except-after-yank)
X  ;;ensure the function exists
X  (if (not (fboundp fcn))
X      (error "Symbol's function definition is void: %s" fcn))
X  ;;generate a "holder" symbol
X  (let ((fholder (intern (concat "real-" (symbol-name fcn)))))
X    ;;if holder is fbound, then we've done this already.  leave alone.
X    (if (not (fboundp fholder))
X	(fset fholder (symbol-function fcn)))
X    ;;generate wrapper function to minimize specified buffer
X    (`
X     (defun (, fcn) (&rest args)
X       (, (documentation fholder))
X       (interactive)
X       ;; pass args if not interactive
X       (if (interactive-p)
X	   (if (, (if except-after-yank
X		      '(or drag-zone
X			   (eq last-command 'yank))
X		      'drag-zone))
X	       (call-interactively (function (, fholder)))
X	       (error "Region is not active."))
X	   (apply (function (, fholder)) args))))))
X
X(insist-on-highlighted-region kill-region t)
X(insist-on-highlighted-region copy-region-as-kill)
X
X(provide 'highlight-region-hack)
END_OF_FILE
if test 12640 -ne `wc -c <'highlight-region-hack.el'`; then
    echo shar: \"'highlight-region-hack.el'\" unpacked with wrong size!
fi
# end of 'highlight-region-hack.el'
fi
echo shar: End of shell archive.
exit 0