Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-sysdp.el @ 110:fe104dbd9147 r20-1b7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b7
author cvs
date Mon, 13 Aug 2007 09:19:45 +0200
parents 360340f9fd5f
children 8619ce7e4c50
comparison
equal deleted inserted replaced
109:e183fc049578 110:fe104dbd9147
656 656
657 (sysdep-defun try-font-name (fontname &rest args) 657 (sysdep-defun try-font-name (fontname &rest args)
658 (cond 658 (cond
659 ((eq window-system 'x) (car-safe (x-list-fonts fontname))) 659 ((eq window-system 'x) (car-safe (x-list-fonts fontname)))
660 ((eq window-system 'ns) (car-safe (ns-list-fonts fontname))) 660 ((eq window-system 'ns) (car-safe (ns-list-fonts fontname)))
661 ((eq window-system 'win32) (car-safe (x-list-fonts fontname)))
662 ((eq window-system 'pm) (car-safe (x-list-fonts fontname)))
661 (t nil))) 663 (t nil)))
662 664
663 (sysdep-defalias 'device-pixel-width 665 (sysdep-defalias 'device-pixel-width
664 (cond 666 (cond
665 ((and (eq window-system 'x) (fboundp 'x-display-pixel-width)) 667 ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-pixel-width))
666 'x-display-pixel-width) 668 'x-display-pixel-width)
667 ((and (eq window-system 'ns) (fboundp 'ns-display-pixel-width)) 669 ((and (eq window-system 'ns) (fboundp 'ns-display-pixel-width))
668 'ns-display-pixel-width) 670 'ns-display-pixel-width)
669 (t 'ignore))) 671 (t 'ignore)))
670 672
671 (sysdep-defalias 'device-pixel-height 673 (sysdep-defalias 'device-pixel-height
672 (cond 674 (cond
673 ((and (eq window-system 'x) (fboundp 'x-display-pixel-height)) 675 ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-pixel-height))
674 'x-display-pixel-height) 676 'x-display-pixel-height)
675 ((and (eq window-system 'ns) (fboundp 'ns-display-pixel-height)) 677 ((and (eq window-system 'ns) (fboundp 'ns-display-pixel-height))
676 'ns-display-pixel-height) 678 'ns-display-pixel-height)
677 (t 'ignore))) 679 (t 'ignore)))
678 680
679 (sysdep-defalias 'device-mm-width 681 (sysdep-defalias 'device-mm-width
680 (cond 682 (cond
681 ((and (eq window-system 'x) (fboundp 'x-display-mm-width)) 683 ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-mm-width))
682 'x-display-mm-width) 684 'x-display-mm-width)
683 ((and (eq window-system 'ns) (fboundp 'ns-display-mm-width)) 685 ((and (eq window-system 'ns) (fboundp 'ns-display-mm-width))
684 'ns-display-mm-width) 686 'ns-display-mm-width)
685 (t 'ignore))) 687 (t 'ignore)))
686 688
687 (sysdep-defalias 'device-mm-height 689 (sysdep-defalias 'device-mm-height
688 (cond 690 (cond
689 ((and (eq window-system 'x) (fboundp 'x-display-mm-height)) 691 ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-mm-height))
690 'x-display-mm-height) 692 'x-display-mm-height)
691 ((and (eq window-system 'ns) (fboundp 'ns-display-mm-height)) 693 ((and (eq window-system 'ns) (fboundp 'ns-display-mm-height))
692 'ns-display-mm-height) 694 'ns-display-mm-height)
693 (t 'ignore))) 695 (t 'ignore)))
694 696
695 (sysdep-defalias 'device-bitplanes 697 (sysdep-defalias 'device-bitplanes
696 (cond 698 (cond
697 ((and (eq window-system 'x) (fboundp 'x-display-planes)) 699 ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-planes))
698 'x-display-planes) 700 'x-display-planes)
699 ((and (eq window-system 'ns) (fboundp 'ns-display-planes)) 701 ((and (eq window-system 'ns) (fboundp 'ns-display-planes))
700 'ns-display-planes) 702 'ns-display-planes)
701 (t 'ignore))) 703 (t 'ignore)))
702 704
745 (let ((val (symbol-name (ns-display-visual-class)))) 747 (let ((val (symbol-name (ns-display-visual-class))))
746 (cond 748 (cond
747 ((string-match "color" val) 'color) 749 ((string-match "color" val) 'color)
748 ((string-match "gray-scale" val) 'grayscale) 750 ((string-match "gray-scale" val) 'grayscale)
749 (t 'mono)))))) 751 (t 'mono))))))
750 (t (function (lambda (&optional device) 'mono))))) 752 (t (function (lambda (&optional device) 'color)))))
751 753
752 (sysdep-defun device-class-list () 754 (sysdep-defun device-class-list ()
753 "Returns a list of valid device classes." 755 "Returns a list of valid device classes."
754 (list 'color 'grayscale 'mono)) 756 (list 'color 'grayscale 'mono))
755 757
784 (list 'tty))) 786 (list 'tty)))
785 787
786 (sysdep-defun valid-device-type-p (type) 788 (sysdep-defun valid-device-type-p (type)
787 "Given a TYPE, return t if it is valid." 789 "Given a TYPE, return t if it is valid."
788 (memq type (device-type-list))) 790 (memq type (device-type-list)))
789
790 791
791 ;; Extent stuff 792 ;; Extent stuff
792 (sysdep-fset 'delete-extent 'delete-overlay) 793 (sysdep-fset 'delete-extent 'delete-overlay)
793 (sysdep-fset 'extent-end-position 'overlay-end) 794 (sysdep-fset 'extent-end-position 'overlay-end)
794 (sysdep-fset 'extent-start-position 'overlay-start) 795 (sysdep-fset 'extent-start-position 'overlay-start)