cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/hui-window.el

   1 ;;; hui-window.el --- Smart Mouse Key window and modeline depress/release actions.
   2
   3 ;; Copyright (C) 1992-1995, 2006, 2008 Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   8 ;; Keywords: hypermedia, mouse
   9
  10 ;; This file is part of GNU Hyperbole.
  11
  12 ;; GNU Hyperbole is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 3, or (at
  15 ;; your option) any later version.
  16
  17 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;;   Must be loaded AFTER hmouse-alist has been defined in
  30 ;;   "hui-mouse.el".
  31 ;;
  32 ;;   Handles drags in same window or across windows and modeline depresses.
  33 ;;
  34 ;; What drags and modeline presses do.
  35 ;; ==============================================================================
  36 ;;                                              Smart Keys
  37 ;; Context                         Action Key                 Assist Key
  38 ;; ==============================================================================
  39 ;; Drag horizontally within window
  40 ;;     Left to right               Scroll to buffer end       Split window across
  41 ;;     Right to left               Scroll to buffer begin     Delete window
  42 ;; Click in modeline
  43 ;;     Left window edge            Bury buffer                Unbury bottom buffer
  44 ;;     Right window edge           Info                       Smart Key Summary
  45 ;;     Otherwise                   Action Key Hook            Assist Key Hook
  46 ;; Modeline depress & wind release Resize window height       <- same
  47 ;; Drag from shared window side    Resize window's width      <- same
  48 ;; Drag from one window to another Create/modify a link but   Swap buffers
  49 ;; Drag vertically within window   Split window sideways      <- same
  50 ;; Drag diagonally within window   Save ring frame-config     Restore ring config
  51 ;;
  52
  53 ;;; Code:
  54
  55 ;;;
  56 ;;; Public variables
  57 ;;;
  58
  59 (defcustom action-key-modeline-hook nil
  60   "*A list of functions to call when the Action Mouse Key is clicked
  61 in the center portion of a modeline."
  62   :type 'hook
  63   :options '(hmouse-context-buffer-menu hmouse-context-ibuffer-menu)
  64   :group 'hyperbole)
  65
  66 ;(defvar action-key-modeline-hook 'hmouse-context-menu
  67 ;  "A list of functions to call when the Action Mouse Key is clicked in the center portion of a modeline.")
  68
  69 (defvar assist-key-modeline-hook nil
  70   "A list of functions to call when the Assist Mouse Key is clicked in the center portion of a modeline.")
  71
  72 (defvar hmouse-edge-sensitivity 10
  73   "*Number of characters from window edges within which a click is considered at an edge.")
  74
  75 (defvar hmouse-side-sensitivity (if hyperb:emacs19-p 2 1)
  76   "*Characters in either direction from window side within which a click is considered on the side.")
  77
  78 (defvar hmouse-x-drag-sensitivity 5
  79   "*Number of chars mouse must move horizontally between depress/release to register a horizontal drag.")
  80
  81 (defvar hmouse-y-drag-sensitivity 3
  82   "*Number of lines mouse must move vertically between depress/release to register a vertical drag.")
  83
  84 (defvar hmouse-x-diagonal-sensitivity 4
  85   "*Number of chars mouse must move horizontally between depress/release to register a diagonal drag.")
  86 (defvar hmouse-y-diagonal-sensitivity 3
  87   "*Number of lines mouse must move vertically between depress/release to register a diagonal drag.")
  88
  89 ;;;
  90 ;;; Add mode line handling to hmouse-alist dispatch table.
  91 ;;;
  92 (if (not (boundp 'hmouse-alist))
  93     (error
  94       "\"hui-modeln.el\": hmouse-alist must be defined before loading this.")
  95   (or (memq 'hmouse-drag-window-side
  96             (mapcar (function (lambda (elt) (let ((pred (car elt)))
  97                                               (if (listp pred) (car pred)))))
  98                     hmouse-alist))
  99       (setq hmouse-alist
 100             (append
 101               '(
 102                 ((hmouse-drag-window-side) .
 103                  ((hmouse-resize-window-side) .
 104                   (hmouse-resize-window-side 'assist)))
 105                 ((setq hkey-value
 106                        (and (not (hmouse-drag-between-windows))
 107                             (hmouse-drag-horizontally))) .
 108                  ((hmouse-horizontal) . (hmouse-horizontal-assist)))
 109                 ((hmouse-modeline-depress) .
 110                  ((action-key-modeline) . (assist-key-modeline)))
 111                 ((hmouse-drag-between-windows) .
 112                  ((hui:link-directly) . (hmouse-swap-buffers 'assist)))
 113                 ((hmouse-drag-vertically) .
 114                  ((sm-split-window-horizontally) .
 115                   (sm-split-window-horizontally)))
 116                 ((setq hkey-value (hmouse-drag-diagonally)) .
 117                  ((wconfig-ring-save) .
 118                   (wconfig-yank-pop
 119                     (prefix-numeric-value current-prefix-arg))))
 120                 )
 121               hmouse-alist))))
 122
 123
 124 ;;;
 125 ;;; Public functions
 126 ;;;
 127
 128 (defun hmouse-drag-between-windows ()
 129   "Returns non-nil if last Action Key depress and release were in different windows.
 130 If free variable 'assist-flag' is non-nil, uses Assist Key."
 131   (if assist-flag
 132       (and assist-key-depress-window assist-key-release-window
 133            (not (eq assist-key-depress-window
 134                     assist-key-release-window)))
 135     (and action-key-depress-window action-key-release-window
 136          (not (eq action-key-depress-window action-key-release-window)))))
 137
 138 (defun hmouse-drag-diagonally ()
 139   "Returns non-nil iff last Action Key use was a diagonal drag within a single window.
 140 If free variable 'assist-flag' is non-nil, uses Assist Key.
 141 Value returned is nil if not a diagonal drag, or one of the following symbols
 142 depending on the direction of the drag: southeast, southwest, northwest, northeast."
 143   (let ((last-depress-x) (last-release-x)
 144         (last-depress-y) (last-release-y))
 145     (if assist-flag
 146         (setq last-depress-x (hmouse-x-coord assist-key-depress-args)
 147               last-release-x (hmouse-x-coord assist-key-release-args)
 148               last-depress-y (hmouse-y-coord assist-key-depress-args)
 149               last-release-y (hmouse-y-coord assist-key-release-args))
 150       (setq last-depress-x (hmouse-x-coord action-key-depress-args)
 151             last-release-x (hmouse-x-coord action-key-release-args)
 152             last-depress-y (hmouse-y-coord action-key-depress-args)
 153             last-release-y (hmouse-y-coord action-key-release-args)))
 154     (and last-depress-x last-release-x last-depress-y last-release-y
 155          (>= (- (max last-depress-x last-release-x)
 156                 (min last-depress-x last-release-x))
 157              hmouse-x-diagonal-sensitivity)
 158          (>= (- (max last-depress-y last-release-y)
 159                 (min last-depress-y last-release-y))
 160              hmouse-y-diagonal-sensitivity)
 161          (cond
 162            ((< last-depress-x last-release-x)
 163             (if (< last-depress-y last-release-y)
 164                 'southeast 'northeast))
 165            (t (if (< last-depress-y last-release-y)
 166                   'southwest 'northwest))))))
 167
 168 (defun hmouse-drag-horizontally ()
 169   "Returns non-nil iff last Action Key use was a horizontal drag within a single window.
 170 If free variable 'assist-flag' is non-nil, uses Assist Key.
 171 Value returned is nil if not a horizontal drag, 'left if drag moved left or
 172 'right otherwise."
 173   (let ((last-depress-x) (last-release-x)
 174         (last-depress-y) (last-release-y))
 175     (if assist-flag
 176         (setq last-depress-x (hmouse-x-coord assist-key-depress-args)
 177               last-release-x (hmouse-x-coord assist-key-release-args)
 178               last-depress-y (hmouse-y-coord assist-key-depress-args)
 179               last-release-y (hmouse-y-coord assist-key-release-args))
 180       (setq last-depress-x (hmouse-x-coord action-key-depress-args)
 181             last-release-x (hmouse-x-coord action-key-release-args)
 182             last-depress-y (hmouse-y-coord action-key-depress-args)
 183             last-release-y (hmouse-y-coord action-key-release-args)))
 184     (and last-depress-x last-release-x last-depress-y last-release-y
 185          (>= (- (max last-depress-x last-release-x)
 186                 (min last-depress-x last-release-x))
 187              hmouse-x-drag-sensitivity)
 188          ;; Don't want to register vertical drags here, so ensure any
 189          ;; vertical movement was less than the vertical drag sensitivity.
 190          (< (- (max last-depress-y last-release-y)
 191                (min last-depress-y last-release-y))
 192             hmouse-y-drag-sensitivity)
 193          (if (< last-depress-x last-release-x) 'right 'left))))
 194
 195 (defun hmouse-drag-vertically ()
 196   "Returns non-nil iff last Action Key use was a vertical drag within a single window.
 197 If free variable 'assist-flag' is non-nil, uses Assist Key.
 198 Value returned is nil if not a vertical line drag, 'up if drag moved up or
 199 'down otherwise."
 200   (let ((last-depress-x) (last-release-x)
 201         (last-depress-y) (last-release-y))
 202     (if assist-flag
 203         (setq last-depress-x (hmouse-x-coord assist-key-depress-args)
 204               last-release-x (hmouse-x-coord assist-key-release-args)
 205               last-depress-y (hmouse-y-coord assist-key-depress-args)
 206               last-release-y (hmouse-y-coord assist-key-release-args))
 207       (setq last-depress-x (hmouse-x-coord action-key-depress-args)
 208             last-release-x (hmouse-x-coord action-key-release-args)
 209             last-depress-y (hmouse-y-coord action-key-depress-args)
 210             last-release-y (hmouse-y-coord action-key-release-args)))
 211     (and last-depress-x last-release-x last-depress-y last-release-y
 212          (>= (- (max last-depress-y last-release-y)
 213                 (min last-depress-y last-release-y))
 214              hmouse-y-drag-sensitivity)
 215          ;; Don't want to register horizontal drags here, so ensure any
 216          ;; horizontal movement was less than or equal to the horizontal drag
 217          ;; sensitivity.
 218          (<= (- (max last-depress-x last-release-x)
 219                 (min last-depress-x last-release-x))
 220              hmouse-x-drag-sensitivity)
 221          (if (< last-depress-y last-release-y) 'down 'up))))
 222
 223 (or (fboundp 'abs)
 224     (defun abs (number)
 225       "Return the absolute value of NUMBER."
 226       (cond
 227         ((< number 0)
 228          (- 0 number))
 229         (t number))))
 230
 231 (defun hmouse-drag-window-side ()
 232   "Returns non-nil if Action Key was dragged from a window side divider.
 233 If free variable 'assist-flag' is non-nil, uses Assist Key."
 234   (cond (hyperb:xemacs-p
 235          ;; Depress events in scrollbars or in non-text area of buffer are
 236          ;; not visible or identifiable at the Lisp-level, so always return
 237          ;; nil.
 238          nil)
 239         (hyperb:window-system
 240          (let* ((depress-args (if assist-flag assist-key-depress-args
 241                                 action-key-depress-args))
 242                 (release-args (if assist-flag assist-key-release-args
 243                                 action-key-release-args))
 244                 (w (smart-window-of-coords depress-args))
 245                 (side-ln (and w (1- (nth 2 (window-edges w)))))
 246                 (last-press-x   (hmouse-x-coord depress-args))
 247                 (last-release-x (hmouse-x-coord release-args)))
 248            (and last-press-x last-release-x side-ln
 249                 (/= last-press-x last-release-x)
 250                 (/= (1+ side-ln) (frame-width))
 251                 (<= (max (- last-press-x side-ln) (- side-ln last-press-x))
 252                     hmouse-side-sensitivity))))))
 253
 254 (defun sm-split-window-horizontally ()
 255   "Splits current window in two evenly, side by side.
 256 Beeps and prints message if can't split window further."
 257   (interactive)
 258   (let ((window-min-width 5))
 259     (condition-case ()
 260         (split-window-horizontally nil)
 261       (error (progn (beep)
 262                     (message
 263                      "(sm-split-window-horizontally): Can't split window further."))))))
 264
 265 (defun sm-split-window-vertically ()
 266   "Splits current window in two evenly, one above the other.
 267 Beeps and prints message if can't split window further."
 268   (interactive)
 269   (let ((window-min-height 2))
 270     (condition-case ()
 271         (if (fboundp 'split-window-quietly)
 272             (split-window-quietly nil)
 273           (split-window-vertically nil))
 274       (error
 275         (progn
 276           (beep)
 277           (message
 278             "(sm-split-window-vertically): Can't split window further."))))))
 279
 280 (defun smart-coords-in-window-p (coords window)
 281   "Tests if COORDS are in WINDOW.  Returns WINDOW if they are, nil otherwise."
 282   (cond ((and hyperb:emacs19-p (eventp coords))
 283          (eq (posn-window (event-start coords)) window))
 284         ((if hyperb:xemacs-p
 285              (if (eventp coords)
 286                  (eq (event-window coords) window)
 287                (eq (car coords) window))))
 288         ((fboundp 'window-edges)
 289          (let* ((edges (window-edges window))
 290                   (w-xmin (nth 0 edges))
 291                   (w-ymin (nth 1 edges))
 292                   (w-xmax (nth 2 edges))
 293                   (w-ymax (nth 3 edges))
 294                   (x  (hmouse-x-coord coords))
 295                   (y  (hmouse-y-coord coords)))
 296              (and (<= w-xmin x) (<= x w-xmax)
 297                   (<= w-ymin y) (<= y w-ymax)
 298                   window)))))
 299
 300 (defun smart-window-of-coords (coords)
 301   "Returns window in which COORDS fall or nil if none.
 302 Ignores minibuffer window."
 303   (cond ((and hyperb:emacs19-p (eventp coords))
 304          (posn-window (event-start coords)))
 305         ((if hyperb:xemacs-p
 306              (if (eventp coords)
 307                  (event-window coords)
 308                (car coords))))
 309         (t (let ((window-list (hypb:window-list 'no-minibuf))
 310                  (window)
 311                  (w))
 312              (while (and (not window) window-list)
 313                (setq w (car window-list)
 314                      window-list (cdr window-list)
 315                      window (smart-coords-in-window-p coords w)))
 316              window))))
 317
 318 ;;;
 319 ;;; Private functions
 320 ;;;
 321
 322 (defun hmouse-context-buffer-menu ()
 323   "If running under a window system, display or hide the buffer menu.
 324 If not running under a window system and Smart Menus are loaded, display the
 325 appropriate Smart Menu for the context at point."
 326   (if (and (fboundp 'smart-menu)
 327            (or (null window-system)
 328                (not (or hyperb:xemacs-p hyperb:emacs19-p))))
 329       (smart-menu)
 330     (let ((wind (get-buffer-window "*Buffer List*"))
 331           owind)
 332       (if wind
 333           (unwind-protect
 334               (progn (setq owind (selected-window))
 335                      (select-window wind)
 336                      (bury-buffer nil))
 337             (select-window owind))
 338         (buffer-menu nil)))))
 339
 340 (defun hmouse-context-ibuffer-menu ()
 341   "Display or hide an ibuffer"
 342   (let ((wind (get-buffer-window "*Ibuffer*"))
 343         owind)
 344     (if wind
 345         (unwind-protect
 346             (progn (setq owind (selected-window))
 347                    (select-window wind)
 348                    (bury-buffer nil))
 349           (select-window owind))
 350       (ibuffer))))
 351
 352 (defun hmouse-horizontal ()
 353   "Goes to buffer end if drag was to the right, otherwise goes to beginning."
 354   (if (eq hkey-value 'right)
 355       (end-of-buffer)
 356     (beginning-of-buffer)))
 357
 358 (defun hmouse-horizontal-assist ()
 359   "Splits window vertically if drag was to the right, otherwise deletes window."
 360   (if (eq hkey-value 'right)
 361       (sm-split-window-vertically)
 362     (delete-window)))
 363
 364 (defun action-key-modeline ()
 365   "Handles Action Key depresses on a window mode line.
 366 If key is:
 367  (1) clicked on left edge of a window's modeline,
 368      window's buffer is buried (placed at bottom of buffer list);
 369  (2) clicked on right edge of a window's modeline,
 370      the Info buffer is displayed, or if already displayed and the
 371      modeline clicked belongs to a window displaying Info, the Info
 372      buffer is hidden;
 373  (3) clicked anywhere in the middle of a window's modeline,
 374      the functions listed in 'action-key-modeline-hook' are called;
 375  (4) dragged vertically from modeline to within a window,
 376      the modeline is moved to point of key release, thereby resizing
 377      its window and potentially its vertical neighbors."
 378   (let ((w (smart-window-of-coords action-key-depress-args)))
 379     (if w (select-window w))
 380     (cond ((hmouse-modeline-click)
 381            (cond ((hmouse-release-left-edge)  (bury-buffer))
 382                  ((hmouse-release-right-edge)
 383                   (if (eq major-mode 'Info-mode)
 384                       (Info-exit)
 385                     (info)))
 386                  (t (run-hooks 'action-key-modeline-hook))))
 387           (t (hmouse-modeline-resize-window)))))
 388
 389 (defun assist-key-modeline ()
 390   "Handles Assist Key depresses on a window mode line.
 391 If secondary key is:
 392  (1) clicked on left edge of a window's modeline,
 393      bottom buffer in buffer list is unburied and placed in window;
 394  (2) clicked on right edge of a window's modeline,
 395      the summary of Smart Key behavior is displayed, or if already
 396      displayed and the modeline clicked belongs to a window displaying
 397      the summary, the summary buffer is hidden;
 398  (3) clicked anywhere in the middle of a window's modeline,
 399      the functions listed in 'assist-key-modeline-hook' are called;
 400  (4) dragged vertically from modeline to within a window,
 401      the modeline is moved to point of key release, thereby resizing
 402      its window and potentially its vertical neighbors."
 403   (let ((buffers)
 404         (w (smart-window-of-coords assist-key-depress-args)))
 405     (if w (select-window w))
 406     (cond ((hmouse-modeline-click 'assist)
 407            (cond ((hmouse-release-left-edge 'assist)
 408                   (if (fboundp 'last)
 409                       (switch-to-buffer (car (last (buffer-list))))
 410                     (setq buffers (buffer-list))
 411                     (switch-to-buffer (nth (1- (length buffers)) buffers))))
 412                  ((hmouse-release-right-edge 'assist)
 413                   (if (equal (buffer-name) (hypb:help-buf-name "Smart"))
 414                       (hkey-help-hide)
 415                     (hkey-summarize 'current-window)))
 416                  (t (run-hooks 'assist-key-modeline-hook))))
 417           (t (hmouse-modeline-resize-window 'assist)))))
 418
 419 (defun hmouse-modeline-click (&optional assist-flag)
 420   "Returns non-nil if last Action Key depress and release was at same point in a modeline.
 421 Optional ASSIST-FLAG non-nil means test for Assist Key click instead."
 422   ;; Assume depress was in modeline and that any drag has already been handled.
 423   ;; So just check that release was in modeline.
 424   (hmouse-modeline-release assist-flag))
 425
 426 (defun hmouse-modeline-depress ()
 427   "Returns non-nil if Action Key was depressed on a window mode line.
 428 If free variable 'assist-flag' is non-nil, uses Assist Key."
 429   (let ((args (if assist-flag assist-key-depress-args
 430                 action-key-depress-args)))
 431     (if (and hyperb:window-system args)
 432         (if (fboundp 'event-over-modeline-p)
 433             (event-over-modeline-p args)
 434           (let* ((w (smart-window-of-coords args))
 435                  (mode-ln (if w (nth 3 (window-edges w))))
 436                  (last-press-y (hmouse-y-coord args)))
 437             ;; Mode-line is always 1 less than the bottom of the window, unless it
 438             ;; is a minibuffer window which does not have a modeline.
 439             (if (not (eq w (minibuffer-window))) (setq mode-ln (1- mode-ln)))
 440             (and last-press-y mode-ln (= last-press-y mode-ln)))))))
 441
 442 (defun hmouse-modeline-release (&optional assist-flag)
 443   "Returns non-nil if Action Key was released on a window mode line.
 444 Optional non-nil ASSIST-FLAG means test release of Assist Key instead."
 445   (let ((args (if assist-flag assist-key-release-args
 446                 action-key-release-args)))
 447     (if (and hyperb:window-system args)
 448         (if (fboundp 'event-over-modeline-p)
 449             (event-over-modeline-p args)
 450           (let* ((w (smart-window-of-coords args))
 451                  (mode-ln (and w (1- (nth 3 (window-edges w)))))
 452                  (last-press-y (hmouse-y-coord args)))
 453             (and last-press-y mode-ln (= last-press-y mode-ln)))))))
 454
 455 (defun hmouse-modeline-resize-window (&optional assist-flag)
 456   "Resizes window whose mode line was depressed upon by the Action Key.
 457 Resize amount depends upon the vertical difference between press and release
 458 of the Action Key.  Optional arg ASSIST-FLAG non-nil means use values from
 459 Assist Key instead."
 460   (cond ((not hyperb:window-system) nil)
 461         ((and hyperb:xemacs-p (not (fboundp 'window-edges)))
 462          (error "Drag from a mode-line with button1 to resize windows."))
 463         (t (let* ((owind (selected-window))
 464                   (window (smart-window-of-coords
 465                            (if assist-flag assist-key-depress-args
 466                              action-key-depress-args)))
 467                   (mode-ln (and window (1- (nth 3 (window-edges window)))))
 468                   (last-release-y
 469                    (hmouse-y-coord
 470                     (if assist-flag assist-key-release-args
 471                       action-key-release-args)))
 472                   (shrink-amount (- mode-ln last-release-y)))
 473              ;; Restore position of point prior to Action Key release.
 474              (if action-key-release-prev-point
 475                  (let ((obuf (current-buffer)))
 476                    (unwind-protect
 477                        (progn
 478                          (set-buffer
 479                           (marker-buffer action-key-release-prev-point))
 480                          (goto-char
 481                           (marker-position action-key-release-prev-point)))
 482                      (set-buffer obuf))))
 483              (cond
 484               ((>= (+ mode-ln 2) (frame-height))
 485                (error
 486                 "(hmouse-modeline-resize-window): Can't move bottom window in frame."))
 487               ((< (length (hypb:window-list 'no-minibuf)) 2)
 488                (error
 489                 "(hmouse-modeline-resize-window): Can't resize sole window in frame."))
 490               (t (unwind-protect
 491                      (progn
 492                        (select-window window)
 493                        (shrink-window shrink-amount)
 494                        ;; Keep redisplay from scrolling other window.
 495                        (select-window (next-window nil 'no-mini))
 496                        (condition-case ()
 497                            (scroll-down shrink-amount)
 498                          (error nil)))
 499                    (select-window owind))))))))
 500
 501 (defun hmouse-release-left-edge (&optional assist-flag)
 502   "Returns non-nil if last Action Key release was at left window edge.
 503 'hmouse-edge-sensitivity' value determines how near to actual edge the
 504 release must be."
 505   (let ((args (if assist-flag assist-key-release-args
 506                  action-key-release-args))
 507         window-left last-release-x)
 508     (if (fboundp 'window-lowest-p) ;; XEmacs >= 19.12
 509         (setq last-release-x (and args (eq (event-window args)
 510                                            (selected-window))
 511                                   (hmouse-x-coord args))
 512               window-left 0)
 513       (setq window-left (car (window-edges))
 514             last-release-x (and args (hmouse-x-coord args))))
 515
 516     (and last-release-x (< (- last-release-x window-left)
 517                            hmouse-edge-sensitivity))))
 518
 519 (defun hmouse-release-right-edge (&optional assist-flag)
 520   "Returns non-nil if last Action Key release was at right window edge.
 521 'hmouse-edge-sensitivity' value determines how near to actual edge the
 522 release must be."
 523   (let ((args (if assist-flag assist-key-release-args
 524                  action-key-release-args))
 525         window-right last-release-x)
 526     (if (fboundp 'window-lowest-p) ;; XEmacs >= 19.12
 527         (setq last-release-x (and args (eq (event-window args)
 528                                            (selected-window))
 529                                   (hmouse-x-coord args))
 530               window-right (window-width))
 531       (setq window-right (nth 2 (window-edges))
 532             last-release-x (and args (hmouse-x-coord args))))
 533     (and last-release-x (>= (+ last-release-x hmouse-edge-sensitivity)
 534                             window-right)
 535          (>= (- window-right last-release-x) 0))))
 536
 537 (defun hmouse-resize-window-side (&optional assist-flag)
 538   "Resizes window whose side was depressed upon by the Action Key.
 539 Resize amount depends upon the horizontal difference between press and release
 540 of the Action Key.  Optional arg ASSIST-FLAG non-nil means use values from
 541 Assist Key instead."
 542   (cond (hyperb:xemacs-p
 543          ;; Depress events in scrollbars or in non-text area of buffer are
 544          ;; not visible or identifiable at the Lisp-level, so always return
 545          ;; nil.
 546          nil)
 547         (hyperb:window-system
 548          (let* ((owind (selected-window))
 549                 (window (smart-window-of-coords
 550                          (if assist-flag assist-key-depress-args
 551                            action-key-depress-args)))
 552                 (side-ln (and window (1- (nth 2 (window-edges window)))))
 553                 (last-release-x
 554                  (hmouse-x-coord
 555                   (if assist-flag assist-key-release-args
 556                     action-key-release-args)))
 557                 (shrink-amount (- side-ln last-release-x))
 558                 )
 559            ;; Restore position of point prior to Action Key release.
 560            (if action-key-release-prev-point
 561                (let ((obuf (current-buffer)))
 562                  (unwind-protect
 563                      (progn
 564                        (set-buffer (marker-buffer action-key-release-prev-point))
 565                        (goto-char (marker-position action-key-release-prev-point)))
 566                    (set-buffer obuf))))
 567            (cond
 568             ((>= (+ side-ln 2) (frame-width))
 569              (error
 570               "(hmouse-resize-window-side): Can't change width of full frame width window."))
 571             ((< (length (hypb:window-list 'no-minibuf)) 2)
 572              (error
 573               "(hmouse-resize-window-side): Can't resize sole window in frame."))
 574             (t (unwind-protect
 575                    (progn
 576                      (select-window window)
 577                      (shrink-window-horizontally shrink-amount))
 578                  (select-window owind))))))))
 579
 580 (defun hmouse-swap-buffers (&optional assist-flag)
 581   "Swaps buffers in windows selected with last Action Key depress and release.
 582 If optional arg ASSIST-FLAG is non-nil, uses Assist Key."
 583   (let* ((w1 (if assist-flag assist-key-depress-window
 584                action-key-depress-window))
 585          (w2 (if assist-flag assist-key-release-window
 586                action-key-release-window))
 587          (w1-buf (and w1 (window-buffer w1)))
 588          (w2-buf (and w2 (window-buffer w2)))
 589          )
 590     (or (and w1 w2)
 591         (error "(hmouse-swap-buffers): Last depress or release not within a window."))
 592     ;; Swap window buffers.
 593     (set-window-buffer w1 w2-buf)
 594     (set-window-buffer w2 w1-buf)))
 595
 596 (defun hmouse-swap-windows (&optional assist-flag)
 597   "Swaps windows selected with last Action Key depress and release.
 598 If optional arg ASSIST-FLAG is non-nil, uses Assist Key."
 599   (let* ((w1 (if assist-flag assist-key-depress-window
 600                action-key-depress-window))
 601          (w2 (if assist-flag assist-key-release-window
 602                action-key-release-window))
 603          (w1-width  (and w1 (window-width w1)))
 604          (w1-height (and w1 (window-height w1)))
 605          (w2-width  (and w2 (window-width w2)))
 606          (w2-height (and w2 (window-height w2)))
 607          )
 608     (or (and w1 w2)
 609         (error "(hmouse-swap-windows): Last depress or release not within a window."))
 610     (unwind-protect
 611         (progn
 612           (select-window w1)
 613           (if (not (= w1-height (frame-height)))
 614               (shrink-window (- w1-height w2-height)))
 615           (if (not (= w1-width (frame-width)))
 616               (shrink-window-horizontally (- w1-width w2-width)))
 617           (select-window w2)
 618           (setq w2-width (window-width w2)
 619                 w2-height (window-height w2))
 620           (if (not (= w2-height (frame-height)))
 621               (shrink-window (- w2-height w1-height)))
 622           (if (not (= w2-width (frame-width)))
 623               (shrink-window-horizontally (- w2-width w1-width)))
 624           )
 625       (select-window w2)
 626       )))
 627
 628 (defun hmouse-x-coord (args)
 629   "Returns x coordinate in chars from window system dependent ARGS."
 630   (let ((x (eval (cdr (assoc hyperb:window-system
 631                              '(("emacs19" . (if (eventp args)
 632                                                 (+ (car (posn-col-row
 633                                                          (event-start args)))
 634                                                    (nth 0 (window-edges
 635                                                            (car
 636                                                             (car (cdr args))
 637                                                             ))))
 638                                               (car args)))
 639                                ("xemacs" .  (if (eventp args)
 640                                                 (event-x args)
 641                                               (car args)))
 642                                ("xterm"  .  (car args))
 643                                ("epoch"  .  (nth 0 args))   ;; Epoch V4
 644                                ("sun"    .  (nth 1 args))
 645                                ("next"   .  (nth 1 args))
 646                                ("apollo" .  (car args))
 647                                ))))))
 648     (if (integerp x) x (error "(hmouse-x-coord): invalid X coord: %s" x))))
 649
 650 (defun hmouse-y-coord (args)
 651   "Returns y coordinate in frame lines from window system dependent ARGS."
 652   (let ((y (eval (cdr (assoc hyperb:window-system
 653                              '(("emacs19" . (if (eventp args)
 654                                                 (+ (cdr (posn-col-row
 655                                                          (event-start args)))
 656                                                    (nth 1 (window-edges
 657                                                            (car
 658                                                             (car (cdr args))
 659                                                             ))))
 660                                               (cdr args)))
 661                                ("xemacs" .  (if (eventp args)
 662                                                 (event-y args)
 663                                               (cdr args)))
 664                                ("xterm"  .  (nth 1 args))
 665                                ("epoch"  .  (nth 1 args))   ;; Epoch V4
 666                                ("sun"    .  (nth 2 args))
 667                                ("next"   .  (nth 2 args))
 668                                ("apollo" .  (nth 1 args))
 669                                ))))))
 670     (if (integerp y) y (error "(hmouse-y-coord): invalid Y coord: %s" y))))
 671
 672
 673 ;;;
 674 ;;; Private variables
 675 ;;;
 676
 677
 678 (provide 'hui-window)
 679
 680 ;;; hui-window.el ends here