Mercurial > hg > xemacs-beta

comparison lisp/select.el @ 5364:0f9aa4eb4bec

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Make my Lisp a little more sophisticated, select.el. 2011-03-08 Aidan Kehoe <kehoea@parhasard.net> * select.el (selection-preferred-types): * select.el (cut-copy-clear-internal): * select.el (create-image-functions): * select.el (select-convert-from-image/gif): * select.el (select-convert-from-image/jpeg): * select.el (select-convert-from-image/png): * select.el (select-convert-from-image/tiff): * select.el (select-convert-from-image/xpm): * select.el (select-convert-from-image/xbm): * select.el (selection-converter-in-alist): Make my Lisp a little more sophisticated in this file.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 08 Mar 2011 21:00:36 +0000
parents 2a54dfbe434f
children ed74d2ca7082
comparison
equal deleted inserted replaced
5363:311f6817efc2 5364:0f9aa4eb4bec
36 ;; We prefer UTF8_STRING to COMPOUND_TEXT because, even though the latter 36 ;; We prefer UTF8_STRING to COMPOUND_TEXT because, even though the latter
37 ;; gives us more information when taking data from other XEmacs invocations, 37 ;; gives us more information when taking data from other XEmacs invocations,
38 ;; Mozilla will happily give us broken COMPOUND_TEXT where a non-broken 38 ;; Mozilla will happily give us broken COMPOUND_TEXT where a non-broken
39 ;; UTF8_STRING is available. 39 ;; UTF8_STRING is available.
40 (defvar selection-preferred-types 40 (defvar selection-preferred-types
41 (let ((res '(UTF8_STRING COMPOUND_TEXT STRING image/png image/gif 41 `(UTF8_STRING ,@(and (featurep 'mule) '(COMPOUND_TEXT)) STRING
42 image/jpeg image/tiff image/xpm image/xbm))) 42 ,@(mapcan #'(lambda (format)
43 (unless (featurep 'mule) (delq 'COMPOUND_TEXT res)) 43 (and (featurep format)
44 res) 44 (list (intern (format "image/%s" format)))))
45 '(png gif jpeg tiff xpm xbm)))
45 "An ordered list of X11 type atoms for selections we want to receive. 46 "An ordered list of X11 type atoms for selections we want to receive.
46 We prefer UTF8_STRING over COMPOUND_TEXT, for compatibility with a certain 47 We prefer UTF8_STRING over COMPOUND_TEXT, for compatibility with a certain
47 widely-used browser suite, and COMPOUND_TEXT over STRING. (COMPOUND_TEXT 48 widely-used browser suite, and COMPOUND_TEXT over STRING. (COMPOUND_TEXT
48 isn't available on non-Mule.) We also accept several image types. 49 isn't available on non-Mule.) We also accept several image types.
49 50
377 (marker-buffer (cdr data))) 378 (marker-buffer (cdr data)))
378 (buffer-live-p (marker-buffer (car data))) 379 (buffer-live-p (marker-buffer (car data)))
379 (buffer-live-p (marker-buffer (cdr data)))))) 380 (buffer-live-p (marker-buffer (cdr data))))))
380 381
381 (defun cut-copy-clear-internal (mode) 382 (defun cut-copy-clear-internal (mode)
382 (or (memq mode '(cut copy clear)) (error "unkown mode %S" mode)) 383 (or (memq mode '(cut copy clear)) (error "unknown mode %S" mode))
383 (or (selection-owner-p) 384 (or (selection-owner-p)
384 (error "XEmacs does not own the primary selection")) 385 (error "XEmacs does not own the primary selection"))
385 (setq last-command nil) 386 (setq last-command nil)
386 (or primary-selection-extent 387 (or primary-selection-extent
387 (error "the primary selection is not an extent?")) 388 (error "the primary selection is not an extent?"))
775 (set-extent-property extent 'duplicable t) 776 (set-extent-property extent 'duplicable t)
776 (set-extent-property extent 'atomic t) 777 (set-extent-property extent 'atomic t)
777 (set-extent-end-glyph extent glyph) 778 (set-extent-end-glyph extent glyph)
778 str))) 779 str)))
779 780
780 ;; Could automate defining these functions these with a macro, but damned if 781 (macrolet
781 ;; I can get that to work. Anyway, this is more readable. 782 ((create-image-functions (&rest formats)
782 783 (cons
783 (defun select-convert-from-image/gif (selection type value) 784 'progn
784 (if (featurep 'gif) (select-convert-from-image-data 'gif value))) 785 (mapcar
785 786 #'(lambda (format)
786 (defun select-convert-from-image/jpeg (selection type value) 787 `(if (featurep ',format)
787 (if (featurep 'jpeg) (select-convert-from-image-data 'jpeg value))) 788 (defalias (intern (concat "select-convert-from-image/"
788 789 ,(symbol-name format)))
789 (defun select-convert-from-image/png (selection type value) 790 #'(lambda (selection type value)
790 (if (featurep 'png) (select-convert-from-image-data 'png value))) 791 (select-convert-from-image-data ',format
791 792 value))))) formats))))
792 (defun select-convert-from-image/tiff (selection type value) 793 (create-image-functions gif jpeg png tiff xpm xbm))
793 (if (featurep 'tiff) (select-convert-from-image-data 'tiff value)))
794
795 (defun select-convert-from-image/xpm (selection type value)
796 (if (featurep 'xpm) (select-convert-from-image-data 'xpm value)))
797
798 (defun select-convert-from-image/xbm (selection type value)
799 (if (featurep 'xbm) (select-convert-from-image-data 'xbm value)))
800 794
801 ;;; CF_xxx conversions 795 ;;; CF_xxx conversions
802 (defun select-convert-from-cf-text (selection type value) 796 (defun select-convert-from-cf-text (selection type value)
803 (if (find-coding-system 'mswindows-multibyte) 797 (if (find-coding-system 'mswindows-multibyte)
804 (let ((value (decode-coding-string value 'mswindows-multibyte))) 798 (let ((value (decode-coding-string value 'mswindows-multibyte)))
929 (CF_UNICODETEXT . select-convert-to-cf-unicodetext) 923 (CF_UNICODETEXT . select-convert-to-cf-unicodetext)
930 )) 924 ))
931 925
932 ;; Types listed here can be selections foreign to XEmacs 926 ;; Types listed here can be selections foreign to XEmacs
933 (setq selection-converter-in-alist 927 (setq selection-converter-in-alist
934 '(; Specific types that get handled by generic converters 928 `(; Specific types that get handled by generic converters
935 (INTEGER . select-convert-from-integer) 929 (INTEGER . select-convert-from-integer)
936 (TIMESTAMP . select-convert-from-integer) 930 (TIMESTAMP . select-convert-from-integer)
937 (LENGTH . select-convert-from-integer) 931 (LENGTH . select-convert-from-integer)
938 (LIST_LENGTH . select-convert-from-integer) 932 (LIST_LENGTH . select-convert-from-integer)
939 (CLIENT_WINDOW . select-convert-from-integer) 933 (CLIENT_WINDOW . select-convert-from-integer)
946 (CF_TEXT . select-convert-from-cf-text) 940 (CF_TEXT . select-convert-from-cf-text)
947 (CF_UNICODETEXT . select-convert-from-cf-unicodetext) 941 (CF_UNICODETEXT . select-convert-from-cf-unicodetext)
948 (text/html . select-convert-from-utf-16-le-text) ; Mozilla 942 (text/html . select-convert-from-utf-16-le-text) ; Mozilla
949 (text/_moz_htmlcontext . select-convert-from-utf-16-le-text) 943 (text/_moz_htmlcontext . select-convert-from-utf-16-le-text)
950 (text/_moz_htmlinfo . select-convert-from-utf-16-le-text) 944 (text/_moz_htmlinfo . select-convert-from-utf-16-le-text)
951 (image/png . select-convert-from-image/png) 945 ,@(loop
952 (image/gif . select-convert-from-image/gif) 946 for format in '(gif jpeg png tiff xpm xbm)
953 (image/jpeg . select-convert-from-image/jpeg ) 947 nconc (if (featurep format)
954 (image/tiff . select-convert-from-image/tiff ) 948 (list (cons (intern (format "image/%s" format))
955 (image/xpm . select-convert-from-image/xpm) 949 (intern (format "select-convert-from-image/%s"
956 (image/xbm . select-convert-from-image/xbm) 950 format))))))))
957 ))
958 951
959 ;; Types listed here have special coercion functions that can munge 952 ;; Types listed here have special coercion functions that can munge
960 ;; other types. This can also be used to add special features - e.g. 953 ;; other types. This can also be used to add special features - e.g.
961 ;; being able to pass a region or a cons of markers to own-selection, 954 ;; being able to pass a region or a cons of markers to own-selection,
962 ;; but getting the *current* text in the region back when calling 955 ;; but getting the *current* text in the region back when calling