Mercurial > emacs
annotate lisp/dframe.el @ 110410:f2e111723c3a
Merge changes made in Gnus trunk.
Reimplement nnimap, and do tweaks to the rest of the code to support that.
* gnus-int.el (gnus-finish-retrieve-group-infos)
(gnus-retrieve-group-data-early): New functions.
* gnus-range.el (gnus-range-nconcat): New function.
* gnus-start.el (gnus-get-unread-articles): Support early retrieval of
data.
(gnus-read-active-for-groups): Support finishing the early retrieval of
data.
* gnus-sum.el (gnus-summary-move-article): Pass the move-to group name
if the move is internal, so that nnimap can do fast internal moves.
* gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for
nnimap usage.
* nnimap.el: Rewritten.
* nnmail.el (nnmail-inhibit-default-split-group): New internal variable
to allow the mail splitting to not return a default group. This is
useful for nnimap, which will leave unmatched mail in the inbox.
* utf7.el (utf7-encode): Autoload.
Implement shell connection.
* nnimap.el (nnimap-open-shell-stream): New function.
(nnimap-open-connection): Use it.
Get the number of lines by using BODYSTRUCTURE.
(nnimap-transform-headers): Get the number of lines in each message.
(nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the
number of lines.
Not all servers return UIDNEXT. Work past this problem.
Remove junk from end of file.
Fix typo in "bogus" section.
Make capabilties be case-insensitive.
Require cl when compiling.
Don't bug out if the LIST command doesn't have any parameters.
2010-09-17 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
* nnimap.el (nnimap-get-groups): Don't bug out if the LIST command
doesn't have any parameters.
(mm-text-html-renderer): Document gnus-article-html.
2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix)
* mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
* dgnushack.el: Define netrc-credentials.
If the user doesn't have a /etc/services, supply some sensible port defaults.
Have `unseen-or-unread' select an unread unseen article first.
(nntp-open-server): Return whether the open was successful or not.
Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ).
Save result so that it doesn't say "failed" all the time.
Add ~/.authinfo to the default, since that's probably most useful for users.
Don't use the "finish" method when we're reading from the agent.
Add some more nnimap-relevant agent stuff to nnagent.el.
* nnimap.el (nnimap-with-process-buffer): Removed.
Revert one line that was changed by mistake in the last checkin.
(nnimap-open-connection): Don't error out when we can't make a connection
nnimap-related changes to avoid bugging out if we can't contact a server.
* gnus-start.el (gnus-get-unread-articles): Don't try to scan groups
from methods that are denied.
* nnimap.el (nnimap-possibly-change-group): Return nil if we can't log
in.
(nnimap-finish-retrieve-group-infos): Make sure we're not waiting for
nothing.
* gnus-sum.el (gnus-select-newsgroup): Indent.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sat, 18 Sep 2010 10:02:19 +0000 |
parents | bbc922c0cfa8 |
children | 249a1455856a |
rev | line source |
---|---|
65753 | 1 ;;; dframe --- dedicate frame support modes |
2 | |
68561
6c2778476533
(dframe-handle-make-frame-visible, dframe-handle-iconify-frame,
Juanma Barranquero <lekktu@gmail.com>
parents:
67226
diff
changeset
|
3 ;;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
106815 | 4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
65753 | 5 |
6 ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
7 ;; Keywords: file, tags, tools | |
8 | |
9 (defvar dframe-version "1.3" | |
10 "The current version of the dedicated frame library.") | |
11 | |
12 ;; This file is part of GNU Emacs. | |
13 | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94274
diff
changeset
|
14 ;; GNU Emacs is free software: you can redistribute it and/or modify |
65753 | 15 ;; it under the terms of the GNU General Public License as published by |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94274
diff
changeset
|
16 ;; the Free Software Foundation, either version 3 of the License, or |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94274
diff
changeset
|
17 ;; (at your option) any later version. |
65753 | 18 |
19 ;; GNU Emacs is distributed in the hope that it will be useful, | |
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 ;; GNU General Public License for more details. | |
23 | |
24 ;; You should have received a copy of the GNU General Public License | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94274
diff
changeset
|
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
65753 | 26 |
27 ;;; Commentary: | |
28 ;; | |
29 ;; This code was developed and maintained as a part of speedbar since 1996. | |
30 ;; It became its own support utility in Aug 2000. | |
31 ;; | |
32 ;; Dedicated frame mode is an Emacs independent library for supporting | |
33 ;; a program/buffer combination that resides in a dedicated frame. | |
34 ;; Support of this nature requires several complex interactions with the | |
35 ;; user which this library will provide, including: | |
36 ;; | |
37 ;; * Creation of a frame. Positioned relatively. | |
38 ;; Includes a frame cache for User position caching. | |
39 ;; * Switching between frames. | |
40 ;; * Timed activities using idle-timers | |
41 ;; * Frame/buffer killing hooks | |
42 ;; * Mouse-3 position relative menu | |
43 ;; * Mouse motion, help-echo hacks | |
94274
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
44 ;; * Mouse clicking, double clicking, & XEmacs image clicking hack |
65753 | 45 ;; * Mode line hacking |
46 ;; * Utilities for use in a program covering: | |
47 ;; o keymap massage for some actions | |
48 ;; o working with an associated buffer | |
49 ;; o shift-click | |
50 ;; o detaching a frame | |
51 ;; o focus-shifting & optional frame jumping | |
52 ;; o currently active frame. | |
53 ;; o message/y-or-n-p | |
54 ;; o mouse set point | |
55 ;; | |
56 ;; To Use: | |
57 ;; 1) (require 'dframe) | |
58 ;; 2) Variable Setup: | |
59 ;; -frame-parameters -- Frame parameters for Emacs. | |
60 ;; -frame-plist -- Frame parameters for XEmacs. | |
61 ;; -- Not on parameter lists: They can optionally include width | |
62 ;; and height. If width or height is not included, then it will | |
63 ;; be provided to match the originating frame. In general, | |
64 ;; turning off the menu bar, mode line, and minibuffer can | |
65 ;; provide a smaller window, or more display area. | |
66 ;; -track-mouse-flag -- mouse tracking on/off specific to your tool. | |
67 ;; -update-flag -- app toggle for timer use. Init from | |
68 ;; `dframe-have-timer-flag'. This is nil for terminals, since | |
69 ;; updating a frame in a terminal is not useful to the user. | |
70 ;; -key-map -- Your keymap. Call `dframe-update-keymap' on it. | |
71 ;; -buffer, -frame, -cached-frame -- Variables used to track your | |
72 ;; applications buffer, frame, or frame cache (when hidden). See | |
73 ;; `dframe-frame-mode' for details. | |
74 ;; -before-delete-hook, -before-popup-hook, -after-create-hook -- | |
75 ;; Hooks to have called. The `-after-create-hook' probably wants | |
76 ;; to call a function which calls `dframe-reposition-frame' in an | |
77 ;; appropriate manner. | |
78 ;; 3) Function Setup: | |
79 ;; your-frame-mode -- function to toggle your app frame on and off. | |
80 ;; its tasks are: | |
81 ;; a) create a buffer | |
82 ;; b) Call `dframe-frame-mode'. (See its doc) | |
83 ;; c) If successful (your -frame variable has a value), call | |
84 ;; timer setup if applicable. | |
85 ;; your-frame-reposition- -- Function to call from after-create-hook to | |
86 ;; reposition your frame with `dframe-repsoition-frame'. | |
87 ;; your-mode -- Set up the major mode of the buffer for your app. | |
88 ;; Set these variables: dframe-track-mouse-function, | |
89 ;; dframe-help-echo-function, | |
90 ;; dframe-mouse-click-function, | |
91 ;; dframe-mouse-position-function. | |
92 ;; See speedbar's implementation of these functions. | |
93 ;; `speedbar-current-frame', `speedbar-get-focus', `speedbar-message', | |
94 ;; `speedbar-y-or-n-p', `speedbar-set-timer', `speedbar-click', | |
95 ;; `speedbar-position-cursor-on-line' | |
96 ;; 4) Handling mouse clicks, and help text: | |
97 ;; dframe-track-mouse, dframe-help-echo-function -- | |
98 ;; These variables need to be set to functions that display info | |
99 ;; based on the mouse's position. | |
100 ;; Text propert 'help-echo, set to `dframe-help-echo', which will | |
101 ;; call `dframe-help-echo-function'. | |
102 ;; Have a `-click' function, it can call `dframe-quick-mouse' for | |
103 ;; positioning. If the variable `dframe-power-click' is non-nil, | |
104 ;; then `shift' was held down during the click. | |
105 | |
106 ;;; Bugs | |
107 ;; | |
108 ;; * The timer managers doesn't handle multiple different timeouts. | |
94274
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
109 ;; * You can't specify continuous timeouts (as opposed to just idle timers.) |
65753 | 110 |
65866
df5f6fcce1be
(x-pointer-hand2, x-pointer-top-left-arrow): Add defvars.
Juanma Barranquero <lekktu@gmail.com>
parents:
65825
diff
changeset
|
111 (defvar x-pointer-hand2) |
df5f6fcce1be
(x-pointer-hand2, x-pointer-top-left-arrow): Add defvars.
Juanma Barranquero <lekktu@gmail.com>
parents:
65825
diff
changeset
|
112 (defvar x-pointer-top-left-arrow) |
df5f6fcce1be
(x-pointer-hand2, x-pointer-top-left-arrow): Add defvars.
Juanma Barranquero <lekktu@gmail.com>
parents:
65825
diff
changeset
|
113 |
65753 | 114 ;;; Code: |
115 | |
116 ;;; Compatibility functions | |
117 ;; | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
118 (defalias 'dframe-frame-parameter |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
119 (if (fboundp 'frame-parameter) 'frame-parameter |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
120 (lambda (frame parameter) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
121 "Return FRAME's PARAMETER value." |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
122 (cdr (assoc parameter (frame-parameters frame)))))) |
65753 | 123 |
124 | |
125 ;;; Variables | |
126 ;; | |
127 (defgroup dframe nil | |
128 "Faces used in dframe." | |
129 :prefix "dframe-" | |
130 :group 'dframe) | |
131 | |
94274
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
132 (defvar dframe-have-timer-flag (if (fboundp 'display-graphic-p) |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
133 (display-graphic-p) |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
134 window-system) |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
135 "Non-nil means that timers are available for this Emacs. |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
136 This is nil for terminals, since updating a frame in a terminal |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
137 is not useful to the user.") |
65753 | 138 |
139 (defcustom dframe-update-speed | |
94274
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
140 (if (featurep 'xemacs) 2 ; 1 is too obrusive in XEmacs |
65753 | 141 1) |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
142 "Idle time in seconds needed before dframe will update itself. |
65753 | 143 Updates occur to allow dframe to display directory information |
144 relevant to the buffer you are currently editing." | |
145 :group 'dframe | |
146 :type 'integer) | |
147 | |
148 (defcustom dframe-activity-change-focus-flag nil | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
149 "Non-nil means the selected frame will change based on activity. |
65753 | 150 Thus, if a file is selected for edit, the buffer will appear in the |
151 selected frame and the focus will change to that frame." | |
152 :group 'dframe | |
153 :type 'boolean) | |
154 | |
155 (defcustom dframe-after-select-attached-frame-hook nil | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
156 "Hook run after dframe has selected the attached frame." |
65753 | 157 :group 'dframe |
158 :type 'hook) | |
159 | |
160 (defvar dframe-track-mouse-function nil | |
161 "*A function to call when the mouse is moved in the given frame. | |
162 Typically used to display info about the line under the mouse.") | |
163 (make-variable-buffer-local 'dframe-track-mouse-function) | |
164 | |
165 (defvar dframe-help-echo-function nil | |
166 "*A function to call when help-echo is used in newer versions of Emacs. | |
167 Typically used to display info about the line under the mouse.") | |
168 (make-variable-buffer-local 'dframe-help-echo-function) | |
169 | |
170 (defvar dframe-mouse-click-function nil | |
171 "*A function to call when the mouse is clicked. | |
172 Valid clicks are mouse 2, our double mouse 1.") | |
173 (make-variable-buffer-local 'dframe-mouse-click-function) | |
174 | |
175 (defvar dframe-mouse-position-function nil | |
99368
4a940838ff4c
* dframe.el (dframe-mouse-position-function)
Juanma Barranquero <lekktu@gmail.com>
parents:
95839
diff
changeset
|
176 "*A function to call to position the cursor for a mouse click.") |
65753 | 177 (make-variable-buffer-local 'dframe-mouse-position-function) |
178 | |
179 (defvar dframe-power-click nil | |
180 "Never set this by hand. Value is t when S-mouse activity occurs.") | |
181 | |
182 (defvar dframe-timer nil | |
183 "The dframe timer used for updating the buffer.") | |
184 (make-variable-buffer-local 'dframe-timer) | |
185 | |
186 (defvar dframe-attached-frame nil | |
187 "The frame which started a frame mode. | |
188 This is the frame from which all interesting activities will go | |
189 for the mode using dframe.") | |
190 (make-variable-buffer-local 'dframe-attached-frame) | |
191 | |
192 (defvar dframe-controlled nil | |
193 "Is this buffer controlled by a dedicated frame. | |
194 Local to those buffers, as a function called that created it.") | |
195 (make-variable-buffer-local 'dframe-controlled) | |
196 | |
197 (defun dframe-update-keymap (map) | |
198 "Update the keymap MAP for dframe default bindings." | |
199 ;; Frame control | |
200 (define-key map "q" 'dframe-close-frame) | |
201 (define-key map "Q" 'delete-frame) | |
202 | |
203 ;; Override switch to buffer to never hack our frame. | |
204 (substitute-key-definition 'switch-to-buffer | |
205 'dframe-switch-buffer-attached-frame | |
206 map global-map) | |
207 | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
208 (if (featurep 'xemacs) |
65753 | 209 (progn |
210 ;; mouse bindings so we can manipulate the items on each line | |
211 (define-key map 'button2 'dframe-click) | |
212 (define-key map '(shift button2) 'dframe-power-click) | |
213 ;; Info doc fix from Bob Weiner | |
214 (if (featurep 'infodoc) | |
215 nil | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
216 (define-key map 'button3 'dframe-popup-kludge)) |
65753 | 217 ) |
218 | |
219 ;; mouse bindings so we can manipulate the items on each line | |
65825
b89d9c4d5386
* info.el (Info-next, Info-prev, Info-up): Select info buffer, in
Chong Yidong <cyd@stupidchicken.com>
parents:
65780
diff
changeset
|
220 ;; (define-key map [down-mouse-1] 'dframe-double-click) |
b89d9c4d5386
* info.el (Info-next, Info-prev, Info-up): Select info buffer, in
Chong Yidong <cyd@stupidchicken.com>
parents:
65780
diff
changeset
|
221 (define-key map [follow-link] 'mouse-face) |
65753 | 222 (define-key map [mouse-2] 'dframe-click) |
223 ;; This is the power click for new frames, or refreshing a cache | |
224 (define-key map [S-mouse-2] 'dframe-power-click) | |
225 ;; This adds a small unecessary visual effect | |
226 ;;(define-key map [down-mouse-2] 'dframe-quick-mouse) | |
227 | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
228 (define-key map [down-mouse-3] 'dframe-popup-kludge) |
65753 | 229 |
230 ;; This lets the user scroll as if we had a scrollbar... well maybe not | |
231 (define-key map [mode-line mouse-2] 'dframe-mouse-hscroll) | |
232 ;; another handy place users might click to get our menu. | |
233 (define-key map [mode-line down-mouse-1] | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
234 'dframe-popup-kludge) |
65753 | 235 |
236 ;; We can't switch buffers with the buffer mouse menu. Lets hack it. | |
237 (define-key map [C-down-mouse-1] 'dframe-hack-buffer-menu) | |
238 | |
239 ;; Lastly, we want to track the mouse. Play here | |
240 (define-key map [mouse-movement] 'dframe-track-mouse) | |
241 )) | |
242 | |
243 (defun dframe-live-p (frame) | |
244 "Return non-nil if FRAME is currently available." | |
245 (and frame (frame-live-p frame) (frame-visible-p frame))) | |
246 | |
247 (defun dframe-frame-mode (arg frame-var cache-var buffer-var frame-name | |
248 local-mode-fn | |
249 &optional | |
250 parameters | |
251 delete-hook popup-hook create-hook | |
252 ) | |
253 "Manage a frame for an application, enabling it when ARG is positive. | |
254 FRAME-VAR is a variable used to cache the frame being used. | |
255 This frame is either resurrected, hidden, killed, etc based on | |
256 the value. | |
257 CACHE-VAR is a variable used to cache a cached frame. | |
258 BUFFER-VAR is a variable used to cache the buffer being used in dframe. | |
68561
6c2778476533
(dframe-handle-make-frame-visible, dframe-handle-iconify-frame,
Juanma Barranquero <lekktu@gmail.com>
parents:
67226
diff
changeset
|
259 This buffer will have `dframe-frame-mode' run on it. |
65753 | 260 FRAME-NAME is the name of the frame to create. |
261 LOCAL-MODE-FN is the function used to call this one. | |
262 PARAMETERS are frame parameters to apply to this dframe. | |
263 DELETE-HOOK are hooks to run when deleting a frame. | |
264 POPUP-HOOK are hooks to run before showing a frame. | |
265 CREATE-HOOK are hooks to run after creating a frame." | |
266 ;; toggle frame on and off. | |
267 (if (not arg) (if (dframe-live-p (symbol-value frame-var)) | |
268 (setq arg -1) (setq arg 1))) | |
269 ;; Make sure the current buffer is set. | |
270 (set-buffer (symbol-value buffer-var)) | |
271 ;; turn the frame off on neg number | |
272 (if (and (numberp arg) (< arg 0)) | |
273 (progn | |
274 (run-hooks 'delete-hook) | |
275 (if (and (symbol-value frame-var) | |
276 (frame-live-p (symbol-value frame-var))) | |
277 (progn | |
278 (set cache-var (symbol-value frame-var)) | |
279 (make-frame-invisible (symbol-value frame-var)))) | |
280 (set frame-var nil)) | |
281 ;; Set this as our currently attached frame | |
282 (setq dframe-attached-frame (selected-frame)) | |
283 (run-hooks 'popup-hook) | |
284 ;; Updated the buffer passed in to contain all the hacks needed | |
285 ;; to make it work well in a dedicated window. | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
286 (with-current-buffer (symbol-value buffer-var) |
65753 | 287 ;; Declare this buffer a dedicated frame |
288 (setq dframe-controlled local-mode-fn) | |
289 | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
290 (if (featurep 'xemacs) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
291 (progn |
65753 | 292 ;; Hack the XEmacs mouse-motion handler |
293 (set (make-local-variable 'mouse-motion-handler) | |
294 'dframe-track-mouse-xemacs) | |
295 ;; Hack the double click handler | |
296 (make-local-variable 'mouse-track-click-hook) | |
297 (add-hook 'mouse-track-click-hook | |
298 (lambda (event count) | |
299 (if (/= (event-button event) 1) | |
300 nil ; Do normal operations. | |
301 (cond ((eq count 1) | |
302 (dframe-quick-mouse event)) | |
303 ((or (eq count 2) | |
304 (eq count 3)) | |
305 (dframe-click event) | |
306 (dframe-quick-mouse event))) | |
307 ;; Don't do normal operations. | |
308 t)))) | |
309 ;; Enable mouse tracking in emacs | |
310 (if dframe-track-mouse-function | |
77099
84c653bf8535
(dframe-frame-mode): Do not set auto-show-mode, since it is obsolete
Glenn Morris <rgm@gnu.org>
parents:
75347
diff
changeset
|
311 (set (make-local-variable 'track-mouse) t))) ;this could be messy. |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
312 ;;;; DISABLED: This causes problems for users with multiple frames. |
65753 | 313 ;;;; ;; Set this up special just for the passed in buffer |
314 ;;;; ;; Terminal minibuffer stuff does not require this. | |
315 ;;;; (if (and (or (assoc 'minibuffer parameters) | |
316 ;;;; ;; XEmacs plist is not an association list | |
317 ;;;; (member 'minibuffer parameters)) | |
318 ;;;; window-system (not (eq window-system 'pc)) | |
319 ;;;; (null default-minibuffer-frame)) | |
320 ;;;; (progn | |
321 ;;;; (make-local-variable 'default-minibuffer-frame) | |
322 ;;;; (setq default-minibuffer-frame dframe-attached-frame)) | |
323 ;;;; ) | |
324 ;; Override `temp-buffer-show-hook' so that help and such | |
325 ;; put their stuff into a frame other than our own. | |
326 ;; Correct use of `temp-buffer-show-function': Bob Weiner | |
327 (if (and (boundp 'temp-buffer-show-hook) | |
328 (boundp 'temp-buffer-show-function)) | |
329 (progn (make-local-variable 'temp-buffer-show-hook) | |
330 (setq temp-buffer-show-hook temp-buffer-show-function))) | |
331 (make-local-variable 'temp-buffer-show-function) | |
332 (setq temp-buffer-show-function 'dframe-temp-buffer-show-function) | |
333 ;; If this buffer is killed, we must make sure that we destroy | |
334 ;; the frame the dedicated window is in. | |
335 (add-hook 'kill-buffer-hook `(lambda () | |
336 (let ((skilling (boundp 'skilling))) | |
337 (if skilling | |
338 nil | |
339 (if dframe-controlled | |
340 (progn | |
341 (funcall dframe-controlled -1) | |
342 (setq ,buffer-var nil) | |
343 ))))) | |
344 t t) | |
345 ) | |
346 ;; Get the frame to work in | |
347 (if (frame-live-p (symbol-value cache-var)) | |
348 (progn | |
349 (set frame-var (symbol-value cache-var)) | |
350 (make-frame-visible (symbol-value frame-var)) | |
351 (select-frame (symbol-value frame-var)) | |
352 (set-window-dedicated-p (selected-window) nil) | |
353 (if (not (eq (current-buffer) (symbol-value buffer-var))) | |
354 (switch-to-buffer (symbol-value buffer-var))) | |
355 (set-window-dedicated-p (selected-window) t) | |
356 (raise-frame (symbol-value frame-var)) | |
357 ) | |
358 (if (frame-live-p (symbol-value frame-var)) | |
359 (raise-frame (symbol-value frame-var)) | |
360 (set frame-var | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
361 (if (featurep 'xemacs) |
65753 | 362 ;; Only guess height if it is not specified. |
363 (if (member 'height parameters) | |
364 (make-frame parameters) | |
365 (make-frame (nconc (list 'height | |
366 (dframe-needed-height)) | |
367 parameters))) | |
368 (let* ((mh (dframe-frame-parameter dframe-attached-frame | |
369 'menu-bar-lines)) | |
370 (paramsa | |
371 ;; Only add a guessed height if one is not specified | |
372 ;; in the input parameters. | |
373 (if (assoc 'height parameters) | |
374 parameters | |
375 (append | |
376 parameters | |
69236
13b406066d9e
(dframe-frame-mode): Don't burp when menu-bar-lines is nil.
Nick Roberts <nickrob@snap.net.nz>
parents:
68651
diff
changeset
|
377 (list (cons 'height (+ (or mh 0) (frame-height))))))) |
65753 | 378 (params |
379 ;; Only add a guessed width if one is not specified | |
380 ;; in the input parameters. | |
381 (if (assoc 'width parameters) | |
382 paramsa | |
383 (append | |
384 paramsa | |
385 (list (cons 'width (frame-width)))))) | |
386 (frame | |
94274
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
387 (if (not (eq window-system 'x)) |
65753 | 388 (make-frame params) |
389 (let ((x-pointer-shape x-pointer-top-left-arrow) | |
390 (x-sensitive-text-pointer-shape | |
391 x-pointer-hand2)) | |
392 (make-frame params))))) | |
393 frame))) | |
394 ;; Put the buffer into the frame | |
395 (save-excursion | |
396 (select-frame (symbol-value frame-var)) | |
397 (switch-to-buffer (symbol-value buffer-var)) | |
398 (set-window-dedicated-p (selected-window) t)) | |
399 ;; Run hooks (like reposition) | |
400 (run-hooks 'create-hook) | |
401 ;; Frame name | |
402 (if (and (or (null window-system) (eq window-system 'pc)) | |
403 (fboundp 'set-frame-name)) | |
404 (save-window-excursion | |
405 (select-frame (symbol-value frame-var)) | |
406 (set-frame-name frame-name))) | |
407 ;; On a terminal, raise the frame or the user will | |
408 ;; be confused. | |
409 (if (not window-system) | |
410 (select-frame (symbol-value frame-var))) | |
411 ))) ) | |
412 | |
413 (defun dframe-reposition-frame (new-frame parent-frame location) | |
414 "Move NEW-FRAME to be relative to PARENT-FRAME. | |
415 LOCATION can be one of 'random, 'left, 'right, 'left-right, or 'top-bottom." | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
416 (if (featurep 'xemacs) |
65753 | 417 (dframe-reposition-frame-xemacs new-frame parent-frame location) |
418 (dframe-reposition-frame-emacs new-frame parent-frame location))) | |
419 | |
95839
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
420 ;; Not defined in builds without X, but behind window-system test. |
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
421 (declare-function x-display-pixel-width "xfns.c" (&optional terminal)) |
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
422 (declare-function x-display-pixel-height "xfns.c" (&optional terminal)) |
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
423 |
65753 | 424 (defun dframe-reposition-frame-emacs (new-frame parent-frame location) |
425 "Move NEW-FRAME to be relative to PARENT-FRAME. | |
426 LOCATION can be one of 'random, 'left-right, 'top-bottom, or | |
99368
4a940838ff4c
* dframe.el (dframe-mouse-position-function)
Juanma Barranquero <lekktu@gmail.com>
parents:
95839
diff
changeset
|
427 a cons cell indicating a position of the form (LEFT . TOP)." |
95839
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
428 ;; Position dframe. |
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
429 ;; Do no positioning if not on a windowing system, |
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
430 (unless (or (not window-system) (eq window-system 'pc)) |
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
431 (let* ((pfx (dframe-frame-parameter parent-frame 'left)) |
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
432 (pfy (dframe-frame-parameter parent-frame 'top)) |
110391
bbc922c0cfa8
Expose tool-bar pixel width to lisp and use it for speedbar (Bug#7048)
Jan D <jan.h.d@swipnet.se>
parents:
106815
diff
changeset
|
433 (pfw (+ (tool-bar-pixel-width parent-frame) |
bbc922c0cfa8
Expose tool-bar pixel width to lisp and use it for speedbar (Bug#7048)
Jan D <jan.h.d@swipnet.se>
parents:
106815
diff
changeset
|
434 (frame-pixel-width parent-frame))) |
95839
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
435 (pfh (frame-pixel-height parent-frame)) |
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
436 (nfw (frame-pixel-width new-frame)) |
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
437 (nfh (frame-pixel-height new-frame)) |
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
438 newleft newtop) |
65753 | 439 ;; Rebuild pfx,pfy to be absolute positions. |
440 (setq pfx (if (not (consp pfx)) | |
441 pfx | |
442 ;; If pfx is a list, that means we grow | |
443 ;; from a specific edge of the display. | |
444 ;; Convert that to the distance from the | |
445 ;; left side of the display. | |
446 (if (eq (car pfx) '-) | |
447 ;; A - means distance from the right edge | |
448 ;; of the display, or DW - pfx - framewidth | |
449 (- (x-display-pixel-width) (car (cdr pfx)) pfw) | |
450 (car (cdr pfx)))) | |
451 pfy (if (not (consp pfy)) | |
452 pfy | |
453 ;; If pfy is a list, that means we grow | |
454 ;; from a specific edge of the display. | |
455 ;; Convert that to the distance from the | |
456 ;; left side of the display. | |
457 (if (eq (car pfy) '-) | |
458 ;; A - means distance from the right edge | |
459 ;; of the display, or DW - pfx - framewidth | |
460 (- (x-display-pixel-height) (car (cdr pfy)) pfh) | |
95839
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
461 (car (cdr pfy))))) |
65753 | 462 (cond ((eq location 'right) |
110391
bbc922c0cfa8
Expose tool-bar pixel width to lisp and use it for speedbar (Bug#7048)
Jan D <jan.h.d@swipnet.se>
parents:
106815
diff
changeset
|
463 (setq newleft (+ pfx pfw 10) |
65753 | 464 newtop pfy)) |
465 ((eq location 'left) | |
67226
fd62535b63a8
(dframe-reposition-frame-emacs): Fix position computation for 'left
Romain Francoise <romain@orebokech.com>
parents:
65866
diff
changeset
|
466 (setq newleft (- pfx 10 nfw) |
65753 | 467 newtop pfy)) |
468 ((eq location 'left-right) | |
469 (setq newleft | |
470 ;; Decide which side to put it on. 200 is just a | |
471 ;; buffer for the left edge of the screen. The | |
472 ;; extra 10 is just dressings for window | |
473 ;; decorations. | |
474 (let* ((left-guess (- pfx 10 nfw)) | |
110391
bbc922c0cfa8
Expose tool-bar pixel width to lisp and use it for speedbar (Bug#7048)
Jan D <jan.h.d@swipnet.se>
parents:
106815
diff
changeset
|
475 (right-guess (+ pfx pfw 10)) |
65753 | 476 (left-margin left-guess) |
477 (right-margin (- (x-display-pixel-width) | |
478 right-guess 5 nfw))) | |
479 (cond ((>= left-margin 0) left-guess) | |
480 ((>= right-margin 0) right-guess) | |
481 ;; otherwise choose side we overlap less | |
482 ((> left-margin right-margin) 0) | |
483 (t (- (x-display-pixel-width) nfw 5)))) | |
95839
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
484 newtop pfy)) |
65753 | 485 ((eq location 'top-bottom) |
486 (setq newleft pfx | |
487 newtop | |
488 ;; Try and guess if we should be on the top or bottom. | |
489 (let* ((top-guess (- pfy 15 nfh)) | |
490 (bottom-guess (+ pfy 5 pfh)) | |
491 (top-margin top-guess) | |
492 (bottom-margin (- (x-display-pixel-height) | |
493 bottom-guess 5 nfh))) | |
494 (cond ((>= top-margin 0) top-guess) | |
495 ((>= bottom-margin 0) bottom-guess) | |
496 ;; Choose a side to overlap the least. | |
497 ((> top-margin bottom-margin) 0) | |
95839
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
498 (t (- (x-display-pixel-height) nfh 5)))))) |
65753 | 499 ((consp location) |
500 (setq newleft (or (car location) 0) | |
501 newtop (or (cdr location) 0))) | |
502 (t nil)) | |
503 (modify-frame-parameters new-frame | |
95839
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
504 (list (cons 'left newleft) |
564317b2d075
(dframe-reposition-frame-emacs): Reorder test, and use unless.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
505 (cons 'top newtop)))))) |
65753 | 506 |
507 (defun dframe-reposition-frame-xemacs (new-frame parent-frame location) | |
508 "Move NEW-FRAME to be relative to PARENT-FRAME. | |
509 LOCATION can be one of 'random, 'left-right, or 'top-bottom." | |
510 ;; Not yet implemented | |
511 ) | |
512 | |
513 ;; XEmacs function only. | |
514 (defun dframe-needed-height (&optional frame) | |
515 "The needed height for the tool bar FRAME (in characters)." | |
516 (or frame (setq frame (selected-frame))) | |
517 ;; The 1 is the missing modeline/minibuffer | |
518 (+ 1 (/ (frame-pixel-height frame) | |
519 ;; This obscure code avoids a byte compiler warning in Emacs. | |
520 (let ((f 'face-height)) | |
521 (funcall f 'default frame))))) | |
522 | |
523 (defun dframe-detach (frame-var cache-var buffer-var) | |
524 "Detatch the frame in symbol FRAME-VAR. | |
525 CACHE-VAR and BUFFER-VAR are symbols as in `dframe-frame-mode'" | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
526 (with-current-buffer (symbol-value buffer-var) |
65753 | 527 (rename-buffer (buffer-name) t) |
528 (let ((oldframe (symbol-value frame-var))) | |
529 (set buffer-var nil) | |
530 (set frame-var nil) | |
531 (set cache-var nil) | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
532 ;; FIXME: Looks very suspicious. Luckily this function is unused. |
65753 | 533 (make-variable-buffer-local frame-var) |
534 (set frame-var oldframe) | |
535 ))) | |
536 | |
537 ;;; Special frame event proxies | |
538 ;; | |
539 (if (boundp 'special-event-map) | |
540 (progn | |
541 (define-key special-event-map [make-frame-visible] | |
542 'dframe-handle-make-frame-visible) | |
543 (define-key special-event-map [iconify-frame] | |
544 'dframe-handle-iconify-frame) | |
545 (define-key special-event-map [delete-frame] | |
546 'dframe-handle-delete-frame)) | |
547 ) | |
548 | |
549 (defvar dframe-make-frame-visible-function nil | |
550 "Function used when a dframe controlled frame is de-iconified. | |
551 The function must take an EVENT.") | |
552 (defvar dframe-iconify-frame-function nil | |
553 "Function used when a dframe controlled frame is iconified. | |
554 The function must take an EVENT.") | |
555 (defvar dframe-delete-frame-function nil | |
556 "Function used when a frame attached to a dframe frame is deleted. | |
557 The function must take an EVENT.") | |
558 | |
559 (defun dframe-handle-make-frame-visible (e) | |
560 "Handle a `make-frame-visible' event. | |
68561
6c2778476533
(dframe-handle-make-frame-visible, dframe-handle-iconify-frame,
Juanma Barranquero <lekktu@gmail.com>
parents:
67226
diff
changeset
|
561 Should enable auto-updating if the last state was also enabled. |
65753 | 562 Argument E is the event making the frame visible." |
563 (interactive "e") | |
564 (let ((f last-event-frame)) | |
565 (if (and (dframe-attached-frame f) | |
566 dframe-make-frame-visible-function) | |
567 (funcall dframe-make-frame-visible-function e) | |
568 ))) | |
569 | |
570 (defun dframe-handle-iconify-frame (e) | |
571 "Handle a `iconify-frame' event. | |
68561
6c2778476533
(dframe-handle-make-frame-visible, dframe-handle-iconify-frame,
Juanma Barranquero <lekktu@gmail.com>
parents:
67226
diff
changeset
|
572 Should disable auto-updating if the last state was also enabled. |
65753 | 573 Argument E is the event iconifying the frame." |
574 (interactive "e") | |
575 (let ((f last-event-frame)) | |
576 (if (and (dframe-attached-frame f) | |
577 dframe-iconify-frame-function e) | |
578 (funcall dframe-iconify-frame-function) | |
579 ))) | |
580 | |
581 (defun dframe-handle-delete-frame (e) | |
582 "Handle `delete-frame' event. | |
583 Argument E is the event deleting the frame." | |
584 (interactive "e") | |
585 (let ((fl (frame-list)) | |
586 (sf (selected-frame))) | |
587 ;; Loop over all frames. If dframe-delete-frame-function is | |
588 ;; non-nil, call it. | |
589 (while fl | |
590 (select-frame (car fl)) | |
591 (if dframe-delete-frame-function | |
592 (funcall dframe-delete-frame-function e)) | |
593 (setq fl (cdr fl))) | |
594 (if (frame-live-p sf) | |
595 (select-frame sf)) | |
596 (handle-delete-frame e))) | |
597 | |
598 | |
599 ;;; Utilities | |
600 ;; | |
601 (defun dframe-get-focus (frame-var activator &optional hook) | |
602 "Change frame focus to or from a dedicated frame. | |
603 If the selected frame is not in the symbol FRAME-VAR, then FRAME-VAR | |
604 frame is selected. If the FRAME-VAR is active, then select the | |
605 attached frame. If FRAME-VAR is nil, ACTIVATOR is called to | |
606 created it. HOOK is an optional argument of hooks to run when | |
68561
6c2778476533
(dframe-handle-make-frame-visible, dframe-handle-iconify-frame,
Juanma Barranquero <lekktu@gmail.com>
parents:
67226
diff
changeset
|
607 selecting FRAME-VAR." |
65753 | 608 (interactive) |
609 (if (eq (selected-frame) (symbol-value frame-var)) | |
610 (if (frame-live-p dframe-attached-frame) | |
611 (dframe-select-attached-frame)) | |
612 ;; make sure we have a frame | |
613 (if (not (frame-live-p (symbol-value frame-var))) | |
614 (funcall activator 1)) | |
615 ;; go there | |
616 (select-frame (symbol-value frame-var)) | |
617 ) | |
618 (other-frame 0) | |
619 ;; If updates are off, then refresh the frame (they want it now...) | |
620 (run-hooks 'hook)) | |
621 | |
622 | |
623 (defun dframe-close-frame () | |
624 "Close the current frame if it is dedicated." | |
625 (interactive) | |
626 (if dframe-controlled | |
627 (let ((b (current-buffer))) | |
628 (funcall dframe-controlled -1) | |
629 (kill-buffer b)))) | |
630 | |
631 (defun dframe-current-frame (frame-var desired-major-mode) | |
632 "Return the existing dedicated frame to use. | |
633 FRAME-VAR is the variable storing the currently active dedicated frame. | |
634 If the current frame's buffer uses DESIRED-MAJOR-MODE, then use that frame." | |
635 (if (not (eq (selected-frame) (symbol-value frame-var))) | |
636 (if (and (eq major-mode 'desired-major-mode) | |
637 (get-buffer-window (current-buffer)) | |
638 (window-frame (get-buffer-window (current-buffer)))) | |
639 (window-frame (get-buffer-window (current-buffer))) | |
640 (symbol-value frame-var)) | |
641 (symbol-value frame-var))) | |
642 | |
643 (defun dframe-attached-frame (&optional frame) | |
644 "Return the attached frame belonging to the dframe controlled frame FRAME. | |
645 If optional arg FRAME is nil just return `dframe-attached-frame'." | |
646 (save-excursion | |
647 (if frame (select-frame frame)) | |
648 dframe-attached-frame)) | |
649 | |
650 (defun dframe-select-attached-frame (&optional frame) | |
68561
6c2778476533
(dframe-handle-make-frame-visible, dframe-handle-iconify-frame,
Juanma Barranquero <lekktu@gmail.com>
parents:
67226
diff
changeset
|
651 "Switch to the frame the dframe controlled frame FRAME was started from. |
6c2778476533
(dframe-handle-make-frame-visible, dframe-handle-iconify-frame,
Juanma Barranquero <lekktu@gmail.com>
parents:
67226
diff
changeset
|
652 If optional arg FRAME is nil assume the attached frame is already selected |
6c2778476533
(dframe-handle-make-frame-visible, dframe-handle-iconify-frame,
Juanma Barranquero <lekktu@gmail.com>
parents:
67226
diff
changeset
|
653 and just run the hooks `dframe-after-select-attached-frame-hook'. Return |
6c2778476533
(dframe-handle-make-frame-visible, dframe-handle-iconify-frame,
Juanma Barranquero <lekktu@gmail.com>
parents:
67226
diff
changeset
|
654 the attached frame." |
65753 | 655 (let ((frame (dframe-attached-frame frame))) |
656 (if frame (select-frame frame)) | |
657 (prog1 frame | |
658 (run-hooks 'dframe-after-select-attached-frame-hook)))) | |
659 | |
660 (defmacro dframe-with-attached-buffer (&rest forms) | |
661 "Execute FORMS in the attached frame's special buffer. | |
662 Optionally select that frame if necessary." | |
663 `(save-selected-window | |
664 ;;(speedbar-set-timer speedbar-update-speed) | |
665 (dframe-select-attached-frame) | |
666 ,@forms | |
667 (dframe-maybee-jump-to-attached-frame))) | |
668 | |
669 (defun dframe-maybee-jump-to-attached-frame () | |
670 "Jump to the attached frame ONLY if this was not a mouse event." | |
671 (when (or (not (dframe-mouse-event-p last-input-event)) | |
672 dframe-activity-change-focus-flag) | |
673 (dframe-select-attached-frame) | |
65866
df5f6fcce1be
(x-pointer-hand2, x-pointer-top-left-arrow): Add defvars.
Juanma Barranquero <lekktu@gmail.com>
parents:
65825
diff
changeset
|
674 ;; KB: For what is this - raising the frame?? |
65753 | 675 (other-frame 0))) |
676 | |
677 | |
678 (defvar dframe-suppress-message-flag nil | |
679 "Non-nil means that `dframe-message' should just return a string.") | |
680 | |
681 (defun dframe-message (fmt &rest args) | |
682 "Like message, but for use in a dedicated frame. | |
683 Argument FMT is the format string, and ARGS are the arguments for message." | |
684 (save-selected-window | |
685 (if dframe-suppress-message-flag | |
686 (apply 'format fmt args) | |
687 (if dframe-attached-frame | |
688 ;; KB: Here we do not need calling `dframe-select-attached-frame' | |
689 (select-frame dframe-attached-frame)) | |
690 (apply 'message fmt args)))) | |
691 | |
692 (defun dframe-y-or-n-p (prompt) | |
693 "Like `y-or-n-p', but for use in a dedicated frame. | |
694 Argument PROMPT is the prompt to use." | |
695 (save-selected-window | |
696 (if (and ;;default-minibuffer-frame | |
697 dframe-attached-frame | |
698 ;;(not (eq default-minibuffer-frame dframe-attached-frame)) | |
699 ) | |
700 ;; KB: Here we do not need calling `dframe-select-attached-frame' | |
701 (select-frame dframe-attached-frame)) | |
702 (y-or-n-p prompt))) | |
703 | |
704 ;;; timer management | |
705 ;; | |
706 ;; Unlike speedbar with a dedicated set of routines, dframe has one master | |
707 ;; timer, and all dframe users will use it. At least until I figure out a way | |
708 ;; around that problem. | |
709 ;; | |
710 ;; Advantage 1: Two apps with timer/frames can munge the master list | |
711 ;; to make sure they occur in order. | |
712 ;; Advantage 2: If a user hits a key between timer functions, we can | |
713 ;; interrupt them safely. | |
714 (defvar dframe-client-functions nil | |
715 "List of client functions using the dframe timer.") | |
716 | |
717 (defun dframe-set-timer (timeout fn &optional null-on-error) | |
718 "Apply a timer with TIMEOUT, to call FN, or remove a timer if TIMEOUT is nil. | |
719 TIMEOUT is the number of seconds until the dframe controled program | |
720 timer is called again. When TIMEOUT is nil, turn off all timeouts. | |
721 This function must be called from the buffer belonging to the program | |
722 who requested the timer. | |
723 If NULL-ON-ERROR is a symbol, set it to nil if we cannot create a timer." | |
724 ;; First, fix up our list of client functions | |
725 (if timeout | |
726 (add-to-list 'dframe-client-functions fn) | |
727 (setq dframe-client-functions (delete fn dframe-client-functions))) | |
728 ;; Now decided what to do about the timout. | |
729 (if (or | |
730 ;; We have a timer, restart the timer with the new time. | |
731 timeout | |
732 ;; We have a timer, an off is requested, and no client | |
733 ;; functions are left, shut er down. | |
734 (and dframe-timer (not timeout) dframe-client-functions)) | |
735 ;; Only call the low level function if we are changing the state. | |
736 (dframe-set-timer-internal timeout null-on-error))) | |
737 | |
738 (defun dframe-set-timer-internal (timeout &optional null-on-error) | |
94274
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
739 "Apply a timer with TIMEOUT to call the dframe timer manager." |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
740 (when dframe-timer |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
741 (if (featurep 'xemacs) |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
742 (delete-itimer dframe-timer) |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
743 (cancel-timer dframe-timer)) |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
744 (setq dframe-timer nil)) |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
745 (when timeout |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
746 (setq dframe-timer |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
747 (if (featurep 'xemacs) |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
748 (start-itimer "dframe" 'dframe-timer-fn |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
749 timeout timeout t) |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
750 (run-with-idle-timer timeout t 'dframe-timer-fn))))) |
65753 | 751 |
752 (defun dframe-timer-fn () | |
753 "Called due to the dframe timer. | |
754 Evaluates all cached timer functions in sequence." | |
755 (let ((l dframe-client-functions)) | |
756 (while (and l (sit-for 0)) | |
757 (condition-case er | |
758 (funcall (car l)) | |
759 (error (message "DFRAME TIMER ERROR: %S" er))) | |
760 (setq l (cdr l))))) | |
761 | |
762 ;;; Menu hacking for mouse-3 | |
763 ;; | |
764 (defconst dframe-pass-event-to-popup-mode-menu | |
765 (let (max-args) | |
766 (and (fboundp 'popup-mode-menu) | |
767 (fboundp 'function-max-args) | |
768 (setq max-args (function-max-args 'popup-mode-menu)) | |
769 (not (zerop max-args)))) | |
99368
4a940838ff4c
* dframe.el (dframe-mouse-position-function)
Juanma Barranquero <lekktu@gmail.com>
parents:
95839
diff
changeset
|
770 "The EVENT arg to `popup-mode-menu' was introduced in XEmacs 21.4.0.") |
65753 | 771 |
772 ;; In XEmacs, we make popup menus work on the item over mouse (as | |
773 ;; opposed to where the point happens to be.) We attain this by | |
774 ;; temporarily moving the point to that place. | |
775 ;; Hrvoje Niksic <hniksic@srce.hr> | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
776 (defalias 'dframe-popup-kludge |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
777 (if (featurep 'xemacs) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
778 (lambda (event) ; XEmacs. |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
779 "Pop up a menu related to the clicked on item. |
65753 | 780 Must be bound to EVENT." |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
781 (interactive "e") |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
782 (save-excursion |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
783 (if dframe-pass-event-to-popup-mode-menu |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
784 (popup-mode-menu event) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
785 (goto-char (event-closest-point event)) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
786 (beginning-of-line) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
787 (forward-char (min 5 (- (save-excursion (end-of-line) (point)) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
788 (save-excursion (beginning-of-line) (point))))) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
789 (popup-mode-menu)) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
790 ;; Wait for menu to bail out. `popup-mode-menu' (and other popup |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
791 ;; menu functions) return immediately. |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
792 (let (new) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
793 (while (not (misc-user-event-p (setq new (next-event)))) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
794 (dispatch-event new)) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
795 (dispatch-event new)))) |
65753 | 796 |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
797 (lambda (e) ; Emacs. |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
798 "Pop up a menu related to the clicked on item. |
65753 | 799 Must be bound to event E." |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
800 (interactive "e") |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
801 (save-excursion |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
802 (mouse-set-point e) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
803 ;; This gets the cursor where the user can see it. |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
804 (if (not (bolp)) (forward-char -1)) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
805 (sit-for 0) |
94274
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
806 (if (fboundp 'mouse-menu-major-mode-map) |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
807 (popup-menu (mouse-menu-major-mode-map) e) |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
808 (with-no-warnings ; don't warn about obsolete fallback |
b9513e9a71ae
(dframe-have-timer-flag): Drop support for Emacs without timers. Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
809 (mouse-major-mode-menu e nil))))))) |
65753 | 810 |
811 ;;; Interactive user functions for the mouse | |
812 ;; | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
813 (defalias 'dframe-mouse-event-p |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
814 (if (featurep 'xemacs) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
815 'button-press-event-p |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
816 (lambda (event) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
817 "Return t if the event is a mouse related event." |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
818 (if (and (listp event) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
819 (member (event-basic-type event) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
820 '(mouse-1 mouse-2 mouse-3))) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
821 t |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
822 nil)))) |
65753 | 823 |
824 (defun dframe-track-mouse (event) | |
825 "For motion EVENT, display info about the current line." | |
826 (interactive "e") | |
827 (when (and dframe-track-mouse-function | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
828 (or (featurep 'xemacs) ;; XEmacs always safe? |
65753 | 829 (windowp (posn-window (event-end event))) ; Sometimes |
830 ; there is no window to jump into. | |
831 )) | |
65866
df5f6fcce1be
(x-pointer-hand2, x-pointer-top-left-arrow): Add defvars.
Juanma Barranquero <lekktu@gmail.com>
parents:
65825
diff
changeset
|
832 |
65753 | 833 (funcall dframe-track-mouse-function event))) |
834 | |
835 (defun dframe-track-mouse-xemacs (event) | |
836 "For motion EVENT, display info about the current line." | |
837 (if (functionp (default-value 'mouse-motion-handler)) | |
838 (funcall (default-value 'mouse-motion-handler) event)) | |
839 (if dframe-track-mouse-function | |
840 (funcall dframe-track-mouse-function event))) | |
841 | |
842 (defun dframe-help-echo (window &optional buffer position) | |
843 "Display help based context. | |
844 The context is in WINDOW, viewing BUFFER, at POSITION. | |
845 BUFFER and POSITION are optional because XEmacs doesn't use them." | |
846 (when (and (not dframe-track-mouse-function) | |
847 (bufferp buffer) | |
848 dframe-help-echo-function) | |
849 (let ((dframe-suppress-message-flag t)) | |
850 (with-current-buffer buffer | |
65825
b89d9c4d5386
* info.el (Info-next, Info-prev, Info-up): Select info buffer, in
Chong Yidong <cyd@stupidchicken.com>
parents:
65780
diff
changeset
|
851 (save-excursion |
b89d9c4d5386
* info.el (Info-next, Info-prev, Info-up): Select info buffer, in
Chong Yidong <cyd@stupidchicken.com>
parents:
65780
diff
changeset
|
852 (if position (goto-char position)) |
b89d9c4d5386
* info.el (Info-next, Info-prev, Info-up): Select info buffer, in
Chong Yidong <cyd@stupidchicken.com>
parents:
65780
diff
changeset
|
853 (funcall dframe-help-echo-function)))))) |
65753 | 854 |
855 (defun dframe-mouse-set-point (e) | |
99368
4a940838ff4c
* dframe.el (dframe-mouse-position-function)
Juanma Barranquero <lekktu@gmail.com>
parents:
95839
diff
changeset
|
856 "Set point based on event E. |
65753 | 857 Handles clicking on images in XEmacs." |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
858 (if (and (featurep 'xemacs) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
859 (save-excursion |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
860 (save-window-excursion |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
861 (mouse-set-point e) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
862 (event-over-glyph-p e)))) |
65753 | 863 ;; We are in XEmacs, and clicked on a picture |
864 (let ((ext (event-glyph-extent e))) | |
865 ;; This position is back inside the extent where the | |
866 ;; junk we pushed into the property list lives. | |
867 (if (extent-end-position ext) | |
868 (goto-char (1- (extent-end-position ext))) | |
869 (mouse-set-point e))) | |
870 ;; We are not in XEmacs, OR we didn't click on a picture. | |
871 (mouse-set-point e))) | |
872 | |
873 (defun dframe-quick-mouse (e) | |
874 "Since mouse events are strange, this will keep the mouse nicely positioned. | |
875 This should be bound to mouse event E." | |
876 (interactive "e") | |
877 (dframe-mouse-set-point e) | |
878 (if dframe-mouse-position-function | |
879 (funcall dframe-mouse-position-function))) | |
880 | |
881 (defun dframe-power-click (e) | |
68561
6c2778476533
(dframe-handle-make-frame-visible, dframe-handle-iconify-frame,
Juanma Barranquero <lekktu@gmail.com>
parents:
67226
diff
changeset
|
882 "Activate any dframe mouse click as a power click. |
65753 | 883 A power click will dispose of cached data (if available) or bring a buffer |
884 up into a different window. | |
885 This should be bound to mouse event E." | |
886 (interactive "e") | |
887 (let ((dframe-power-click t)) | |
888 (select-frame last-event-frame) | |
889 (dframe-click e))) | |
890 | |
891 (defun dframe-click (e) | |
892 "Call our clients click function on a user click. | |
893 E is the event causing the click." | |
894 (interactive "e") | |
895 (dframe-mouse-set-point e) | |
896 (when dframe-mouse-click-function | |
897 ;; On the off chance of buffer switch, or something incorrectly | |
898 ;; configured. | |
899 (funcall dframe-mouse-click-function e))) | |
900 | |
901 (defun dframe-double-click (e) | |
902 "Activate the registered click function on a double click. | |
903 This must be bound to a mouse event. | |
904 This should be bound to mouse event E." | |
905 (interactive "e") | |
906 ;; Emacs only. XEmacs handles this via `mouse-track-click-hook'. | |
907 (cond ((eq (car e) 'down-mouse-1) | |
908 (dframe-mouse-set-point e)) | |
909 ((eq (car e) 'mouse-1) | |
910 (dframe-quick-mouse e)) | |
911 ((or (eq (car e) 'double-down-mouse-1) | |
912 (eq (car e) 'triple-down-mouse-1)) | |
913 (dframe-click e)))) | |
914 | |
915 ;;; Hacks of normal things. | |
916 ;; | |
917 ;; Some normal things that happen in one of these dedicated frames | |
918 ;; must be handled specially, so that our dedicated frame isn't | |
919 ;; messed up. | |
920 (defun dframe-temp-buffer-show-function (buffer) | |
921 "Placed in the variable `temp-buffer-show-function' in dedicated frames. | |
922 If a user requests help using \\[help-command] <Key> the temp BUFFER will be | |
923 redirected into a window on the attached frame." | |
924 (if dframe-attached-frame (dframe-select-attached-frame)) | |
925 (pop-to-buffer buffer nil) | |
926 (other-window -1) | |
927 ;; Fix for using this hook on some platforms: Bob Weiner | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
928 (cond ((not (featurep 'xemacs)) |
65753 | 929 (run-hooks 'temp-buffer-show-hook)) |
930 ((fboundp 'run-hook-with-args) | |
931 (run-hook-with-args 'temp-buffer-show-hook buffer)) | |
932 ((and (boundp 'temp-buffer-show-hook) | |
933 (listp temp-buffer-show-hook)) | |
934 (mapcar (function (lambda (hook) (funcall hook buffer))) | |
935 temp-buffer-show-hook)))) | |
936 | |
937 (defun dframe-hack-buffer-menu (e) | |
938 "Control mouse 1 is buffer menu. | |
939 This hack overrides it so that the right thing happens in the main | |
940 Emacs frame, not in the dedicated frame. | |
941 Argument E is the event causing this activity." | |
942 (interactive "e") | |
78630
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
943 (let ((fn (lookup-key global-map (if (featurep 'xemacs) |
0a2e0422ddd5
Remove spurious * in custom docstrings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
944 '(control button1) |
65753 | 945 [C-down-mouse-1]))) |
946 (oldbuff (current-buffer)) | |
947 (newbuff nil)) | |
948 (unwind-protect | |
949 (save-excursion | |
950 (set-window-dedicated-p (selected-window) nil) | |
951 (call-interactively fn) | |
952 (setq newbuff (current-buffer))) | |
953 (switch-to-buffer oldbuff) | |
954 (set-window-dedicated-p (selected-window) t)) | |
955 (if (not (eq newbuff oldbuff)) | |
956 (dframe-with-attached-buffer | |
957 (switch-to-buffer newbuff))))) | |
958 | |
959 (defun dframe-switch-buffer-attached-frame (&optional buffer) | |
960 "Switch to BUFFER in the attached frame, and raise that frame. | |
961 This overrides the default behavior of `switch-to-buffer' which is | |
962 broken because of the dedicated frame." | |
963 (interactive) | |
964 ;; Assume we are in the dedicated frame. | |
965 (other-frame 1) | |
966 ;; Now switch buffers | |
967 (if buffer | |
968 (switch-to-buffer buffer) | |
969 (call-interactively 'switch-to-buffer nil nil))) | |
970 | |
971 ;; XEmacs: this can be implemented using modeline keymaps, but there | |
972 ;; is no use, as we have horizontal scrollbar (as the docstring | |
973 ;; hints.) | |
974 (defun dframe-mouse-hscroll (e) | |
975 "Read a mouse event E from the mode line, and horizontally scroll. | |
976 If the mouse is being clicked on the far left, or far right of the | |
977 mode-line. This is only useful for non-XEmacs." | |
978 (interactive "e") | |
979 (let* ((x-point (car (nth 2 (car (cdr e))))) | |
980 (pixels-per-10-col (/ (* 10 (frame-pixel-width)) | |
981 (frame-width))) | |
982 (click-col (1+ (/ (* 10 x-point) pixels-per-10-col))) | |
983 ) | |
984 (cond ((< click-col 3) | |
985 (scroll-left 2)) | |
986 ((> click-col (- (window-width) 5)) | |
987 (scroll-right 2)) | |
988 (t (dframe-message | |
989 "Click on the edge of the modeline to scroll left/right"))) | |
990 )) | |
991 | |
992 (provide 'dframe) | |
993 | |
65779 | 994 ;; arch-tag: df9b91b6-e85e-4a76-a02e-b3cb5b686bd4 |
65753 | 995 ;;; dframe.el ends here |