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