lisp/dframe.el

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