Mercurial > hg > xemacs-beta

comparison lisp/select.el @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents 54fa1a5c2d12
children 42a86787d173
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
664 (defun select-convert-to-atom (selection type value) 664 (defun select-convert-to-atom (selection type value)
665 (and (symbolp value) value)) 665 (and (symbolp value) value))
666 666
667 ;;; CF_xxx conversions 667 ;;; CF_xxx conversions
668 (defun select-convert-from-cf-text (selection type value) 668 (defun select-convert-from-cf-text (selection type value)
669 (replace-in-string (if (string-match "\0" value) 669 (let ((value (decode-coding-string value 'mswindows-multibyte)))
670 (substring value 0 (match-beginning 0)) 670 (replace-in-string (if (string-match "\0" value)
671 value) 671 (substring value 0 (match-beginning 0))
672 "\\(\r\n\\|\n\r\\)" "\n" t)) 672 value)
673 "\\(\r\n\\|\n\r\\)" "\n" t)))
674
675 (defun select-convert-from-cf-unicodetext (selection type value)
676 (let ((value (decode-coding-string value 'mswindows-unicode)))
677 (replace-in-string (if (string-match "\0" value)
678 (substring value 0 (match-beginning 0))
679 value)
680 "\\(\r\n\\|\n\r\\)" "\n" t)))
673 681
674 (defun select-convert-to-cf-text (selection type value) 682 (defun select-convert-to-cf-text (selection type value)
675 (let ((text (select-convert-to-text selection type value))) 683 (let ((text (select-convert-to-text selection type value)))
676 (concat (replace-in-string text "\n" "\r\n" t) "\0"))) 684 (encode-coding-string
685 (concat (replace-in-string text "\n" "\r\n" t) "\0")
686 'mswindows-multibyte)))
687
688 (defun select-convert-to-cf-unicodetext (selection type value)
689 (let ((text (select-convert-to-text selection type value)))
690 (encode-coding-string
691 (concat (replace-in-string text "\n" "\r\n" t) "\0")
692 'mswindows-unicode)))
677 693
678 ;;; Appenders 694 ;;; Appenders
679 (defun select-append-to-text (selection type value1 value2) 695 (defun select-append-to-text (selection type value1 value2)
680 (let ((text1 (select-convert-to-text selection 'STRING value1)) 696 (let ((text1 (select-convert-to-text selection 'STRING value1))
681 (text2 (select-convert-to-text selection 'STRING value2))) 697 (text2 (select-convert-to-text selection 'STRING value2)))
692 (defun select-append-to-cf-text (selection type value1 value2) 708 (defun select-append-to-cf-text (selection type value1 value2)
693 (let ((text1 (select-convert-from-cf-text selection 'CF_TEXT value1)) 709 (let ((text1 (select-convert-from-cf-text selection 'CF_TEXT value1))
694 (text2 (select-convert-from-cf-text selection 'CF_TEXT value2))) 710 (text2 (select-convert-from-cf-text selection 'CF_TEXT value2)))
695 (if (and text1 text2) 711 (if (and text1 text2)
696 (select-convert-to-cf-text selection type (concat text1 text2)) 712 (select-convert-to-cf-text selection type (concat text1 text2))
713 nil)))
714
715 (defun select-append-to-cf-unicodetext (selection type value1 value2)
716 (let ((text1 (select-convert-from-cf-unicodetext selection
717 'CF_UNICODETEXT value1))
718 (text2 (select-convert-from-cf-unicodetext selection
719 'CF_UNICODETEXT value2)))
720 (if (and text1 text2)
721 (select-convert-to-cf-unicodetext selection type (concat text1 text2))
697 nil))) 722 nil)))
698 723
699 (defun select-append-default (selection type value1 value2) 724 (defun select-append-default (selection type value1 value2)
700 ;; This appender gets used if the type is "nil" - i.e. default. 725 ;; This appender gets used if the type is "nil" - i.e. default.
701 ;; It should probably have more cases implemented than it does - e.g. 726 ;; It should probably have more cases implemented than it does - e.g.
759 (CLASS . select-convert-to-class) 784 (CLASS . select-convert-to-class)
760 (NAME . select-convert-to-name) 785 (NAME . select-convert-to-name)
761 (ATOM . select-convert-to-atom) 786 (ATOM . select-convert-to-atom)
762 (INTEGER . select-convert-to-integer) 787 (INTEGER . select-convert-to-integer)
763 (CF_TEXT . select-convert-to-cf-text) 788 (CF_TEXT . select-convert-to-cf-text)
789 (CF_UNICODETEXT . select-convert-to-cf-unicodetext)
764 )) 790 ))
765 791
766 ;; Types listed here can be selections foreign to XEmacs 792 ;; Types listed here can be selections foreign to XEmacs
767 (setq selection-converter-in-alist 793 (setq selection-converter-in-alist
768 '(; Specific types that get handled by generic converters 794 '(; Specific types that get handled by generic converters
778 (TEXT . select-convert-from-text) 804 (TEXT . select-convert-from-text)
779 (STRING . select-convert-from-text) 805 (STRING . select-convert-from-text)
780 (LENGTH . select-convert-from-length) 806 (LENGTH . select-convert-from-length)
781 (FILE_NAME . select-convert-from-filename) 807 (FILE_NAME . select-convert-from-filename)
782 (CF_TEXT . select-convert-from-cf-text) 808 (CF_TEXT . select-convert-from-cf-text)
809 (CF_UNICODETEXT . select-convert-from-cf-unicodetext)
783 )) 810 ))
784 811
785 ;; Types listed here have special coercion functions that can munge 812 ;; Types listed here have special coercion functions that can munge
786 ;; other types. This can also be used to add special features - e.g. 813 ;; other types. This can also be used to add special features - e.g.
787 ;; being able to pass a region or a cons of markers to own-selection, 814 ;; being able to pass a region or a cons of markers to own-selection,
794 ;; values with types listed in selection-coercible-types. 821 ;; values with types listed in selection-coercible-types.
795 (setq selection-coercion-alist 822 (setq selection-coercion-alist
796 '((TEXT . select-coerce-to-text) 823 '((TEXT . select-coerce-to-text)
797 (STRING . select-coerce-to-text) 824 (STRING . select-coerce-to-text)
798 (COMPOUND_TEXT . select-coerce-to-text) 825 (COMPOUND_TEXT . select-coerce-to-text)
799 (CF_TEXT . select-coerce-to-text))) 826 (CF_TEXT . select-coerce-to-text)
827 (CF_UNICODETEXT . select-coerce-to-text)
828 ))
800 829
801 ;; Types listed here can be appended by own-selection 830 ;; Types listed here can be appended by own-selection
802 (setq selection-appender-alist 831 (setq selection-appender-alist
803 '((nil . select-append-default) 832 '((nil . select-append-default)
804 (TEXT . select-append-to-text) 833 (TEXT . select-append-to-text)
805 (STRING . select-append-to-string) 834 (STRING . select-append-to-string)
806 (COMPOUND_TEXT . select-append-to-compound-text) 835 (COMPOUND_TEXT . select-append-to-compound-text)
807 (CF_TEXT . select-append-to-cf-text) 836 (CF_TEXT . select-append-to-cf-text)
837 (CF_UNICODETEXT . select-append-to-cf-unicodetext)
808 )) 838 ))
809 839
810 ;; Types listed here have buffer-kill handlers 840 ;; Types listed here have buffer-kill handlers
811 (setq selection-buffer-killed-alist 841 (setq selection-buffer-killed-alist
812 '((nil . select-buffer-killed-default) 842 '((nil . select-buffer-killed-default)
813 (TEXT . select-buffer-killed-text) 843 (TEXT . select-buffer-killed-text)
814 (STRING . select-buffer-killed-text) 844 (STRING . select-buffer-killed-text)
815 (COMPOUND_TEXT . select-buffer-killed-text) 845 (COMPOUND_TEXT . select-buffer-killed-text)
816 (CF_TEXT . select-buffer-killed-text))) 846 (CF_TEXT . select-buffer-killed-text)
847 (CF_UNICODETEXT . select-buffer-killed-text)
848 ))
817 849
818 ;; Lists of types that are coercible (can be converted to other types) 850 ;; Lists of types that are coercible (can be converted to other types)
819 (setq selection-coercible-types '(TEXT STRING COMPOUND_TEXT)) 851 (setq selection-coercible-types '(TEXT STRING COMPOUND_TEXT CF_TEXT CF_UNICODETEXT))
820 852
821 ;;; select.el ends here 853 ;;; select.el ends here