lisp/dframe.el

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