Mercurial > hg > xemacs-beta

comparison lisp/prim/scrollbar.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;; Scrollbar support.
2 ;; Copyright (C) 1995 Board of Trustees, University of Illinois
3
4 ;; This file is part of XEmacs.
5
6 ;; XEmacs is free software; you can redistribute it and/or modify it
7 ;; under the terms of the GNU General Public License as published by
8 ;; the Free Software Foundation; either version 2, or (at your option)
9 ;; any later version.
10
11 ;; XEmacs is distributed in the hope that it will be useful, but
12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;; General Public License for more details.
15
16 ;; You should have received a copy of the GNU General Public License
17 ;; along with XEmacs; see the file COPYING. If not, write to the Free
18 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19
20 ;;; Synched up with: Not in FSF. (Completely divergent from FSF scroll-bar.el)
21
22 (defun init-scrollbar-from-resources (locale)
23 (if (and (featurep 'x)
24 (or (eq locale 'global)
25 (eq 'x (device-or-frame-type locale)))
26 (x-init-scrollbar-from-resources locale))))
27
28 ;;
29 ;; vertical scrollbar functions
30 ;;
31
32
33 ;;
34 ;; horizontal scrollbar functions
35 ;;
36
37 (defun scrollbar-char-left (window)
38 "Function called when the char-left arrow on the scrollbar is clicked.
39 This is the little arrow to the left of the scrollbar. One argument is
40 passed, the scrollbar's window. You can advise this function to
41 change the scrollbar behavior."
42 (if (not (window-live-p window))
43 nil
44 (scrollbar-set-hscroll window (- (window-hscroll window) 1))
45 (setq zmacs-region-stays t)
46 nil))
47
48 (defun scrollbar-char-right (window)
49 "Function called when the char-right arrow on the scrollbar is clicked.
50 This is the little arrow to the right of the scrollbar. One argument is
51 passed, the scrollbar's window. You can advise this function to
52 change the scrollbar behavior."
53 (if (not (window-live-p window))
54 nil
55 (scrollbar-set-hscroll window (+ (window-hscroll window) 1))
56 (setq zmacs-region-stays t)
57 nil))
58
59 (defun scrollbar-page-left (window)
60 "Function called when the user gives the \"page-left\" scrollbar action.
61 \(The way this is done can vary from scrollbar to scrollbar.\) One argument is
62 passed, the scrollbar's window. You can advise this function to
63 change the scrollbar behavior."
64 (if (not (window-live-p window))
65 nil
66 (scrollbar-set-hscroll window (- (window-hscroll window)
67 (- (window-width window) 2)))
68 (setq zmacs-region-stays t)
69 nil))
70
71 (defun scrollbar-page-right (window)
72 "Function called when the user gives the \"page-right\" scrollbar action.
73 \(The way this is done can vary from scrollbar to scrollbar.\) One argument is
74 passed, the scrollbar's window. You can advise this function to
75 change the scrollbar behavior."
76 (if (not (window-live-p window))
77 nil
78 (scrollbar-set-hscroll window (+ (window-hscroll window)
79 (- (window-width window) 2)))
80 (setq zmacs-region-stays t)
81 nil))
82
83 (defun scrollbar-to-left (window)
84 "Function called when the user gives the \"to-left\" scrollbar action.
85 \(The way this is done can vary from scrollbar to scrollbar.\). One argument is
86 passed, the scrollbar's window. You can advise this function to
87 change the scrollbar behavior."
88 (if (not (window-live-p window))
89 nil
90 (scrollbar-set-hscroll window 0)
91 (setq zmacs-region-stays t)
92 nil))
93
94 (defun scrollbar-to-right (window)
95 "Function called when the user gives the \"to-right\" scrollbar action.
96 \(The way this is done can vary from scrollbar to scrollbar.\). One argument is
97 passed, the scrollbar's window. You can advise this function to
98 change the scrollbar behavior."
99 (if (not (window-live-p window))
100 nil
101 (scrollbar-set-hscroll window 'max)
102 (setq zmacs-region-stays t)
103 nil))
104
105 (defun scrollbar-horizontal-drag (data)
106 "Function called when the user drags the horizontal scrollbar thumb.
107 One argument is passed, a cons containing the scrollbar's window and a value
108 representing how many columns the thumb is slid over. You can advise
109 this function to change the scrollbar behavior."
110 (let ((window (car data))
111 (value (cdr data)))
112 (if (not (or (window-live-p window) (integerp value)))
113 nil
114 (scrollbar-set-hscroll window value)
115 (setq zmacs-region-stays t)
116 nil)))