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