X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/bfab7c6ec74dc55d640ef36f8cb1790a1420f991..10339fa90363cf20a9e379c083df83405718302d:/lisp/dframe.el diff --git a/lisp/dframe.el b/lisp/dframe.el index 0d320c214e..312f49f605 100644 --- a/lisp/dframe.el +++ b/lisp/dframe.el @@ -1,7 +1,6 @@ ;;; dframe --- dedicate frame support modes -;;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1996-2011 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; Keywords: file, tags, tools @@ -11,10 +10,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -22,9 +21,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -175,7 +172,7 @@ Valid clicks are mouse 2, our double mouse 1.") (make-variable-buffer-local 'dframe-mouse-click-function) (defvar dframe-mouse-position-function nil - "*A function to called to position the cursor for a mouse click.") + "*A function to call to position the cursor for a mouse click.") (make-variable-buffer-local 'dframe-mouse-position-function) (defvar dframe-power-click nil @@ -419,22 +416,25 @@ LOCATION can be one of 'random, 'left, 'right, 'left-right, or 'top-bottom." (dframe-reposition-frame-xemacs new-frame parent-frame location) (dframe-reposition-frame-emacs new-frame parent-frame location))) +;; Not defined in builds without X, but behind window-system test. +(declare-function x-display-pixel-width "xfns.c" (&optional terminal)) +(declare-function x-display-pixel-height "xfns.c" (&optional terminal)) + (defun dframe-reposition-frame-emacs (new-frame parent-frame location) "Move NEW-FRAME to be relative to PARENT-FRAME. LOCATION can be one of 'random, 'left-right, 'top-bottom, or -a cons cell indicationg a position of the form (LEFT . TOP)." - (let* ((pfx (dframe-frame-parameter parent-frame 'left)) - (pfy (dframe-frame-parameter parent-frame 'top)) - (pfw (frame-pixel-width parent-frame)) - (pfh (frame-pixel-height parent-frame)) - (nfw (frame-pixel-width new-frame)) - (nfh (frame-pixel-height new-frame)) - newleft newtop - ) - ;; Position dframe. - (if (or (not window-system) (eq window-system 'pc)) - ;; Do no positioning if not on a windowing system, - nil +a cons cell indicating a position of the form (LEFT . TOP)." + ;; Position dframe. + ;; Do no positioning if not on a windowing system, + (unless (or (not window-system) (eq window-system 'pc)) + (let* ((pfx (dframe-frame-parameter parent-frame 'left)) + (pfy (dframe-frame-parameter parent-frame 'top)) + (pfw (+ (tool-bar-pixel-width parent-frame) + (frame-pixel-width parent-frame))) + (pfh (frame-pixel-height parent-frame)) + (nfw (frame-pixel-width new-frame)) + (nfh (frame-pixel-height new-frame)) + newleft newtop) ;; Rebuild pfx,pfy to be absolute positions. (setq pfx (if (not (consp pfx)) pfx @@ -457,10 +457,9 @@ a cons cell indicationg a position of the form (LEFT . TOP)." ;; A - means distance from the right edge ;; of the display, or DW - pfx - framewidth (- (x-display-pixel-height) (car (cdr pfy)) pfh) - (car (cdr pfy)))) - ) + (car (cdr pfy))))) (cond ((eq location 'right) - (setq newleft (+ pfx pfw 5) + (setq newleft (+ pfx pfw 10) newtop pfy)) ((eq location 'left) (setq newleft (- pfx 10 nfw) @@ -472,7 +471,7 @@ a cons cell indicationg a position of the form (LEFT . TOP)." ;; extra 10 is just dressings for window ;; decorations. (let* ((left-guess (- pfx 10 nfw)) - (right-guess (+ pfx pfw 5)) + (right-guess (+ pfx pfw 10)) (left-margin left-guess) (right-margin (- (x-display-pixel-width) right-guess 5 nfw))) @@ -481,8 +480,7 @@ a cons cell indicationg a position of the form (LEFT . TOP)." ;; otherwise choose side we overlap less ((> left-margin right-margin) 0) (t (- (x-display-pixel-width) nfw 5)))) - newtop pfy - )) + newtop pfy)) ((eq location 'top-bottom) (setq newleft pfx newtop @@ -496,15 +494,14 @@ a cons cell indicationg a position of the form (LEFT . TOP)." ((>= bottom-margin 0) bottom-guess) ;; Choose a side to overlap the least. ((> top-margin bottom-margin) 0) - (t (- (x-display-pixel-height) nfh 5))))) - ) + (t (- (x-display-pixel-height) nfh 5)))))) ((consp location) (setq newleft (or (car location) 0) newtop (or (cdr location) 0))) (t nil)) (modify-frame-parameters new-frame - (list (cons 'left newleft) - (cons 'top newtop)))))) + (list (cons 'left newleft) + (cons 'top newtop)))))) (defun dframe-reposition-frame-xemacs (new-frame parent-frame location) "Move NEW-FRAME to be relative to PARENT-FRAME. @@ -769,7 +766,7 @@ Evaluates all cached timer functions in sequence." (fboundp 'function-max-args) (setq max-args (function-max-args 'popup-mode-menu)) (not (zerop max-args)))) - "The EVENT arg to 'popup-mode-menu' was introduced in XEmacs 21.4.0.") + "The EVENT arg to `popup-mode-menu' was introduced in XEmacs 21.4.0.") ;; In XEmacs, we make popup menus work on the item over mouse (as ;; opposed to where the point happens to be.) We attain this by @@ -786,8 +783,8 @@ Must be bound to EVENT." (popup-mode-menu event) (goto-char (event-closest-point event)) (beginning-of-line) - (forward-char (min 5 (- (save-excursion (end-of-line) (point)) - (save-excursion (beginning-of-line) (point))))) + (forward-char (min 5 (- (line-end-position) + (line-beginning-position)))) (popup-mode-menu)) ;; Wait for menu to bail out. `popup-mode-menu' (and other popup ;; menu functions) return immediately. @@ -855,7 +852,7 @@ BUFFER and POSITION are optional because XEmacs doesn't use them." (funcall dframe-help-echo-function)))))) (defun dframe-mouse-set-point (e) - "Set POINT based on event E. + "Set point based on event E. Handles clicking on images in XEmacs." (if (and (featurep 'xemacs) (save-excursion @@ -993,5 +990,4 @@ mode-line. This is only useful for non-XEmacs." (provide 'dframe) -;; arch-tag: df9b91b6-e85e-4a76-a02e-b3cb5b686bd4 ;;; dframe.el ends here