cgit.sxemacs.org Git - sxemacs/blob - lisp/x-scrollbar.el

   1 ;;; x-scrollbar.el --- scrollbar resourcing and such.
   2
   3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1995 Sun Microsystems.
   5 ;; Copyright (C) 1995, 1996 Ben Wing.
   6
   7 ;; Author: Ben Wing <ben@xemacs.org>
   8 ;; Maintainer: SXEmacs Development Team
   9 ;; Keywords: extensions, dumped
  10
  11 ;; This file is part of SXEmacs.
  12
  13 ;; SXEmacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; SXEmacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Synched up with: Not synched.
  27
  28 ;;; Commentary:
  29
  30 ;; This file is dumped with SXEmacs (when X and menubar support is compiled in).
  31
  32 ;;; Code:
  33
  34 (defun x-init-scrollbar-from-resources (locale)
  35   (x-init-specifier-from-resources
  36    (specifier-fallback scrollbar-width) 'natnum locale
  37    '("scrollBarWidth" . "ScrollBarWidth")
  38    ;; The name strings are wrong, but the scrollbar name is
  39    ;; non-deterministic so it is a poor way to set a resource
  40    ;; for the scrollbar anyhow.
  41    (cond ((featurep 'athena-scrollbars)
  42           '("scrollbar.thickness" . "ScrollBar.Thickness"))
  43          ((featurep 'lucid-scrollbars)
  44           '("scrollbar.width" . "XlwScrollBar.Width"))
  45          ((featurep 'motif-scrollbars)
  46           '("scrollbar.width" . "XmScrollBar.Width"))))
  47   ;; Athena scrollbars accept either 'thickness' or 'width'.
  48   ;; If any of the previous resources succeeded, the following
  49   ;; call does nothing; so there's no harm in doing it all the
  50   ;; time.
  51   (if (featurep 'athena-scrollbars)
  52       (x-init-specifier-from-resources
  53        (specifier-fallback scrollbar-width) 'natnum locale
  54        '("scrollbar.width" . "ScrollBar.Width")))
  55
  56   ;; lather, rinse, repeat.
  57   (x-init-specifier-from-resources
  58    (specifier-fallback scrollbar-height) 'natnum locale
  59    '("scrollBarHeight" . "ScrollBarHeight")
  60    ;; The name strings are wrong, but the scrollbar name is
  61    ;; non-deterministic so it is a poor way to set a resource
  62    ;; for the scrollbar anyhow.
  63    (cond ((featurep 'athena-scrollbars)
  64           '("scrollbar.thickness" . "ScrollBar.Thickness"))
  65          ((featurep 'lucid-scrollbars)
  66           '("scrollbar.height" . "XlwScrollBar.Height"))
  67          ((featurep 'motif-scrollbars)
  68           '("scrollbar.height" . "XmScrollBar.Height"))))
  69   ;; Athena scrollbars accept either 'thickness' or 'height'.
  70   ;; If any of the previous resources succeeded, the following
  71   ;; call does nothing; so there's no harm in doing it all the
  72   ;; time.
  73   (if (featurep 'athena-scrollbars)
  74       (x-init-specifier-from-resources
  75        (specifier-fallback scrollbar-height) 'natnum locale
  76        '("scrollbar.height" . "ScrollBar.Height")))
  77
  78   ;; Now do ScrollBarPlacement.scrollBarPlacement
  79   (let ((case-fold-search t)
  80         (resval (x-get-resource "ScrollBarPlacement" "scrollBarPlacement"
  81                                 'string locale nil 'warn)))
  82     (cond
  83      ((null resval))
  84      ((string-match "^top[_-]left$" resval)
  85       (set-specifier scrollbar-on-top-p t locale)
  86       (set-specifier scrollbar-on-left-p t locale))
  87      ((string-match "^top[_-]right$" resval)
  88       (set-specifier scrollbar-on-top-p t locale)
  89       (set-specifier scrollbar-on-left-p nil locale))
  90      ((string-match "^bottom[_-]left$" resval)
  91       (set-specifier scrollbar-on-top-p nil locale)
  92       (set-specifier scrollbar-on-left-p t locale))
  93      ((string-match "^bottom[_-]right$" resval)
  94       (set-specifier scrollbar-on-top-p nil locale)
  95       (set-specifier scrollbar-on-left-p nil locale))
  96      (t
  97       (display-warning 'resource
  98         (format "Illegal value '%s' for scrollBarPlacement resource" resval)))))
  99
 100 )
 101
 102 ;;; x-scrollbar.el ends here