annotate lisp/scrollbar.el @ 5553:62edcc6a11ec

Add an assertion about argument order to #'apply-partially compiler macro lisp/ChangeLog addition: 2011-08-24 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (apply-partially): Add an assertion to this compiler macro, requiring that the order of the placeholders corresponding to the arguments in the constants vector of the constructed compiled function be the same as the order of the arguments to #'apply-partially. tests/ChangeLog addition: 2011-08-24 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Add a test of apply partially that depends on the relative order of its arguments.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 24 Aug 2011 11:06:41 +0100
parents 308d34e9f07d
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; scrollbar.el --- Scrollbar support for XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Keywords: internal, extensions, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 502
diff changeset
10 ;; XEmacs is free software: you can redistribute it and/or modify it
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 502
diff changeset
11 ;; under the terms of the GNU General Public License as published by the
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 502
diff changeset
12 ;; Free Software Foundation, either version 3 of the License, or (at your
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 502
diff changeset
13 ;; option) any later version.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 502
diff changeset
15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 502
diff changeset
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 502
diff changeset
17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 502
diff changeset
18 ;; for more details.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 502
diff changeset
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;;; Synched up with: Not in FSF. (Completely divergent from FSF scroll-bar.el)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;; This file is dumped with XEmacs (when scrollbar support is compiled in).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; added for the options menu - dverna
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 (defcustom scrollbars-visible-p t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 "Whether the scrollbars are globally visible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 This variable can be customized through the options menu."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 :set (lambda (var val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 (set-specifier vertical-scrollbar-visible-p val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 (set-specifier horizontal-scrollbar-visible-p val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 (setq-default scrollbars-visible-p val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 :group 'display)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 (defun init-scrollbar-from-resources (locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 (when (and (featurep 'x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 (or (eq locale 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 (eq 'x (device-or-frame-type locale))))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 440
diff changeset
46 (declare-fboundp (x-init-scrollbar-from-resources locale)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 (when (and (featurep 'mswindows)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 (or (eq locale 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 (eq 'mswindows (device-or-frame-type locale))))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 440
diff changeset
50 (declare-fboundp (mswindows-init-scrollbar-metrics locale))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 ;; vertical scrollbar functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
56 ;;; #### Move functions from C into Lisp here!
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 ;; horizontal scrollbar functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 (defun scrollbar-char-left (window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 "Function called when the char-left arrow on the scrollbar is clicked.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 This is the little arrow to the left of the scrollbar. One argument is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 passed, the scrollbar's window. You can advise this function to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 change the scrollbar behavior."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (when (window-live-p window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 (scrollbar-set-hscroll window (- (window-hscroll window) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (setq zmacs-region-stays t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 (defun scrollbar-char-right (window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 "Function called when the char-right arrow on the scrollbar is clicked.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 This is the little arrow to the right of the scrollbar. One argument is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 passed, the scrollbar's window. You can advise this function to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 change the scrollbar behavior."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 (when (window-live-p window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 (scrollbar-set-hscroll window (+ (window-hscroll window) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (setq zmacs-region-stays t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (defun scrollbar-page-left (window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 "Function called when the user gives the \"page-left\" scrollbar action.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 \(The way this is done can vary from scrollbar to scrollbar.\) One argument is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 passed, the scrollbar's window. You can advise this function to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 change the scrollbar behavior."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 (when (window-live-p window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (scrollbar-set-hscroll window (- (window-hscroll window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 (- (window-width window) 2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 (setq zmacs-region-stays t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 (defun scrollbar-page-right (window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 "Function called when the user gives the \"page-right\" scrollbar action.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 \(The way this is done can vary from scrollbar to scrollbar.\) One argument is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 passed, the scrollbar's window. You can advise this function to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 change the scrollbar behavior."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (when (window-live-p window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (scrollbar-set-hscroll window (+ (window-hscroll window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (- (window-width window) 2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 (setq zmacs-region-stays t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 (defun scrollbar-to-left (window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 "Function called when the user gives the \"to-left\" scrollbar action.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 \(The way this is done can vary from scrollbar to scrollbar.\). One argument is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 passed, the scrollbar's window. You can advise this function to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 change the scrollbar behavior."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 (when (window-live-p window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (scrollbar-set-hscroll window 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 (setq zmacs-region-stays t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 (defun scrollbar-to-right (window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 "Function called when the user gives the \"to-right\" scrollbar action.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 \(The way this is done can vary from scrollbar to scrollbar.\). One argument is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 passed, the scrollbar's window. You can advise this function to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 change the scrollbar behavior."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 (when (window-live-p window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 (scrollbar-set-hscroll window 'max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 (setq zmacs-region-stays t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 (defun scrollbar-horizontal-drag (data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 "Function called when the user drags the horizontal scrollbar thumb.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 One argument is passed, a cons containing the scrollbar's window and a value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 representing how many columns the thumb is slid over. You can advise
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 this function to change the scrollbar behavior."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 (let ((window (car data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 (value (cdr data)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 (when (and (window-live-p window) (integerp value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 (scrollbar-set-hscroll window value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (setq zmacs-region-stays t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 ;;; scrollbar.el ends here