[COMMIT] Make my Lisp a little more sophisticated, select.el.

APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1299618036 0 # Node ID 0f9aa4eb4bece8c5ca3a200b6458daf60088bef0 # Parent 311f6817efc24a2f7946186eaed71e20bc6ed5ab Make my Lisp a little more sophisticated, select.el. 2011-03-08 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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. diff -r 311f6817efc2 -r 0f9aa4eb4bec lisp/ChangeLog --- a/lisp/ChangeLog Tue Mar 08 18:12:48 2011 +0000 +++ b/lisp/ChangeLog Tue Mar 08 21:00:36 2011 +0000 ＠＠ -1,3 +1,17 ＠＠ +2011-03-08 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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. + 2011-03-08 Aidan Kehoe <kehoea(a)parhasard.net&gt; * package-ui.el (pui-add-required-packages): diff -r 311f6817efc2 -r 0f9aa4eb4bec lisp/select.el --- a/lisp/select.el Tue Mar 08 18:12:48 2011 +0000 +++ b/lisp/select.el Tue Mar 08 21:00:36 2011 +0000 ＠＠ -38,10 +38,11 ＠＠ ;; Mozilla will happily give us broken COMPOUND_TEXT where a non-broken ;; UTF8_STRING is available. (defvar selection-preferred-types - (let ((res '(UTF8_STRING COMPOUND_TEXT STRING image/png image/gif - image/jpeg image/tiff image/xpm image/xbm))) - (unless (featurep 'mule) (delq 'COMPOUND_TEXT res)) - res) + `(UTF8_STRING ,＠(and (featurep 'mule) '(COMPOUND_TEXT)) STRING + ,＠(mapcan #'(lambda (format) + (and (featurep format) + (list (intern (format "image/%s" format))))) + '(png gif jpeg tiff xpm xbm))) "An ordered list of X11 type atoms for selections we want to receive. We prefer UTF8_STRING over COMPOUND_TEXT, for compatibility with a certain widely-used browser suite, and COMPOUND_TEXT over STRING. (COMPOUND_TEXT ＠＠ -379,7 +380,7 ＠＠ (buffer-live-p (marker-buffer (cdr data)))))) (defun cut-copy-clear-internal (mode) - (or (memq mode '(cut copy clear)) (error "unkown mode %S" mode)) + (or (memq mode '(cut copy clear)) (error "unknown mode %S" mode)) (or (selection-owner-p) (error "XEmacs does not own the primary selection")) (setq last-command nil) ＠＠ -777,26 +778,19 ＠＠ (set-extent-end-glyph extent glyph) str))) -;; Could automate defining these functions these with a macro, but damned if -;; I can get that to work. Anyway, this is more readable. - -(defun select-convert-from-image/gif (selection type value) - (if (featurep 'gif) (select-convert-from-image-data 'gif value))) - -(defun select-convert-from-image/jpeg (selection type value) - (if (featurep 'jpeg) (select-convert-from-image-data 'jpeg value))) - -(defun select-convert-from-image/png (selection type value) - (if (featurep 'png) (select-convert-from-image-data 'png value))) - -(defun select-convert-from-image/tiff (selection type value) - (if (featurep 'tiff) (select-convert-from-image-data 'tiff value))) - -(defun select-convert-from-image/xpm (selection type value) - (if (featurep 'xpm) (select-convert-from-image-data 'xpm value))) - -(defun select-convert-from-image/xbm (selection type value) - (if (featurep 'xbm) (select-convert-from-image-data 'xbm value))) +(macrolet + ((create-image-functions (&rest formats) + (cons + 'progn + (mapcar + #'(lambda (format) + `(if (featurep ',format) + (defalias (intern (concat "select-convert-from-image/" + ,(symbol-name format))) + #'(lambda (selection type value) + (select-convert-from-image-data ',format + value))))) formats)))) + (create-image-functions gif jpeg png tiff xpm xbm)) ;;; CF_xxx conversions (defun select-convert-from-cf-text (selection type value) ＠＠ -931,7 +925,7 ＠＠ ;; Types listed here can be selections foreign to XEmacs (setq selection-converter-in-alist - '(; Specific types that get handled by generic converters + `(; Specific types that get handled by generic converters (INTEGER . select-convert-from-integer) (TIMESTAMP . select-convert-from-integer) (LENGTH . select-convert-from-integer) ＠＠ -948,13 +942,12 ＠＠ (text/html . select-convert-from-utf-16-le-text) ; Mozilla (text/_moz_htmlcontext . select-convert-from-utf-16-le-text) (text/_moz_htmlinfo . select-convert-from-utf-16-le-text) - (image/png . select-convert-from-image/png) - (image/gif . select-convert-from-image/gif) - (image/jpeg . select-convert-from-image/jpeg ) - (image/tiff . select-convert-from-image/tiff ) - (image/xpm . select-convert-from-image/xpm) - (image/xbm . select-convert-from-image/xbm) - )) + ,＠(loop + for format in '(gif jpeg png tiff xpm xbm) + nconc (if (featurep format) + (list (cons (intern (format "image/%s" format)) + (intern (format "select-convert-from-image/%s" + format)))))))) ;; Types listed here have special coercion functions that can munge ;; other types. This can also be used to add special features - e.g. -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches