Starting a Cygwin XEmacs built with XFT support without setting DISPLAY aborts with a backtrace, as a result of Face-frob-property calling the X11 frobbing functions with a mswindows device and the XFT libraries objecting to that, quite reasonably. With server-side font support, x-make-font-bold and friends silently accept a mswindows-device, and that’s why this problem wasn’t seen previously. There are other functions that accept CURRENT-DEVICE and that don’t seem to be quite sane in their treatment of it, but I’m not going to look into them right now. lisp/ChangeLog addition: 2007-04-22 Aidan Kehoe <kehoea(a)parhasard.net&gt; * specifier.el (device-type-matches-spec): Add `msprinter' to the type of devices that are not window systems. * specifier.el (derive-device-type-from-tag-set): Remove a superflous empty line. * specifier.el (derive-device-type-from-locale-and-tag-set): If CURRENT-DEVICE is provided, only ever return its type (if it matches TAG-SET) or nil (if it doesn't). XEmacs Trunk source patch: Diff command: cvs -q diff -Nu Files affected: lisp/specifier.el =================================================================== RCS Index: lisp/specifier.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/specifier.el,v retrieving revision 1.15 diff -u -u -r1.15 specifier.el --- lisp/specifier.el 2005/11/13 07:39:28 1.15 +++ lisp/specifier.el 2007/04/22 14:50:59 ＠＠ -739,7 +739,7 ＠＠ ;; OK), or `window-system' -- window system device types OK. (cond ((not devtype-spec) devtype) ((eq devtype-spec 'window-system) - (and (not (memq devtype '(tty stream))) devtype)) + (and (not (memq devtype '(msprinter tty stream))) devtype)) (t (and (eq devtype devtype-spec) devtype)))) (defun add-tag-to-inst-list (inst-list tag-set) ＠＠ -815,7 +815,10 ＠＠ devtype-spec current-device) "Given a tag set, try (heuristically) to get a device type from it. -There are three stages that this function proceeds through, each one trying +If CURRENT-DEVICE is supplied, then this function either returns its type, +in the event that it matches TAG-SET, or nil. + +Otherwise, there are three stages that it proceeds through, each one trying harder than the previous to get a value. TRY-STAGES controls how many stages to try. If nil or 1, only stage 1 is done; if 2; stages 1 and 2 are done; if 3, stages 1-3 are done; if t, all stages are done (currently 1-3). ＠＠ -847,39 +850,48 ＠＠ (if (eq try-stages t) (setq try-stages 3)) (check-argument-range try-stages 1 3) (flet ((delete-wrong-type (x) - (delete-if-not - #'(lambda (y) - (device-type-matches-spec y devtype-spec)) - x))) - (let ((both (intersection (device-type-list) - (canonicalize-tag-set tag-set)))) + (delete-if-not + #'(lambda (y) + (device-type-matches-spec y devtype-spec)) + x))) + (let ((both (intersection + (if current-device + (list (device-type current-device)) + (device-type-list)) + (canonicalize-tag-set tag-set)))) ;; shouldn't be more than one (will fail), but whatever (if both (first (delete-wrong-type both)) - (and (>= try-stages 2) - ;; no device types mentioned. try the hard way, - ;; i.e. check each existing device to see if it will - ;; pass muster. - (let ((okdevs - (delete-wrong-type - (delete-duplicates - (mapcan - #'(lambda (dev) - (and (device-matches-specifier-tag-set-p - dev tag-set) - (list (device-type dev)))) - (device-list))))) - (devtype (cond ((or (null devtype-spec) - (eq devtype-spec 'window-system)) - (let ((dev (derive-domain-from-locale - 'global devtype-spec - current-device))) - (and dev (device-type dev)))) - (t devtype-spec)))) - (cond ((= 1 (length okdevs)) (car okdevs)) - ((< try-stages 3) nil) - ((null okdevs) devtype) - ((memq devtype okdevs) devtype) - (t (car okdevs))))))))) + (and (>= try-stages 2) + ;; no device types mentioned. try the hard way, + ;; i.e. check each existing device (or the + ;; supplied device) to see if it will pass muster. + ;; + ;; Further checking is not relevant if current-device was + ;; supplied. + (not current-device) + (let ((okdevs + (delete-wrong-type + (delete-duplicates + (mapcan + #'(lambda (dev) + (and (device-matches-specifier-tag-set-p + dev tag-set) + (list (device-type dev)))) + (if current-device + (list current-device) + (device-list)))))) + (devtype (cond ((or (null devtype-spec) + (eq devtype-spec 'window-system)) + (let ((dev (derive-domain-from-locale + 'global devtype-spec + current-device))) + (and dev (device-type dev)))) + (t devtype-spec)))) + (cond ((= 1 (length okdevs)) (car okdevs)) + ((< try-stages 3) nil) + ((null okdevs) devtype) + ((memq devtype okdevs) devtype) + (t (car okdevs))))))))) ;; Sheesh, the things you do to get "intuitive" behavior. (defun derive-device-type-from-locale-and-tag-set (locale tag-set ＠＠ -895,7 +907,6 ＠＠ type from the tag set. DEVTYPE-SPEC and CURRENT-DEVICE as in `derive-domain-from-locale'." - (cond ((valid-specifier-domain-p locale) ;; if locale is a domain, then it must match DEVTYPE-SPEC, ;; or we exit immediately with nil. -- On the quay of the little Black Sea port, where the rescued pair came once more into contact with civilization, Dobrinton was bitten by a dog which was assumed to be mad, though it may only have been indiscriminating. (Saki) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches