;;(define-key global-map '(shift button2) 'x-mouse-kill)
(define-key global-map '(control button2) 'x-set-point-and-move-selection)
+(define-obsolete-function-alias 'x-insert-selection 'insert-selection)
+
(defun x-mouse-kill (event)
"Kill the text between the point and mouse and copy it to the clipboard and
-to the cut buffer"
+to the cut buffer."
(interactive "@e")
(let ((old-point (point)))
(mouse-set-point event)
(let ((s (buffer-substring old-point (point))))
- (x-own-clipboard s)
+ (own-clipboard s)
(x-store-cutbuffer s))
(kill-region old-point (point))))
-(defun x-yank-function ()
- "Insert the current X selection or, if there is none, insert the X cutbuffer.
-A mark is pushed, so that the inserted text lies between point and mark."
- (push-mark)
- (if (region-active-p)
- (if (consp zmacs-region-extent)
- ;; pirated code from insert-rectangle in rect.el
- ;; perhaps that code should be modified to handle a list of extents
- ;; as the rectangle to be inserted?
- (let ((lines zmacs-region-extent)
- (insertcolumn (current-column))
- (first t))
- (push-mark)
- (while lines
- (or first
- (progn
- (forward-line 1)
- (or (bolp) (insert ?\n))
- (move-to-column insertcolumn t)))
- (setq first nil)
- (insert (extent-string (car lines)))
- (setq lines (cdr lines))))
- (insert (extent-string zmacs-region-extent)))
- (x-insert-selection t)))
-
-(defun x-insert-selection (&optional check-cutbuffer-p move-point-event)
- "Insert the current selection into buffer at point."
- (interactive "P")
- (let ((text (if check-cutbuffer-p
- (or (condition-case () (x-get-selection) (error ()))
- (x-get-cutbuffer)
- (error "No selection or cut buffer available"))
- (x-get-selection))))
- (cond (move-point-event
- (mouse-set-point move-point-event)
- (push-mark (point)))
- ((interactive-p)
- (push-mark (point))))
- (insert text)
- ))
-
(make-obsolete 'x-set-point-and-insert-selection 'mouse-yank)
(defun x-set-point-and-insert-selection (event)
"Set point where clicked and insert the primary selection or the cut buffer."
;; to fail; just let the appropriate error message get issued. (We need
;; to insert the selection and set point first, or the selection may
;; get inserted at the wrong place.)
- (and (x-selection-owner-p)
+ (and (selection-owner-p)
primary-selection-extent
- (x-insert-selection t event))
+ (insert-selection t event))
(kill-primary-selection))
(defun mouse-track-and-copy-to-cutbuffer (event)
(set-buffer (extent-object (car primary-selection-extent)))
(x-store-cutbuffer
(mapconcat
- 'identity
+ #'identity
(extract-rectangle
(extent-start-position (car primary-selection-extent))
(extent-end-position (car (reverse primary-selection-extent))))
(if x-pointers-initialized ; only do it when the first device is created
nil
(set-glyph-image text-pointer-glyph
- (or (x-get-resource "textPointer" "Cursor" 'string device)
- "xterm"))
+ (or (x-get-resource "textPointer" "Cursor" 'string device nil 'warn)
+ [cursor-font :data "xterm"]))
(set-glyph-image selection-pointer-glyph
- (or (x-get-resource "selectionPointer" "Cursor" 'string device)
- "top_left_arrow"))
+ (or (x-get-resource "selectionPointer" "Cursor" 'string device
+ nil 'warn)
+ [cursor-font :data "top_left_arrow"]))
(set-glyph-image nontext-pointer-glyph
- (or (x-get-resource "spacePointer" "Cursor" 'string device)
- "xterm")) ; was "crosshair"
+ (or (x-get-resource "spacePointer" "Cursor" 'string device nil 'warn)
+ [cursor-font :data "xterm"])) ; was "crosshair"
(set-glyph-image modeline-pointer-glyph
- (or (x-get-resource "modeLinePointer" "Cursor" 'string device)
+ (or (x-get-resource "modeLinePointer" "Cursor" 'string device
+ nil 'warn)
;; "fleur"))
- "sb_v_double_arrow"))
+ [cursor-font :data "sb_v_double_arrow"]))
(set-glyph-image gc-pointer-glyph
- (or (x-get-resource "gcPointer" "Cursor" 'string device)
- "watch"))
+ (or (x-get-resource "gcPointer" "Cursor" 'string device nil 'warn)
+ [cursor-font :data "watch"]))
(when (featurep 'scrollbar)
(set-glyph-image
scrollbar-pointer-glyph
- (or (x-get-resource "scrollbarPointer" "Cursor" 'string device)
- "top_left_arrow")))
+ (or (x-get-resource "scrollbarPointer" "Cursor" 'string device
+ nil 'warn)
+ ;; bizarrely if we don't specify the specific locale (x) this
+ ;; gets instantiated on the stream device. Bad puppy.
+ [cursor-font :data "top_left_arrow"]) 'global '(default x)))
(set-glyph-image busy-pointer-glyph
- (or (x-get-resource "busyPointer" "Cursor" 'string device)
- "watch"))
+ (or (x-get-resource "busyPointer" "Cursor" 'string device nil 'warn)
+ [cursor-font :data "watch"]))
(set-glyph-image toolbar-pointer-glyph
- (or (x-get-resource "toolBarPointer" "Cursor" 'string device)
- "left_ptr"))
+ (or (x-get-resource "toolBarPointer" "Cursor" 'string device
+ nil 'warn)
+ [cursor-font :data "left_ptr"]))
(set-glyph-image divider-pointer-glyph
- (or (x-get-resource "dividerPointer" "Cursor" 'string device)
- "sb_h_double_arrow"))
+ (or (x-get-resource "dividerPointer" "Cursor" 'string device
+ nil 'warn)
+ [cursor-font :data "sb_h_double_arrow"]))
(let ((fg
- (x-get-resource "pointerColor" "Foreground" 'string device)))
+ (x-get-resource "pointerColor" "Foreground" 'string device
+ nil 'warn)))
(and fg
(set-face-foreground 'pointer fg)))
(let ((bg
- (x-get-resource "pointerBackground" "Background" 'string device)))
+ (x-get-resource "pointerBackground" "Background" 'string device
+ nil 'warn)))
(and bg
(set-face-background 'pointer bg)))
(setq x-pointers-initialized t))