xemacs-beta: lisp/prim/frame.el comparison

comparison lisp/prim/frame.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30

author	cvs
date	Mon, 13 Aug 2007 09:02:59 +0200
parents	56c54cf7c5b6
children	c0c698873ce1

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;; General Public License for more details.
 ;; You should have received a copy of the GNU General Public License
 ;; along with XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Free Software Foundation, 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 ;;; Synched up with: FSF 19.30.
 ;;; Code:
 	system.  Not currently implemented.
 win32	A connection to a machine running Microsoft Windows NT or
 	Windows 95.  Not currently implemented.
 pc	A direct-write MS-DOS frame.  Not currently implemented.
-PROPS should be an plist of properties, as in the call to `make-frame'.
+PROPS should be a plist of properties, as in the call to `make-frame'.
 If a connection to CONNECTION already exists, it is reused; otherwise,
 a new connection is opened."
 (make-frame props (make-device type connection props)))
 (defun frame-type (&optional frame)
 "Return the type of the specified frame (e.g. `x' or `tty').
 This is equivalent to the type of the frame's device.
 Value is `tty' for a tty frame (a character-only terminal),
 `x' for a frame that is an X window,
-`ns' for a frame that is a NeXTstep window (not yet implemented),
+`ns' for a frame that is a NeXTstep window (not yet implemeted),
 `win32' for a frame that is a Windows or Windows NT window (not yet
 implemented),
 `pc' for a frame that is a direct-write MS-DOS frame (not yet implemented),
 `stream' for a stream frame (which acts like a stdio stream), and
 `dead' for a deleted frame."
 	    (list frame-icon-title-format map-frame-hook frames)
 	  frame-icon-title-format icon-name
 	  map-frame-hook 'deiconify-emacs)
 (iconify-frame me)))
 (defun deiconify-emacs (&optional ignore)
 (or iconification-data (error "not iconified?"))
 (setq frame-icon-title-format (car iconification-data)
 	map-frame-hook (car (cdr iconification-data))
 	iconification-data (car (cdr (cdr iconification-data))))
 (while iconification-data
 (let ((visibility (cdr (car iconification-data))))
-(cond (visibility  ;; JV  (Note non-nil means visible in XEmacs)
+(cond ((eq visibility 't)
 	     (make-frame-visible (car (car iconification-data))))
-;	    (t ;; (eq visibility 'icon) ;; JV Not in XEmacs!!!
+;	    (t ;; (eq visibility 'icon)
 ;	     (make-frame-visible (car (car iconification-data)))
 ;	     (sleep-for 500 t) ; process X events; I really want to XSync() here
 ;	     (iconify-frame (car (car iconification-data))))
 	    ;; (t nil)
 	    ))
 (setq iconification-data (cdr iconification-data))))
 (defun suspend-or-iconify-emacs ()
 "Calls iconify-emacs if frame is an X frame, otherwise calls suspend-emacs"
 (interactive)
-(cond
+(if (eq (frame-type (selected-frame)) 'x)
-((eq (frame-type (selected-frame)) 'x) (iconify-emacs))
+(iconify-emacs)
-((and (eq (frame-type (selected-frame)) 'tty)
+(suspend-emacs)))
-	 (console-tty-controlling-process (selected-console)))
-(suspend-console (selected-console)))
-(t
-(suspend-emacs))))
 ;;; auto-raise and auto-lower
 (defvar auto-raise-frame nil
 (and (boundp 'drag-and-drop-functions)
 (or drag-and-drop-functions
 	 (add-hook 'drag-and-drop-functions 'default-drag-and-drop-functions)))
+(defun cde-start-drag (begin end)
+"Implements the CDE drag operation.
+Calls the internal function cde-start-drag-internal to do the actual work."
+(interactive "_r")
+(if (featurep 'cde)
+(cde-start-drag-internal (buffer-substring-no-properties begin end))
+(error "CDE functionality not compiled in.")))
 ;;; Application-specific frame-management
 (defvar get-frame-for-buffer-default-frame-name nil
 "The default frame to select; see doc of `get-frame-for-buffer'.")
 		   (save-excursion (set-buffer buffer)
 				   major-mode))))
 (or (get mode 'frame-name)
 	get-frame-for-buffer-default-frame-name)))
-(defun get-frame-for-buffer-make-new-frame (buffer &optional frame-name plist)
-(let* ((fr (make-frame plist))
+(defun get-frame-for-buffer-make-new-frame (buffer &optional frame-name)
+(let* ((fr (make-frame (and frame-name (list (cons 'name frame-name)))))
 	 (w (frame-root-window fr)))
 ;;
 ;; Make the one buffer being displayed in this newly created
 ;; frame be the buffer of interest, instead of something
 ;; random, so that it won't be shown in two-window mode.
 ;;
 ;; This buffer's mode expressed a preference for a frame of a particular
 ;; name.  That always takes priority.
 ;;
 (let ((limit (get name 'instance-limit))
-	    (defaults (get name 'frame-defaults))
 	    (matching-frames '())
 	    frames frame already-visible)
 	;; Sort the list so that iconic frames will be found last.  They
 	;; will be used too, but mapped frames take precedence.  And
 	;; fully visible frames come before occluded frames.
-;; Hidden frames come after really visible ones
 	(setq frames
 	      (sort (frame-list)
 		    #'(lambda (s1 s2)
 			(cond ((frame-totally-visible-p s2)
 			       nil)
 			      ((not (frame-visible-p s2))
 			       (frame-visible-p s1))
-			      ((eq (frame-visible-p s2) 'hidden)
-			       (eq (frame-visible-p s1) t ))
 			      ((not (frame-totally-visible-p s2))
 			       (and (frame-visible-p s1)
 				    (frame-totally-visible-p s1)))))))
 	;; but the selected frame should come first, even if it's occluded,
 	;; to minimize thrashing.
 	(cond (already-visible
 	       already-visible)
 	      ((or (null matching-frames)
 		   (eq limit 0) ; means create with reckless abandon
 		   (and limit (< (length matching-frames) limit)))
-	       (get-frame-for-buffer-make-new-frame
+	       (get-frame-for-buffer-make-new-frame buffer name))
-		buffer
-		name
-		(alist-to-plist (acons 'name name
-				       (plist-to-alist defaults)))))
 	      (t
 	       ;; do not switch any of the window/buffer associations in an
 	       ;; existing frame; this function only picks a frame; the
 	       ;; determination of which windows on it get reused is up to
 	       ;; display-buffer itself.
 					     (or (frame-visible-p x)
 						 (frame-iconified-p x))))
 		    #'(lambda (s1 s2)
 			(cond ((and (frame-visible-p s1)
 				    (not (frame-visible-p s2))))
-			      ((and (eq (frame-visible-p s1) t)
-				    (eq (frame-visible-p s2) 'hidden)))
 			      ((and (frame-visible-p s2)
 				    (not (frame-visible-p s1)))
 			       nil)
 			      ((and (equal (frame-name s1) defname)
 				    (not (equal (frame-name s2) defname))))
 	  nil
 	(if (eq cur-frame next-frame)
 	    (setq save-frame next-frame)
 	  (and
 	   (or (not visible-only)
-	       (frame-visible-p next-frame))
+	       (eq t (frame-visible-p next-frame)))
 	   (setq frames (append frames (list next-frame))))))
 	(setq list (cdr list)))
 (if save-frame
 	(append (list save-frame) frames)
 frames)))
-(defvar temp-buffer-shrink-to-fit t
-"*When non-nil resize temporary output buffers to minimize blank lines.")
-(defvar temp-buffer-max-height .5
-"*Proportion of frame to use for temp windows.")
 (defun show-temp-buffer-in-current-frame (buffer)
 "For use as the value of temp-buffer-show-function:
 always displays the buffer in the current frame, regardless of the behavior
 that would otherwise be introduced by the `pre-display-buffer-function', which
 	  ;; only the pre-display-buffer-function should ever do this.
 	  (error "display-buffer switched frames on its own!!"))
 (setq minibuffer-scroll-window window)
 (set-window-start window 1) ; obeys narrowing
 (set-window-point window 1)
-(when temp-buffer-shrink-to-fit
-(let* ((temp-window-size (round (* temp-buffer-max-height
-(frame-height (window-frame window)))))
-(size (window-displayed-height window)))
-(when (< size temp-window-size)
-(enlarge-window (- temp-window-size size) nil window)))
-(shrink-window-if-larger-than-buffer window))
 nil)))
 (setq pre-display-buffer-function 'get-frame-for-buffer)
 (setq temp-buffer-show-function 'show-temp-buffer-in-current-frame)
 "Set property PROP of FRAME to VAL.  See `set-frame-properties'."
 (set-frame-properties frame (list prop val)))
 (defun frame-height (&optional frame)
 "Return number of lines available for display on FRAME."
-(or frame (setq frame (selected-frame)))
 (frame-property frame 'height))
 (defun frame-width (&optional frame)
 "Return number of columns available for display on FRAME."
-(or frame (setq frame (selected-frame)))
 (frame-property frame 'width))
 (put 'cursor-color 'frame-property-alias [text-cursor background])
 (put 'modeline 'frame-property-alias 'has-modeline-p)

Mercurial > hg > xemacs-beta

comparison lisp/prim/frame.el @ 70:131b0175ea99 r20-0b30