[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
cua-mode: cursor types
From: |
Michael Mauger |
Subject: |
cua-mode: cursor types |
Date: |
Mon, 23 Feb 2004 19:20:32 -0800 (PST) |
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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- cua-mode: cursor types,
Michael Mauger <=