unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* cua-mode: cursor types
@ 2004-02-24  3:20 Michael Mauger
  2004-04-30 20:56 ` Kim F. Storm
  0 siblings, 1 reply; 6+ messages in thread
From: Michael Mauger @ 2004-02-24  3:20 UTC (permalink / raw)


Below is a patch for cua-base.el that changes the cursor shape based on
insert/overstrike or read-only state.  The mode already supports changing
the color of the cursor, this patch only adds changing its shape.

It also fixes a bug where the cursor was not being set when the mode
starts up.

My .emacs now sets these as follows:

    (setq cua-normal-cursor-color '(bar . "black")
          cua-overwrite-cursor-color '(box . "red")
          cua-read-only-cursor-color '(block . "blue"))

NB. I tried to change the name of the `cua-*-cursor-color' variables to
`cua-*cursor-style' and then use `defvaralias' to link the old name to
the new, but custom-set-variable wouldn't work.  SHould this have worked?


Index: emacs/lisp/emulation/cua-base.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/emulation/cua-base.el,v
retrieving revision 1.27
diff -u -r1.27 cua-base.el
--- emacs/lisp/emulation/cua-base.el	25 Nov 2003 22:10:52 -0000	1.27
+++ emacs/lisp/emulation/cua-base.el	21 Feb 2004 18:55:44 -0000
@@ -411,30 +411,101 @@
 					    (cdr (assoc 'cursor-color default-frame-alist)))
 				       (frame-parameter nil 'cursor-color)
 				       "red")
-  "Normal (non-overwrite) cursor color.
+  "Normal (non-overwrite) cursor color and type.
 Also used to indicate that rectangle padding is not in effect.
-Default is to load cursor color from initial or default frame
parameters."
+Default is to load cursor color from initial or default frame
parameters.
+
+If the value is a COLOR name, then only the `cursor-color'
+attribute will be affected.
+If the value is a cursor TYPE (one of: `box', `block' or `bar'),
+then only the `cursor-type' property will be affected.
+If the value is a cons of (TYPE . COLOR), then both properties
+are affected."
   :initialize 'custom-initialize-default
-  :type 'color
+  :type '(choice
+	  (color :tag "Color")
+	  (choice :tag "Type"
+		  (const :tag "Filled box" box)
+		  (const :tag "Narrow bar" bar)
+		  (const :tag "Hollow block" block))
+	  (cons :tag "Color and Type"
+		(choice :tag "Type"
+			(const :tag "Filled box" box)
+			(const :tag "Narrow bar" bar)
+			(const :tag "Hollow block" block))
+		(color :tag "Color")))
   :group 'cua)
 
 (defcustom cua-read-only-cursor-color "darkgreen"
-  "*Cursor color used in read-only buffers, if non-nil."
-  :type 'color
+  "*Cursor color used in read-only buffers, if non-nil.
+
+If the value is a COLOR name, then only the `cursor-color'
+attribute will be affected.
+If the value is a cursor TYPE (one of: `box', `block' or `bar'),
+then only the `cursor-type' property will be affected.
+If the value is a cons of (TYPE . COLOR), then both properties
+are affected."
+  :type '(choice
+	  (color :tag "Color")
+	  (choice :tag "Type"
+		  (const :tag "Filled box" box)
+		  (const :tag "Narrow bar" bar)
+		  (const :tag "Hollow block" block))
+	  (cons :tag "Color and Type"
+		(choice :tag "Type"
+			(const :tag "Filled box" box)
+			(const :tag "Narrow bar" bar)
+			(const :tag "Hollow block" block))
+		(color :tag "Color")))
   :group 'cua)
 
 (defcustom cua-overwrite-cursor-color "yellow"
   "*Cursor color used when overwrite mode is set, if non-nil.
-Also used to indicate that rectangle padding is in effect."
-  :type 'color
+Also used to indicate that rectangle padding is in effect.
+
+If the value is a COLOR name, then only the `cursor-color'
+attribute will be affected.
+If the value is a cursor TYPE (one of: `box', `block' or `bar'),
+then only the `cursor-type' property will be affected.
+If the value is a cons of (TYPE . COLOR), then both properties
+are affected."
+  :type '(choice
+	  (color :tag "Color")
+	  (choice :tag "Type"
+		  (const :tag "Filled box" box)
+		  (const :tag "Narrow bar" bar)
+		  (const :tag "Hollow block" block))
+	  (cons :tag "Color and Type"
+		(choice :tag "Type"
+			(const :tag "Filled box" box)
+			(const :tag "Narrow bar" bar)
+			(const :tag "Hollow block" block))
+		(color :tag "Color")))
   :group 'cua)
 
 (defcustom cua-global-mark-cursor-color "cyan"
   "*Indication for active global mark.
-Will change cursor color to specified color if string."
-  :type 'color
-  :group 'cua)
+Will change cursor color to specified color if string.
 
+If the value is a COLOR name, then only the `cursor-color'
+attribute will be affected.
+If the value is a cursor TYPE (one of: `box', `block' or `bar'),
+then only the `cursor-type' property will be affected.
+If the value is a cons of (TYPE . COLOR), then both properties
+are affected."
+  :type '(choice
+	  (color :tag "Color")
+	  (choice :tag "Type"
+		  (const :tag "Filled box" box)
+		  (const :tag "Narrow bar" bar)
+		  (const :tag "Hollow block" block))
+	  (cons :tag "Color and Type"
+		(choice :tag "Type"
+			(const :tag "Filled box" box)
+			(const :tag "Narrow bar" bar)
+			(const :tag "Hollow block" block))
+		(color :tag "Color")))
+  :group 'cua)
 
 ;;; Rectangle support is in cua-rect.el
 
@@ -850,7 +921,7 @@
 
 With no prefix argument, clear mark if already set.  Otherwise, set
 mark, and push old mark position on local mark ring; also push mark on
-global mark ring if last mark was set in another buffer.  
+global mark ring if last mark was set in another buffer.
 
 With argument, jump to mark, and pop a new position for mark off
 the local mark ring \(this does not affect the global mark ring\).
@@ -906,19 +977,35 @@
   (let ((cursor
 	 (cond
 	  ((and cua--global-mark-active
-		(stringp cua-global-mark-cursor-color))
+		cua-global-mark-cursor-color)
 	   cua-global-mark-cursor-color)
 	  ((and buffer-read-only
-		(stringp cua-read-only-cursor-color))
+		cua-read-only-cursor-color)
 	   cua-read-only-cursor-color)
-	  ((and (stringp cua-overwrite-cursor-color)
+	  ((and cua-overwrite-cursor-color
 		(or overwrite-mode
 		    (and cua--rectangle (cua--rectangle-padding))))
 	   cua-overwrite-cursor-color)
-	  (t cua-normal-cursor-color))))
-    (if (and cursor
-	     (not (equal cursor (frame-parameter nil 'cursor-color))))
-	(set-cursor-color cursor))
+	  (t cua-normal-cursor-color)))
+	color
+	type)
+    (setq color (if (and cursor (consp cursor))
+		    (cdr cursor)
+		  (if (stringp cursor)
+		      cursor)))
+    (setq type (if (and cursor (consp cursor))
+		   (car cursor)
+		 (if (symbolp cursor)
+		     cursor)))
+    (if (and color
+	     (stringp color)
+	     (not (equal color (frame-parameter nil 'cursor-color))))
+	(set-cursor-color color))
+    (if (and type
+	     (symbolp type)
+	     (not (eq type (frame-parameter nil 'cursor-type))))
+	(modify-frame-parameters nil
+				 (list (cons 'cursor-type type))))
     cursor))
 
 
@@ -1186,7 +1273,9 @@
 	(add-hook 'post-command-hook 'cua--post-command-handler)
 	(if (and cua-enable-modeline-indications (not (assoc 'cua-mode
minor-mode-alist)))
 	    (setq minor-mode-alist (cons '(cua-mode cua--status-string)
minor-mode-alist)))
-	)
+	(if cua-enable-cursor-indications
+	    (cua--update-indications)))
+
     (remove-hook 'pre-command-hook 'cua--pre-command-handler)
     (remove-hook 'post-command-hook 'cua--post-command-handler))
 


__________________________________
Do you Yahoo!?
Yahoo! Mail SpamGuard - Read only the mail you want.
http://antispam.yahoo.com/tools

^ permalink raw reply	[flat|nested] 6+ messages in thread
* Re: cua-mode: cursor types
@ 2004-05-01  7:11 Lars Hansen
  2004-05-01 21:25 ` Kim F. Storm
  0 siblings, 1 reply; 6+ messages in thread
From: Lars Hansen @ 2004-05-01  7:11 UTC (permalink / raw)
  Cc: emacs-devel

Nice feature! My eyes are on the cursor rather than on the mode line.

However, there are some problems:
1. With two windows in the same frame displaying two different buffers, 
toggling one into overwrite mode changes the color of the hollow cursor 
in the other.
2. With two frames displaying the same buffer, toggling into overwrite 
mode only changes the cursor in the active frame. Maybe the other frame 
just needs repainting.
3. If you don't use cua-mode but just set cua-enable-cursor-indications 
to t, the feature does not work. Is that intended?

^ permalink raw reply	[flat|nested] 6+ messages in thread
end of thread, other threads:[~2004-05-03 15:44 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2004-02-24  3:20 cua-mode: cursor types Michael Mauger
2004-04-30 20:56 ` Kim F. Storm
  -- strict thread matches above, loose matches on Subject: below --
2004-05-01  7:11 Lars Hansen
2004-05-01 21:25 ` Kim F. Storm
2004-05-03  9:24   ` Juanma Barranquero
2004-05-03 15:44   ` Ehud Karni

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).