cua-mode: cursor types

cua-mode: cursor types

[Michael Mauger]

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

Re: cua-mode: cursor types

[Kim F. Storm]

Michael Mauger <mmaug@yahoo.com> writes:

> 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.

Thank you.  I have installed your patch with some minor changes.

Most notably, I could not get the cursor type to change via
modify-frame-parameters.  Insted I set default-cursor-type, which
works for me.

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: cua-mode: cursor types

[Lars Hansen]

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?

Re: cua-mode: cursor types

[Kim F. Storm]

Lars Hansen <larsh@math.ku.dk> writes:

> 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.

There is only one cursor color shared by all windows in a frame, so
I cannot do anything about that.

> 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.

Problem is that cursor color is a frame specific parameter.
Feel free to post a patch :-)


> 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?

It only works with cua-mode as the name suggests.

It would be nice to separate it, but it is tied in with cua's global-mark
feature, so it is a bit tricky to do right.  Maybe in 22.x

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: cua-mode: cursor types

[Juanma Barranquero]

I have problems with cursor types when mixing styles (hollow, bar, etc.) As
soon as I switch from box to another one, I can't go back to box.

For example, I load and eval-buffer the following:

  (load-library "cua-base")
  (cua-mode)
  (setq cua-enable-cursor-indications t)
  (setq cua-normal-cursor-color 'box)
  (setq cua-overwrite-cursor-color 'hbar)
  (setq cua-read-only-cursor-color 'hollow)

C-x C-q     => hollow
C-x C-q     => still hollow !
<ins>       => hbar
<ins>       => hbar !
C-x C-q     => hollow

etc.


                                                                Juanma

Re: cua-mode: cursor types

[Ehud Karni]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

On 01 May 2004 23:25:59 +0200, storm@cua.dk (Kim F. Storm) wrote:
>
> Lars Hansen <larsh@math.ku.dk> writes:
>
> > Nice feature! My eyes are on the cursor rather than on the mode line.
> >
> > 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?
>
> It only works with cua-mode as the name suggests.
>
> It would be nice to separate it, but it is tied in with cua's global-mark
> feature, so it is a bit tricky to do right.  Maybe in 22.x

I have the following code that does that independently of cua-mode
(which I don't use).  This code allows you to change the cursor size
for terminals that support it. The MS-DOS code is quite old (I have
not used Emacs on MS-DOS for more than 5 years).

Ehud.


(defvar cursor-string nil "Last cursor string used")
(defvar cursor-string-over "\033[4l\033[20;10W"
    "Overwrite: underline cursor in TTY/MS-DOS, Yellow color for non terminals")
(defvar cursor-string-ins  "\033[90;10W"
    "Block cursor in TTY/MS-DOS, Green color for non terminals")

(defvar xterm-on (or (eq 'x window-system)
                     (eq 'w32 window-system)           ;; Windows NT/95 system (20.x)
                     (eq system-type 'ms-dos))         ;; PC (MSDOS) (old)
        "xterm/regular terminal switch nil=regular")   ;; xterm or windowed system

(if (eq system-type 'ms-dos)                           ; MSDOS is not really X terminal
   (progn
       (setq cursor-string-over (concat [11] [13]))    ; overwrite mode under-line
       (setq cursor-string-ins  (concat [01] [11])))   ; insert mode - block cursor
   (if xterm-on
       (progn
           (setq cursor-string-over "yellow")          ; overwrite mode
           (setq cursor-string-ins  "green")           ; insert mode
           (set-cursor-color cursor-string-over))))    ; start as overwrite cursor


(defun ins-cursor-set-init () "set cursor-string to empty string"
       (setq cursor-string "")
       (ins-cursor-set))

(defun ins-cursor-set () "set cursor type according to insertion mode (insert=block)"
       (let ((sv-crs-str cursor-string))
           (setq cursor-string (if overwrite-mode
                                   cursor-string-over      ; under-line cursor / yellow
                                   cursor-string-ins))     ; block cursor / green
           (or (string= sv-crs-str cursor-string)
               (cond
                   ((eq system-type 'ms-dos)                                   ; MSDOS
                               (set-cursor-mode (aref cursor-string 0) (aref cursor-string 1)))
                   (xterm-on
                               (set-cursor-color cursor-string))               ; X terminal
                   (sw-tty-on                                                  ; MVS TTY emulator
                               (if (>= emacs-major-version 21)                 ; internal show cursor appeared
                                   (internal-show-cursor nil nil))             ; in emacs 21 and must be used
                               (send-string-to-terminal cursor-string))))))    ; MVS TTY by Alex Ofek


(add-hook 'post-command-hook       'ins-cursor-set)
(add-hook 'suspend-resume-hook     'ins-cursor-set-init)
(add-hook 'minibuffer-exit-hook    'ins-cursor-set-init)
(add-hook 'minibuffer-setup-hook   'ins-cursor-set-init)
(add-hook 'mouse-leave-buffer-hook 'ins-cursor-set-init)


;; A function for MS-DOS only, should be loaded only when `system-type' is ms-dos
(defun set-cursor-mode (start-line end-line &optional blink-mode)
  "Set cursor shape for DOS machine, scan lines from START-LINE to END-LINE,
Optional third arg non-nil means cursor blinks."
       (and (numberp start-line)
           (numberp end-line)
           (let ((regs (make-register)))           ; union REGS regs
               (set-register-value regs 'ah 1)     ; regs.h.ah = 0x01
               (set-register-value regs 'ch start-line)
               (set-register-value regs 'cl end-line)
               (int86 16 regs))                    ; int86 (0x10 /* 16 */,...)
           nil))


- --
 Ehud Karni           Tel: +972-3-7966-561  /"\
 Mivtach - Simon      Fax: +972-3-7966-667  \ /  ASCII Ribbon Campaign
 Insurance agencies   (USA) voice mail and   X   Against   HTML   Mail
 http://www.mvs.co.il  FAX:  1-815-5509341  / \
 GnuPG: 98EA398D <http://www.keyserver.net/>    Better Safe Than Sorry
-----BEGIN PGP SIGNATURE-----
Comment: use http://www.keyserver.net/ to get my key (and others)

iD8DBQFAlmjTLFvTvpjqOY0RAuscAJ9G5YhDxNaHRLfj7pefggjJ73iCdwCeKhYH
uziYmUFe0jbvXqWsJdljbnU=
=z6Ve
-----END PGP SIGNATURE-----