Mercurial > hg > xemacs-beta
annotate lisp/x-mouse.el @ 5820:b3824b7f5627
Some changes to eliminate warnings with Apple clang version 1.7.
src/ChangeLog addition:
2014-10-18 Aidan Kehoe <kehoea@parhasard.net>
Some changes to eliminate warnings with Apple clang version 1.7.
* cm.c (send_string_to_tty_console):
* doprnt.c (doprnt_2):
* doprnt.c (parse_off_posnum):
* event-stream.c (dribble_out_event):
Cast various calls to Lstream_putc() to void when the result isn't
being used, for the sake of clang.
* lisp.h:
Declare #'replace here too, it's used in event-stream.c.
* lisp.h (ALLOCA):
* lisp.h (MALLOC_OR_ALLOCA):
Cast a couple of zeros in the context of the ternary operator to
void to prevent unused value warnings with clang.
* sysdep.c (child_setup_tty):
* text.h (ASSERT_ASCTEXT_ASCII_LEN):
Use DO_NOTHING in these files to quieten the compiler.
lib-src/ChangeLog addition:
2014-10-18 Aidan Kehoe <kehoea@parhasard.net>
* ootags.c (substitute):
Cast the result of strlen to int before comparing it with a signed
value, for the sake of compiler warnings.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 18 Oct 2014 21:48:10 +0100 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; x-mouse.el --- Mouse support for X window system. |
| 2 | |
| 3 ;; Copyright (C) 1985, 1992-4, 1997 Free Software Foundation, Inc. | |
| 4 ;; Copyright (C) 1995, 1996 Ben Wing. | |
| 5 | |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: mouse, dumped | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
502
diff
changeset
|
11 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
502
diff
changeset
|
12 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
502
diff
changeset
|
13 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
502
diff
changeset
|
14 ;; option) any later version. |
| 428 | 15 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
502
diff
changeset
|
16 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
502
diff
changeset
|
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
502
diff
changeset
|
18 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
502
diff
changeset
|
19 ;; for more details. |
| 428 | 20 |
| 21 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
502
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 23 |
| 24 ;;; Synched up with: Not synched. | |
| 25 | |
| 26 ;;; Commentary: | |
| 27 | |
| 28 ;; This file is dumped with XEmacs (when X support is compiled in). | |
| 29 | |
| 30 ;;; Code: | |
| 31 | |
| 502 | 32 (globally-declare-fboundp |
| 33 '(x-store-cutbuffer x-get-resource)) | |
| 34 | |
| 428 | 35 ;;(define-key global-map 'button2 'x-set-point-and-insert-selection) |
| 36 ;; This is reserved for use by Hyperbole. | |
| 37 ;;(define-key global-map '(shift button2) 'x-mouse-kill) | |
| 38 (define-key global-map '(control button2) 'x-set-point-and-move-selection) | |
| 39 | |
| 40 (define-obsolete-function-alias 'x-insert-selection 'insert-selection) | |
| 41 | |
| 42 (defun x-mouse-kill (event) | |
| 43 "Kill the text between the point and mouse and copy it to the clipboard and | |
| 444 | 44 to the cut buffer." |
| 428 | 45 (interactive "@e") |
| 46 (let ((old-point (point))) | |
| 47 (mouse-set-point event) | |
| 48 (let ((s (buffer-substring old-point (point)))) | |
| 49 (own-clipboard s) | |
| 50 (x-store-cutbuffer s)) | |
| 51 (kill-region old-point (point)))) | |
| 52 | |
| 53 (make-obsolete 'x-set-point-and-insert-selection 'mouse-yank) | |
| 54 (defun x-set-point-and-insert-selection (event) | |
| 55 "Set point where clicked and insert the primary selection or the cut buffer." | |
| 56 (interactive "e") | |
| 57 (let ((mouse-yank-at-point nil)) | |
| 58 (mouse-yank event))) | |
| 59 | |
| 60 (defun x-set-point-and-move-selection (event) | |
| 61 "Set point where clicked and move the selected text to that location." | |
| 62 (interactive "e") | |
| 63 ;; Don't try to move the selection if x-kill-primary-selection if going | |
| 64 ;; to fail; just let the appropriate error message get issued. (We need | |
| 65 ;; to insert the selection and set point first, or the selection may | |
| 66 ;; get inserted at the wrong place.) | |
| 67 (and (selection-owner-p) | |
| 68 primary-selection-extent | |
| 69 (insert-selection t event)) | |
| 70 (kill-primary-selection)) | |
| 71 | |
| 72 (defun mouse-track-and-copy-to-cutbuffer (event) | |
| 73 "Make a selection like `mouse-track', but also copy it to the cutbuffer." | |
| 74 (interactive "e") | |
| 75 (mouse-track event) | |
| 76 (cond | |
| 77 ((null primary-selection-extent) | |
| 78 nil) | |
| 79 ((consp primary-selection-extent) | |
| 80 (save-excursion | |
| 81 (set-buffer (extent-object (car primary-selection-extent))) | |
| 82 (x-store-cutbuffer | |
| 83 (mapconcat | |
| 84 #'identity | |
| 85 (extract-rectangle | |
| 86 (extent-start-position (car primary-selection-extent)) | |
| 87 (extent-end-position (car (reverse primary-selection-extent)))) | |
| 88 "\n")))) | |
| 89 (t | |
| 90 (save-excursion | |
| 91 (set-buffer (extent-object primary-selection-extent)) | |
| 92 (x-store-cutbuffer | |
| 93 (buffer-substring (extent-start-position primary-selection-extent) | |
| 94 (extent-end-position primary-selection-extent))))))) | |
| 95 | |
| 96 | |
| 97 (defvar x-pointers-initialized nil) | |
| 98 | |
| 99 (defun x-init-pointer-shape (device) | |
| 100 "Initialize the mouse-pointers of DEVICE from the X resource database." | |
| 101 (if x-pointers-initialized ; only do it when the first device is created | |
| 102 nil | |
| 103 (set-glyph-image text-pointer-glyph | |
| 442 | 104 (or (x-get-resource "textPointer" "Cursor" 'string device nil 'warn) |
| 446 | 105 [cursor-font :data "xterm"])) |
| 428 | 106 (set-glyph-image selection-pointer-glyph |
| 442 | 107 (or (x-get-resource "selectionPointer" "Cursor" 'string device |
| 108 nil 'warn) | |
| 446 | 109 [cursor-font :data "top_left_arrow"])) |
| 428 | 110 (set-glyph-image nontext-pointer-glyph |
| 442 | 111 (or (x-get-resource "spacePointer" "Cursor" 'string device nil 'warn) |
| 446 | 112 [cursor-font :data "xterm"])) ; was "crosshair" |
| 428 | 113 (set-glyph-image modeline-pointer-glyph |
| 442 | 114 (or (x-get-resource "modeLinePointer" "Cursor" 'string device |
| 115 nil 'warn) | |
| 428 | 116 ;; "fleur")) |
| 446 | 117 [cursor-font :data "sb_v_double_arrow"])) |
| 428 | 118 (set-glyph-image gc-pointer-glyph |
| 442 | 119 (or (x-get-resource "gcPointer" "Cursor" 'string device nil 'warn) |
| 446 | 120 [cursor-font :data "watch"])) |
| 428 | 121 (when (featurep 'scrollbar) |
| 122 (set-glyph-image | |
| 123 scrollbar-pointer-glyph | |
| 442 | 124 (or (x-get-resource "scrollbarPointer" "Cursor" 'string device |
| 125 nil 'warn) | |
| 446 | 126 ;; bizarrely if we don't specify the specific locale (x) this |
| 127 ;; gets instantiated on the stream device. Bad puppy. | |
| 128 [cursor-font :data "top_left_arrow"]) 'global '(default x))) | |
| 428 | 129 (set-glyph-image busy-pointer-glyph |
| 442 | 130 (or (x-get-resource "busyPointer" "Cursor" 'string device nil 'warn) |
| 446 | 131 [cursor-font :data "watch"])) |
| 428 | 132 (set-glyph-image toolbar-pointer-glyph |
| 442 | 133 (or (x-get-resource "toolBarPointer" "Cursor" 'string device |
| 134 nil 'warn) | |
| 446 | 135 [cursor-font :data "left_ptr"])) |
| 428 | 136 (set-glyph-image divider-pointer-glyph |
| 442 | 137 (or (x-get-resource "dividerPointer" "Cursor" 'string device |
| 138 nil 'warn) | |
| 446 | 139 [cursor-font :data "sb_h_double_arrow"])) |
| 428 | 140 (let ((fg |
| 442 | 141 (x-get-resource "pointerColor" "Foreground" 'string device |
| 142 nil 'warn))) | |
| 428 | 143 (and fg |
| 144 (set-face-foreground 'pointer fg))) | |
| 145 (let ((bg | |
| 442 | 146 (x-get-resource "pointerBackground" "Background" 'string device |
| 147 nil 'warn))) | |
| 428 | 148 (and bg |
| 149 (set-face-background 'pointer bg))) | |
| 150 (setq x-pointers-initialized t)) | |
| 151 nil) | |
| 152 | |
| 153 ;;; x-mouse.el ends here |