Mercurial > hg > xemacs-beta

comparison lisp/select.el @ 5618:cc1ec4c93a67

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Improve Lisp style in a few places, select.el lisp/ChangeLog addition: 2011-12-23 Aidan Kehoe <kehoea@parhasard.net> * select.el (activate-region-as-selection): * select.el (select-make-extent-for-selection): * select.el (select-convert-in): * select.el (select-convert-out): * select.el (select-coerce): * select.el (select-convert-to-targets): Improve Lisp style in a few places here; don't re-implement #'delete-duplicates, use #'funcall instead of consing up a list to pass to #'apply.
author Aidan Kehoe <kehoea@parhasard.net>
date Fri, 23 Dec 2011 10:34:40 +0000
parents 5273dd66a1ba
children 0df3cedee9ac
comparison
equal deleted inserted replaced
5617:b0d712bbc2a6 5618:cc1ec4c93a67
254 "Assuming we own the selection, disown it. 254 "Assuming we own the selection, disown it.
255 With an argument, discard the secondary selection instead of the 255 With an argument, discard the secondary selection instead of the
256 primary selection." 256 primary selection."
257 (disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY)) 257 (disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY))
258 (when (and selection-sets-clipboard 258 (when (and selection-sets-clipboard
259 (or (not secondary-p) 259 (memq secondary-p '(nil PRIMARY CLIPBOARD)))
260 (eq secondary-p 'PRIMARY)
261 (eq secondary-p 'CLIPBOARD)))
262 (disown-selection-internal 'CLIPBOARD))) 260 (disown-selection-internal 'CLIPBOARD)))
263 261
264 ;; selections and active regions 262 ;; selections and active regions
265 263
266 ;; If and only if zmacs-regions is true: 264 ;; If and only if zmacs-regions is true:
426 ;; These next three functions get called by C code... 424 ;; These next three functions get called by C code...
427 (defun select-convert-in (selection type value) 425 (defun select-convert-in (selection type value)
428 "Attempt to convert the specified external VALUE to the specified DATA-TYPE, 426 "Attempt to convert the specified external VALUE to the specified DATA-TYPE,
429 for the specified SELECTION. Return nil if this is impossible, or a 427 for the specified SELECTION. Return nil if this is impossible, or a
430 suitable internal representation otherwise." 428 suitable internal representation otherwise."
431 (when value 429 (and value
432 (let ((handler-fn (cdr (assq type selection-converter-in-alist)))) 430 (funcall (or (cdr (assq type selection-converter-in-alist)) #'ignore)
433 (if handler-fn 431 selection type value)))
434 (apply handler-fn (list selection type value))
435 value))))
436 432
437 (defun select-convert-out (selection type value) 433 (defun select-convert-out (selection type value)
438 "Attempt to convert the specified internal VALUE for the specified DATA-TYPE 434 "Attempt to convert the specified internal VALUE for the specified DATA-TYPE
439 and SELECTION. Return nil if this is impossible, or a suitable external 435 and SELECTION. Return nil if this is impossible, or a suitable external
440 representation otherwise." 436 representation otherwise."
441 (when value 437 (and value
442 (let ((handler-fn (cdr (assq type selection-converter-out-alist)))) 438 (funcall (or (cdr (assq type selection-converter-out-alist)) #'ignore)
443 (when handler-fn 439 selection type value)))
444 (apply handler-fn (list selection type value))))))
445 440
446 (defun select-coerce (selection type value) 441 (defun select-coerce (selection type value)
447 "Attempt to convert the specified internal VALUE to a representation 442 "Attempt to convert the specified internal VALUE to a representation
448 suitable for return from `get-selection' in the specified DATA-TYPE. Return 443 suitable for return from `get-selection' in the specified DATA-TYPE. Return
449 nil if this is impossible, or a suitable representation otherwise." 444 nil if this is impossible, or a suitable representation otherwise."
450 (when value 445 (and value
451 (let ((handler-fn (cdr (assq type selection-coercion-alist)))) 446 (funcall (or (cdr (assq type selection-conversion-alist)) #'ignore)
452 (when handler-fn 447 selection type value)))
453 (apply handler-fn (list selection type value))))))
454 448
455 ;; The rest of the functions on this "page" are conversion handlers, 449 ;; The rest of the functions on this "page" are conversion handlers,
456 ;; append handlers and buffer-kill handlers. 450 ;; append handlers and buffer-kill handlers.
457 (defun select-convert-to-text (selection type value) 451 (defun select-convert-to-text (selection type value)
458 (cond ((stringp value) 452 (cond ((stringp value)
548 (cons (ash value -16) (logand value 65535)) 542 (cons (ash value -16) (logand value 65535))
549 nil))) 543 nil)))
550 544
551 (defun select-convert-to-targets (selection type value) 545 (defun select-convert-to-targets (selection type value)
552 ;; return a vector of atoms, but remove duplicates first. 546 ;; return a vector of atoms, but remove duplicates first.
553 (let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist))) 547 (delete-duplicates (map 'vector #'car selection-converter-out-alist)))
554 (rest all))
555 (while rest
556 (cond ((memq (car rest) (cdr rest))
557 (setcdr rest (delq (car rest) (cdr rest))))
558 (t
559 (setq rest (cdr rest)))))
560 (apply 'vector all)))
561 548
562 (defun select-convert-to-delete (selection type value) 549 (defun select-convert-to-delete (selection type value)
563 (disown-selection-internal selection) 550 (disown-selection-internal selection)
564 ;; A return value of nil means that we do not know how to do this conversion, 551 ;; A return value of nil means that we do not know how to do this conversion,
565 ;; and replies with an "error". A return value of NULL means that we have 552 ;; and replies with an "error". A return value of NULL means that we have