Mercurial > hg > xemacs-beta

comparison lisp/prim/scrollbar.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 441bb1e64a06
children a145efe76779
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;; General Public License for more details. 14 ;; General Public License for more details.
15 15
16 ;; You should have received a copy of the GNU General Public License 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 17 ;; along with XEmacs; see the file COPYING. If not, write to the Free
18 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 18 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19 ;; Boston, MA 02111-1307, USA.
20 19
21 ;;; Synched up with: Not in FSF. (Completely divergent from FSF scroll-bar.el) 20 ;;; Synched up with: Not in FSF. (Completely divergent from FSF scroll-bar.el)
22 21
23 (defun init-scrollbar-from-resources (locale) 22 (defun init-scrollbar-from-resources (locale)
24 (if (and (featurep 'x) 23 (if (and (featurep 'x)
38 (defun scrollbar-char-left (window) 37 (defun scrollbar-char-left (window)
39 "Function called when the char-left arrow on the scrollbar is clicked. 38 "Function called when the char-left arrow on the scrollbar is clicked.
40 This is the little arrow to the left of the scrollbar. One argument is 39 This is the little arrow to the left of the scrollbar. One argument is
41 passed, the scrollbar's window. You can advise this function to 40 passed, the scrollbar's window. You can advise this function to
42 change the scrollbar behavior." 41 change the scrollbar behavior."
43 (when (window-live-p window) 42 (if (not (window-live-p window))
43 nil
44 (scrollbar-set-hscroll window (- (window-hscroll window) 1)) 44 (scrollbar-set-hscroll window (- (window-hscroll window) 1))
45 (setq zmacs-region-stays t) 45 (setq zmacs-region-stays t)
46 nil)) 46 nil))
47 47
48 (defun scrollbar-char-right (window) 48 (defun scrollbar-char-right (window)
49 "Function called when the char-right arrow on the scrollbar is clicked. 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 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 51 passed, the scrollbar's window. You can advise this function to
52 change the scrollbar behavior." 52 change the scrollbar behavior."
53 (when (window-live-p window) 53 (if (not (window-live-p window))
54 nil
54 (scrollbar-set-hscroll window (+ (window-hscroll window) 1)) 55 (scrollbar-set-hscroll window (+ (window-hscroll window) 1))
55 (setq zmacs-region-stays t) 56 (setq zmacs-region-stays t)
56 nil)) 57 nil))
57 58
58 (defun scrollbar-page-left (window) 59 (defun scrollbar-page-left (window)
59 "Function called when the user gives the \"page-left\" scrollbar action. 60 "Function called when the user gives the \"page-left\" scrollbar action.
60 \(The way this is done can vary from scrollbar to scrollbar.\) One argument is 61 \(The way this is done can vary from scrollbar to scrollbar.\) One argument is
61 passed, the scrollbar's window. You can advise this function to 62 passed, the scrollbar's window. You can advise this function to
62 change the scrollbar behavior." 63 change the scrollbar behavior."
63 (when (window-live-p window) 64 (if (not (window-live-p window))
65 nil
64 (scrollbar-set-hscroll window (- (window-hscroll window) 66 (scrollbar-set-hscroll window (- (window-hscroll window)
65 (- (window-width window) 2))) 67 (- (window-width window) 2)))
66 (setq zmacs-region-stays t) 68 (setq zmacs-region-stays t)
67 nil)) 69 nil))
68 70
69 (defun scrollbar-page-right (window) 71 (defun scrollbar-page-right (window)
70 "Function called when the user gives the \"page-right\" scrollbar action. 72 "Function called when the user gives the \"page-right\" scrollbar action.
71 \(The way this is done can vary from scrollbar to scrollbar.\) One argument is 73 \(The way this is done can vary from scrollbar to scrollbar.\) One argument is
72 passed, the scrollbar's window. You can advise this function to 74 passed, the scrollbar's window. You can advise this function to
73 change the scrollbar behavior." 75 change the scrollbar behavior."
74 (when (window-live-p window) 76 (if (not (window-live-p window))
77 nil
75 (scrollbar-set-hscroll window (+ (window-hscroll window) 78 (scrollbar-set-hscroll window (+ (window-hscroll window)
76 (- (window-width window) 2))) 79 (- (window-width window) 2)))
77 (setq zmacs-region-stays t) 80 (setq zmacs-region-stays t)
78 nil)) 81 nil))
79 82
80 (defun scrollbar-to-left (window) 83 (defun scrollbar-to-left (window)
81 "Function called when the user gives the \"to-left\" scrollbar action. 84 "Function called when the user gives the \"to-left\" scrollbar action.
82 \(The way this is done can vary from scrollbar to scrollbar.\). One argument is 85 \(The way this is done can vary from scrollbar to scrollbar.\). One argument is
83 passed, the scrollbar's window. You can advise this function to 86 passed, the scrollbar's window. You can advise this function to
84 change the scrollbar behavior." 87 change the scrollbar behavior."
85 (when (window-live-p window) 88 (if (not (window-live-p window))
89 nil
86 (scrollbar-set-hscroll window 0) 90 (scrollbar-set-hscroll window 0)
87 (setq zmacs-region-stays t) 91 (setq zmacs-region-stays t)
88 nil)) 92 nil))
89 93
90 (defun scrollbar-to-right (window) 94 (defun scrollbar-to-right (window)
91 "Function called when the user gives the \"to-right\" scrollbar action. 95 "Function called when the user gives the \"to-right\" scrollbar action.
92 \(The way this is done can vary from scrollbar to scrollbar.\). One argument is 96 \(The way this is done can vary from scrollbar to scrollbar.\). One argument is
93 passed, the scrollbar's window. You can advise this function to 97 passed, the scrollbar's window. You can advise this function to
94 change the scrollbar behavior." 98 change the scrollbar behavior."
95 (when (window-live-p window) 99 (if (not (window-live-p window))
100 nil
96 (scrollbar-set-hscroll window 'max) 101 (scrollbar-set-hscroll window 'max)
97 (setq zmacs-region-stays t) 102 (setq zmacs-region-stays t)
98 nil)) 103 nil))
99 104
100 (defun scrollbar-horizontal-drag (data) 105 (defun scrollbar-horizontal-drag (data)
101 "Function called when the user drags the horizontal scrollbar thumb. 106 "Function called when the user drags the horizontal scrollbar thumb.
102 One argument is passed, a cons containing the scrollbar's window and a value 107 One argument is passed, a cons containing the scrollbar's window and a value
103 representing how many columns the thumb is slid over. You can advise 108 representing how many columns the thumb is slid over. You can advise
104 this function to change the scrollbar behavior." 109 this function to change the scrollbar behavior."
105 (let ((window (car data)) 110 (let ((window (car data))
106 (value (cdr data))) 111 (value (cdr data)))
107 (when (and (window-live-p window) (integerp value)) 112 (if (not (or (window-live-p window) (integerp value)))
113 nil
108 (scrollbar-set-hscroll window value) 114 (scrollbar-set-hscroll window value)
109 (setq zmacs-region-stays t) 115 (setq zmacs-region-stays t)
110 nil))) 116 nil)))