428
+ − 1 ;;; scrollbar.el --- Scrollbar support for XEmacs
+ − 2
+ − 3 ;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+ − 4
+ − 5 ;; Maintainer: XEmacs Development Team
+ − 6 ;; Keywords: internal, extensions, dumped
+ − 7
+ − 8 ;; This file is part of XEmacs.
+ − 9
+ − 10 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 11 ;; under the terms of the GNU General Public License as published by
+ − 12 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 13 ;; any later version.
+ − 14
+ − 15 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 18 ;; General Public License for more details.
+ − 19
+ − 20 ;; You should have received a copy of the GNU General Public License
+ − 21 ;; along with XEmacs; see the file COPYING. If not, write to the
+ − 22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
+ − 23 ;; Boston, MA 02111-1307, USA.
+ − 24
+ − 25 ;;; Synched up with: Not in FSF. (Completely divergent from FSF scroll-bar.el)
+ − 26
+ − 27 ;;; Commentary:
+ − 28
+ − 29 ;; This file is dumped with XEmacs (when scrollbar support is compiled in).
+ − 30
+ − 31 ;;; Code:
+ − 32
+ − 33 ;; added for the options menu - dverna
+ − 34 (defcustom scrollbars-visible-p t
+ − 35 "Whether the scrollbars are globally visible.
+ − 36 This variable can be customized through the options menu."
+ − 37 :type 'boolean
+ − 38 :set (lambda (var val)
+ − 39 (set-specifier vertical-scrollbar-visible-p val)
+ − 40 (set-specifier horizontal-scrollbar-visible-p val)
+ − 41 (setq-default scrollbars-visible-p val))
+ − 42 :group 'display)
+ − 43
+ − 44 (defun init-scrollbar-from-resources (locale)
+ − 45 (when (and (featurep 'x)
+ − 46 (or (eq locale 'global)
+ − 47 (eq 'x (device-or-frame-type locale))))
502
+ − 48 (declare-fboundp (x-init-scrollbar-from-resources locale)))
428
+ − 49 (when (and (featurep 'mswindows)
+ − 50 (or (eq locale 'global)
+ − 51 (eq 'mswindows (device-or-frame-type locale))))
502
+ − 52 (declare-fboundp (mswindows-init-scrollbar-metrics locale))))
428
+ − 53
+ − 54 ;;
+ − 55 ;; vertical scrollbar functions
+ − 56 ;;
+ − 57
440
+ − 58 ;;; #### Move functions from C into Lisp here!
428
+ − 59
+ − 60 ;;
+ − 61 ;; horizontal scrollbar functions
+ − 62 ;;
+ − 63
+ − 64 (defun scrollbar-char-left (window)
+ − 65 "Function called when the char-left arrow on the scrollbar is clicked.
+ − 66 This is the little arrow to the left of the scrollbar. One argument is
+ − 67 passed, the scrollbar's window. You can advise this function to
+ − 68 change the scrollbar behavior."
+ − 69 (when (window-live-p window)
+ − 70 (scrollbar-set-hscroll window (- (window-hscroll window) 1))
+ − 71 (setq zmacs-region-stays t)
+ − 72 nil))
+ − 73
+ − 74 (defun scrollbar-char-right (window)
+ − 75 "Function called when the char-right arrow on the scrollbar is clicked.
+ − 76 This is the little arrow to the right of the scrollbar. One argument is
+ − 77 passed, the scrollbar's window. You can advise this function to
+ − 78 change the scrollbar behavior."
+ − 79 (when (window-live-p window)
+ − 80 (scrollbar-set-hscroll window (+ (window-hscroll window) 1))
+ − 81 (setq zmacs-region-stays t)
+ − 82 nil))
+ − 83
+ − 84 (defun scrollbar-page-left (window)
+ − 85 "Function called when the user gives the \"page-left\" scrollbar action.
+ − 86 \(The way this is done can vary from scrollbar to scrollbar.\) One argument is
+ − 87 passed, the scrollbar's window. You can advise this function to
+ − 88 change the scrollbar behavior."
+ − 89 (when (window-live-p window)
+ − 90 (scrollbar-set-hscroll window (- (window-hscroll window)
+ − 91 (- (window-width window) 2)))
+ − 92 (setq zmacs-region-stays t)
+ − 93 nil))
+ − 94
+ − 95 (defun scrollbar-page-right (window)
+ − 96 "Function called when the user gives the \"page-right\" scrollbar action.
+ − 97 \(The way this is done can vary from scrollbar to scrollbar.\) One argument is
+ − 98 passed, the scrollbar's window. You can advise this function to
+ − 99 change the scrollbar behavior."
+ − 100 (when (window-live-p window)
+ − 101 (scrollbar-set-hscroll window (+ (window-hscroll window)
+ − 102 (- (window-width window) 2)))
+ − 103 (setq zmacs-region-stays t)
+ − 104 nil))
+ − 105
+ − 106 (defun scrollbar-to-left (window)
+ − 107 "Function called when the user gives the \"to-left\" scrollbar action.
+ − 108 \(The way this is done can vary from scrollbar to scrollbar.\). One argument is
+ − 109 passed, the scrollbar's window. You can advise this function to
+ − 110 change the scrollbar behavior."
+ − 111 (when (window-live-p window)
+ − 112 (scrollbar-set-hscroll window 0)
+ − 113 (setq zmacs-region-stays t)
+ − 114 nil))
+ − 115
+ − 116 (defun scrollbar-to-right (window)
+ − 117 "Function called when the user gives the \"to-right\" scrollbar action.
+ − 118 \(The way this is done can vary from scrollbar to scrollbar.\). One argument is
+ − 119 passed, the scrollbar's window. You can advise this function to
+ − 120 change the scrollbar behavior."
+ − 121 (when (window-live-p window)
+ − 122 (scrollbar-set-hscroll window 'max)
+ − 123 (setq zmacs-region-stays t)
+ − 124 nil))
+ − 125
+ − 126 (defun scrollbar-horizontal-drag (data)
+ − 127 "Function called when the user drags the horizontal scrollbar thumb.
+ − 128 One argument is passed, a cons containing the scrollbar's window and a value
+ − 129 representing how many columns the thumb is slid over. You can advise
+ − 130 this function to change the scrollbar behavior."
+ − 131 (let ((window (car data))
+ − 132 (value (cdr data)))
+ − 133 (when (and (window-live-p window) (integerp value))
+ − 134 (scrollbar-set-hscroll window value)
+ − 135 (setq zmacs-region-stays t)
+ − 136 nil)))
+ − 137
+ − 138 ;;; scrollbar.el ends here
