Mercurial > hg > xemacs-beta

comparison lisp/window.el @ 800:a5954632b187

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-31 08:27:14 by ben] more fixes, first crack at finishing behavior implementation TODO.ben-mule-21-5: Update. configure.in: Fix for new error-checking types. make-mswin-unicode.pl: Don't be fucked up by CRLF. Output code to force errors when nonintercepted Windows calls issued. behavior.el, dumped-lisp.el, menubar-items.el: Add support for saving using custom. Load into a dumped XEmacs. Correct :title to :short-doc in accordance with behavior-defs.el. Add a submenu under Options for turning on/off behaviors. cl-macs.el: Properly document `loop'. Fix a minor bug in keymap iteration and add support for bit-vector iteration. lisp-mode.el: Rearrange and add items for macro expanding. menubar-items.el: Document connection between these two functions. window.el: Port stuff from GNU 21.1. config.inc.samp, xemacs.mak: Separate out and add new variable for controlling error-checking. s/windowsnt.h: Use new ERROR_CHECK_ALL; not related to DEBUG_XEMACS. alloc.c, backtrace.h, buffer.c, buffer.h, bytecode.c, callproc.c, casetab.c, charset.h, chartab.c, cmdloop.c, config.h.in, console-msw.c, console-stream.c, console-tty.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dired-msw.c, dired.c, dumper.c, editfns.c, eldap.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, extents.c, faces.c, file-coding.c, file-coding.h, fileio.c, frame-msw.c, frame.c, frame.h, glyphs-gtk.c, glyphs-msw.c, glyphs-shared.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, insdel.c, intl-auto-encap-win32.c, intl-auto-encap-win32.h, intl-encap-win32.c, intl-win32.c, keymap.c, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, macros.c, marker.c, md5.c, menubar-x.c, menubar.c, mule-coding.c, ntproc.c, objects-gtk.c, objects-msw.c, objects-x.c, objects.c, opaque.c, print.c, process-nt.c, process-unix.c, process.c, rangetab.c, redisplay-msw.c, redisplay-output.c, redisplay.c, regex.c, scrollbar-msw.c, select-msw.c, signal.c, specifier.c, specifier.h, symbols.c, sysdep.c, syswindows.h, text.c, text.h, toolbar-msw.c, tooltalk.c, ui-gtk.c, unicode.c, window.c: Redo error-checking macros: ERROR_CHECK_TYPECHECK -> ERROR_CHECK_TYPES, ERROR_CHECK_CHARBPOS -> ERROR_CHECK_TEXT, add ERROR_CHECK_DISPLAY, ERROR_CHECK_STRUCTURES. Document these in config.h.in. Fix code to follow docs. Fix *_checking_assert() in accordance with new names. Attempt to fix periodic redisplay crash freeing display line structures. Add first implementation of sledgehammer redisplay check. Redo print_*() to use write_fmt_string(), write_fmt_string_lisp(). Fix bug in md5 handling. Rename character-to-unicode to char-to-unicode; same for unicode-to-char{acter}. Move chartab documentation to `make-char-table'. Some header cleanup. Clean up remaining places where nonintercepted Windows calls are being used. automated/mule-tests.el: Fix for new Unicode support.
author ben
date Sun, 31 Mar 2002 08:30:17 +0000
parents 3e321319c5ba
children 68f6865bee47
comparison
equal deleted inserted replaced
799:03d9f9084848 800:a5954632b187
123 ; (not (memq walk-windows-current walk-windows-history))) 123 ; (not (memq walk-windows-current walk-windows-history)))
124 ; (setq walk-windows-history (cons walk-windows-current 124 ; (setq walk-windows-history (cons walk-windows-current
125 ; walk-windows-history)) 125 ; walk-windows-history))
126 ; (funcall function walk-windows-current)))) 126 ; (funcall function walk-windows-current))))
127 127
128 (defun get-window-with-predicate (predicate &optional minibuf
129 all-frames default)
130 "Return a window satisfying PREDICATE.
131
132 This function cycles through all visible windows using `walk-windows',
133 calling PREDICATE on each one. PREDICATE is called with a window as
134 argument. The first window for which PREDICATE returns a non-nil
135 value is returned. If no window satisfies PREDICATE, DEFAULT is
136 returned.
137
138 Optional second arg MINIBUF t means count the minibuffer window even
139 if not active. MINIBUF nil or omitted means count the minibuffer iff
140 it is active. MINIBUF neither t nor nil means not to count the
141 minibuffer even if it is active.
142
143 Several frames may share a single minibuffer; if the minibuffer
144 counts, all windows on all frames that share that minibuffer count
145 too. Therefore, if you are using a separate minibuffer frame
146 and the minibuffer is active and MINIBUF says it counts,
147 `walk-windows' includes the windows in the frame from which you
148 entered the minibuffer, as well as the minibuffer window.
149
150 ALL-FRAMES is the optional third argument.
151 ALL-FRAMES nil or omitted means cycle within the frames as specified above.
152 ALL-FRAMES = `visible' means include windows on all visible frames.
153 ALL-FRAMES = 0 means include windows on all visible and iconified frames.
154 ALL-FRAMES = t means include windows on all frames including invisible frames.
155 If ALL-FRAMES is a frame, it means include windows on that frame.
156 Anything else means restrict to the selected frame."
157 (catch 'found
158 (walk-windows #'(lambda (window)
159 (when (funcall predicate window)
160 (throw 'found window)))
161 minibuf all-frames)
162 default))
163
164 (defalias 'some-window 'get-window-with-predicate)
165
128 (defun minibuffer-window-active-p (window) 166 (defun minibuffer-window-active-p (window)
129 "Return t if WINDOW (a minibuffer window) is now active." 167 "Return t if WINDOW (a minibuffer window) is now active."
130 (eq window (active-minibuffer-window))) 168 (eq window (active-minibuffer-window)))
131 169
132 (defmacro save-selected-window (&rest body) 170 (defmacro save-selected-window (&rest body)
147 ,@body)) 185 ,@body))
148 186
149 187
150 (defun count-windows (&optional minibuf) 188 (defun count-windows (&optional minibuf)
151 "Return the number of visible windows. 189 "Return the number of visible windows.
152 Optional arg MINIBUF non-nil means count the minibuffer 190 This counts the windows in the selected frame and (if the minibuffer is
191 to be counted) its minibuffer frame (if that's not the same frame).
192 The optional arg MINIBUF non-nil means count the minibuffer
153 even if it is inactive." 193 even if it is inactive."
154 (let ((count 0)) 194 (let ((count 0))
155 (walk-windows (function (lambda (w) 195 (walk-windows (function (lambda (w)
156 (setq count (+ count 1)))) 196 (setq count (+ count 1))))
157 minibuf) 197 minibuf)
158 count)) 198 count))
199
200 (defun window-safely-shrinkable-p (&optional window)
201 "Non-nil if the WINDOW can be shrunk without shrinking other windows.
202 If WINDOW is nil or omitted, it defaults to the currently selected window."
203 (save-selected-window
204 (when window (select-window window))
205 (or (and (not (eq window (frame-first-window)))
206 (= (car (window-pixel-edges))
207 (car (window-pixel-edges (previous-window)))))
208 (= (car (window-pixel-edges))
209 (car (window-pixel-edges (next-window)))))))
159 210
160 (defun balance-windows () 211 (defun balance-windows ()
161 "Make all visible windows the same height (approximately)." 212 "Make all visible windows the same height (approximately)."
162 (interactive) 213 (interactive)
163 (let ((count -1) levels newsizes size) 214 (let ((count -1) levels newsizes size)
284 (defun shrink-window-horizontally (arg) 335 (defun shrink-window-horizontally (arg)
285 "Make current window ARG columns narrower." 336 "Make current window ARG columns narrower."
286 (interactive "p") 337 (interactive "p")
287 (shrink-window arg t)) 338 (shrink-window arg t))
288 339
340 ; (defun window-buffer-height (window)
341 ; "Return the height (in screen lines) of the buffer that WINDOW is displaying."
342 ; (save-excursion
343 ; (set-buffer (window-buffer window))
344 ; (goto-char (point-min))
345 ; (let ((ignore-final-newline
346 ; ;; If buffer ends with a newline, ignore it when counting height
347 ; ;; unless point is after it.
348 ; (and (not (eobp)) (eq ?\n (char-after (1- (point-max)))))))
349 ; (+ 1 (nth 2 (compute-motion (point-min)
350 ; '(0 . 0)
351 ; (- (point-max) (if ignore-final-newline 1 0))
352 ; (cons 0 100000000)
353 ; (window-width window)
354 ; nil
355 ; window))))))
356
357 (defun count-screen-lines (&optional beg end count-final-newline window)
358 "Return the number of screen lines in the region.
359 The number of screen lines may be different from the number of actual lines,
360 due to line breaking, display table, etc.
361
362 Optional arguments BEG and END default to `point-min' and `point-max'
363 respectively.
364
365 If region ends with a newline, ignore it unless optional third argument
366 COUNT-FINAL-NEWLINE is non-nil.
367
368 The optional fourth argument WINDOW specifies the window used for obtaining
369 parameters such as width, horizontal scrolling, and so on. The default is
370 to use the selected window's parameters.
371
372 Like `vertical-motion', `count-screen-lines' always uses the current buffer,
373 regardless of which buffer is displayed in WINDOW. This makes possible to use
374 `count-screen-lines' in any buffer, whether or not it is currently displayed
375 in some window."
376 (unless beg
377 (setq beg (point-min)))
378 (unless end
379 (setq end (point-max)))
380 (if (= beg end)
381 0
382 (save-excursion
383 (save-restriction
384 (widen)
385 (narrow-to-region (min beg end)
386 (if (and (not count-final-newline)
387 (= ?\n (char-before (max beg end))))
388 (1- (max beg end))
389 (max beg end)))
390 (goto-char (point-min))
391 (1+ (vertical-motion (buffer-size) window))))))
392
393 ; (defun fit-window-to-buffer (&optional window max-height min-height)
394 ; "Make WINDOW the right size to display its contents exactly.
395 ; If WINDOW is omitted or nil, it defaults to the selected window.
396 ; If the optional argument MAX-HEIGHT is supplied, it is the maximum height
397 ; the window is allowed to be, defaulting to the frame height.
398 ; If the optional argument MIN-HEIGHT is supplied, it is the minimum
399 ; height the window is allowed to be, defaulting to `window-min-height'.
400
401 ; The heights in MAX-HEIGHT and MIN-HEIGHT include the mode-line and/or
402 ; header-line."
403 ; (interactive)
404
405 ; (when (null window)
406 ; (setq window (selected-window)))
407 ; (when (null max-height)
408 ; (setq max-height (frame-height (window-frame window))))
409
410 ; (let* ((buf
411 ; ;; Buffer that is displayed in WINDOW
412 ; (window-buffer window))
413 ; (window-height
414 ; ;; The current height of WINDOW
415 ; (window-height window))
416 ; (desired-height
417 ; ;; The height necessary to show the buffer displayed by WINDOW
418 ; ;; (`count-screen-lines' always works on the current buffer).
419 ; (with-current-buffer buf
420 ; (+ (count-screen-lines)
421 ; ;; If the buffer is empty, (count-screen-lines) is
422 ; ;; zero. But, even in that case, we need one text line
423 ; ;; for cursor.
424 ; (if (= (point-min) (point-max))
425 ; 1 0)
426 ; ;; For non-minibuffers, count the mode-line, if any
427 ; (if (and (not (window-minibuffer-p window))
428 ; mode-line-format)
429 ; 1 0)
430 ; ;; Count the header-line, if any
431 ; (if header-line-format 1 0))))
432 ; (delta
433 ; ;; Calculate how much the window height has to change to show
434 ; ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT.
435 ; (- (max (min desired-height max-height)
436 ; (or min-height window-min-height))
437 ; window-height))
438 ; ;; We do our own height checking, so avoid any restrictions due to
439 ; ;; window-min-height.
440 ; (window-min-height 1))
441
442 ; ;; Don't try to redisplay with the cursor at the end
443 ; ;; on its own line--that would force a scroll and spoil things.
444 ; (when (with-current-buffer buf
445 ; (and (eobp) (bolp) (not (bobp))))
446 ; (set-window-point window (1- (window-point window))))
447
448 ; (save-selected-window
449 ; (select-window window)
450
451 ; ;; Adjust WINDOW to the nominally correct size (which may actually
452 ; ;; be slightly off because of variable height text, etc).
453 ; (unless (zerop delta)
454 ; (enlarge-window delta))
455
456 ; ;; Check if the last line is surely fully visible. If not,
457 ; ;; enlarge the window.
458 ; (let ((end (with-current-buffer buf
459 ; (save-excursion
460 ; (goto-char (point-max))
461 ; (when (and (bolp) (not (bobp)))
462 ; ;; Don't include final newline
463 ; (backward-char 1))
464 ; (when truncate-lines
465 ; ;; If line-wrapping is turned off, test the
466 ; ;; beginning of the last line for visibility
467 ; ;; instead of the end, as the end of the line
468 ; ;; could be invisible by virtue of extending past
469 ; ;; the edge of the window.
470 ; (forward-line 0))
471 ; (point)))))
472 ; (set-window-vscroll window 0)
473 ; (while (and (< desired-height max-height)
474 ; (= desired-height (window-height window))
475 ; (not (pos-visible-in-window-p end window)))
476 ; (enlarge-window 1)
477 ; (setq desired-height (1+ desired-height)))))))
478
289 (defun shrink-window-if-larger-than-buffer (&optional window) 479 (defun shrink-window-if-larger-than-buffer (&optional window)
290 "Shrink the WINDOW to be as small as possible to display its contents. 480 "Shrink the WINDOW to be as small as possible to display its contents.
291 Do not shrink to less than `window-min-height' lines. 481 Do not shrink to less than `window-min-height' lines.
292 Do nothing if the buffer contains more lines than the present window height, 482 Do nothing if the buffer contains more lines than the present window height,
293 or if some of the window's contents are scrolled out of view, 483 or if some of the window's contents are scrolled out of view,