Mercurial > hg > xemacs-beta

comparison lisp/select.el @ 851:e7ee5f8bde58

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-05-23 11:46:08 by ben] fix for raymond toy's crash, alloca crashes, some recover-session improvements files.el: Recover-session improvements: Only show session files where some files can actually be recovered, and show in chronological order. subr.el, menubar-items.el: As promised to rms, the functionality in truncate-string-with-continuation-dots has been merged into truncate-string-to-width. Change callers in menubar-items.el. select.el: Document some of these funs better. Fix problem where we were doing own-clipboard twice. Makefile.in.in: Add alloca.o. Ensure that alloca.s doesn't compile into alloca.o, but allocax.o (not that it's currently used or anything.) EmacsFrame.c, abbrev.c, alloc.c, alloca.c, callint.c, callproc.c, config.h.in, device-msw.c, device-x.c, dired.c, doc.c, editfns.c, emacs.c, emodules.c, eval.c, event-Xt.c, event-msw.c, event-stream.c, file-coding.c, fileio.c, filelock.c, fns.c, glyphs-gtk.c, glyphs-msw.c, glyphs-x.c, gui-x.c, input-method-xlib.c, intl-win32.c, lisp.h, lread.c, menubar-gtk.c, menubar-msw.c, menubar.c, mule-wnnfns.c, nt.c, objects-msw.c, process-nt.c, realpath.c, redisplay-gtk.c, redisplay-output.c, redisplay-x.c, redisplay.c, search.c, select-msw.c, sysdep.c, syswindows.h, text.c, text.h, ui-byhand.c: Fix Raymond Toy's crash. Repeat to self: 2^21 - 1 is NOT the same as (2 << 21) - 1. Fix crashes due to excessive alloca(). replace alloca() with ALLOCA(), which calls the C alloca() [which uses xmalloc()] when the size is too big. Insert in various places calls to try to flush the C alloca() stored info if there is any. Add MALLOC_OR_ALLOCA(), for places that expect to be alloca()ing large blocks. This xmalloc()s when too large and records an unwind-protect to free -- relying on the caller to unbind_to() elsewhere in the function. Use it in concat(). Use MALLOC instead of ALLOCA in select-msw.c. xemacs.mak: Add alloca.o.
author ben
date Thu, 23 May 2002 11:46:46 +0000
parents 74899b430f18
children 8174a45f637c
comparison
equal deleted inserted replaced
850:f915ad7befaf 851:e7ee5f8bde58
1 ;;; select.el --- Lisp interface to windows selections. 1 ;;; select.el --- Lisp interface to windows selections.
2 2
3 ;; Copyright (C) 1998 Andy Piper. 3 ;; Copyright (C) 1998 Andy Piper.
4 ;; Copyright (C) 1990, 1997 Free Software Foundation, Inc. 4 ;; Copyright (C) 1990, 1997 Free Software Foundation, Inc.
5 ;; Copyright (C) 1995 Sun Microsystems. 5 ;; Copyright (C) 1995 Sun Microsystems.
6 ;; Copyright (C) 2002 Ben Wing.
6 7
7 ;; Maintainer: XEmacs Development Team 8 ;; Maintainer: XEmacs Development Team
8 ;; Keywords: extensions, dumped 9 ;; Keywords: extensions, dumped
9 10
10 ;; This file is part of XEmacs. 11 ;; This file is part of XEmacs.
44 "Controls the selection's relationship to the clipboard. 45 "Controls the selection's relationship to the clipboard.
45 When non-nil, any operation that sets the primary selection will also 46 When non-nil, any operation that sets the primary selection will also
46 set the clipboard.") 47 set the clipboard.")
47 48
48 (defun copy-primary-selection () 49 (defun copy-primary-selection ()
49 "Copy the selection to the Clipboard and the kill ring." 50 "Copy the selection to the Clipboard and the kill ring.
51 This is similar to the command \\[kill-ring-save] except that it will
52 save to the Clipboard even if that command doesn't, and it handles rectangles
53 properly."
50 (interactive) 54 (interactive)
51 (and (console-on-window-system-p) 55 (and (console-on-window-system-p)
52 (cut-copy-clear-internal 'copy))) 56 (cut-copy-clear-internal 'copy)))
53 57
54 (defun kill-primary-selection () 58 (defun kill-primary-selection ()
55 "Copy the selection to the Clipboard and the kill ring, then delete it." 59 "Copy the selection to the Clipboard and the kill ring, then deleted it.
60 This is similar to the command \\[kill-region] except that it will
61 save to the Clipboard even if that command doesn't, and it handles rectangles
62 properly."
56 (interactive "*") 63 (interactive "*")
57 (and (console-on-window-system-p) 64 (and (console-on-window-system-p)
58 (cut-copy-clear-internal 'cut))) 65 (cut-copy-clear-internal 'cut)))
59 66
60 (defun delete-primary-selection () 67 (defun delete-primary-selection ()
128 The argument TYPE (default `PRIMARY') says which selection, 135 The argument TYPE (default `PRIMARY') says which selection,
129 and DATA specifies the contents. DATA may be any lisp data type 136 and DATA specifies the contents. DATA may be any lisp data type
130 that can be converted using the function corresponding to DATA-TYPE 137 that can be converted using the function corresponding to DATA-TYPE
131 in `select-converter-alist'---strings are the usual choice, but 138 in `select-converter-alist'---strings are the usual choice, but
132 other types may be permissible depending on the DATA-TYPE parameter 139 other types may be permissible depending on the DATA-TYPE parameter
133 (if DATA-TYPE is not supplied, the default behavior is window 140 \(if DATA-TYPE is not supplied, the default behavior is window
134 system specific, but strings are always accepted). 141 system specific, but strings are always accepted).
135 HOW-TO-ADD may be any of the following: 142 HOW-TO-ADD may be any of the following:
136 143
137 'replace-all or nil -- replace all data in the selection. 144 'replace-all or nil -- replace all data in the selection.
138 'replace-existing -- replace data for specified DATA-TYPE only. 145 'replace-existing -- replace data for specified DATA-TYPE only.
139 'append or t -- append data to existing DATA-TYPE data. 146 'append or t -- append data to existing DATA-TYPE data.
140 147
141 DATA-TYPE is the window-system specific data type identifier 148 DATA-TYPE is the window-system specific data type identifier
142 (see `register-selection-data-type' for more information). 149 \(see `register-selection-data-type' for more information).
143 150
144 The selection may also be a cons of two markers pointing to the same buffer, 151 The selection may also be a cons of two markers pointing to the same buffer,
145 or an overlay. In these cases, the selection is considered to be the text 152 or an overlay. In these cases, the selection is considered to be the text
146 between the markers *at whatever time the selection is examined* (note 153 between the markers *at whatever time the selection is examined* (note
147 that the window system clipboard does not necessarily duplicate this 154 that the window system clipboard does not necessarily duplicate this
353 e (extent-end-position primary-selection-extent)))) 360 e (extent-end-position primary-selection-extent))))
354 (set-buffer b) 361 (set-buffer b)
355 (cond ((memq mode '(cut copy)) 362 (cond ((memq mode '(cut copy))
356 (if rect-p 363 (if rect-p
357 (progn 364 (progn
358 ;; why is killed-rectangle free? Is it used somewhere? 365 ;; killed-rectangle is defvarred in rect.el
359 ;; should it be defvarred?
360 (setq killed-rectangle (extract-rectangle s e)) 366 (setq killed-rectangle (extract-rectangle s e))
361 (kill-new (mapconcat #'identity killed-rectangle "\n"))) 367 (kill-new (mapconcat #'identity killed-rectangle "\n")))
362 (copy-region-as-kill s e)) 368 (copy-region-as-kill s e))
363 ;; Maybe killing doesn't own clipboard. Make sure it happens. 369 ;; Maybe killing doesn't own clipboard. Make sure it happens.
364 ;; This memq is kind of grody, because they might have done it 370 ;; This memq is kind of grody, because they might have done it
365 ;; some other way, but owning the clipboard twice in that case 371 ;; some other way, but owning the clipboard twice in that case
366 ;; wouldn't actually hurt anything. 372 ;; wouldn't actually hurt anything.
367 (or (and (consp kill-hooks) (memq 'own-clipboard kill-hooks)) 373 (or (and (consp kill-hooks) (memq 'own-clipboard kill-hooks))
374 (eq 'own-clipboard interprogram-cut-function)
368 (own-clipboard (car kill-ring))))) 375 (own-clipboard (car kill-ring)))))
369 (cond ((memq mode '(cut clear)) 376 (cond ((memq mode '(cut clear))
370 (if rect-p 377 (if rect-p
371 (delete-rectangle s e) 378 (delete-rectangle s e)
372 (delete-region s e)))) 379 (delete-region s e))))