code.delx.au - gnu-emacs-elpa/blob - packages/realgud/realgud/common/window.el

   1 ;;; Copyright (C) 2010, 2014-2015 Rocky Bernstein <rocky@gnu.org>
   2 (require 'load-relative)
   3 (require-relative-list '("helper") "realgud-")
   4 (require-relative-list '("buffer/helper") "realgud-buffer-")
   5
   6 (declare-function realgud:backtrace-init    'realgud-buffer-helper)
   7 (declare-function realgud-get-backtrace-buf 'realgud-buffer-helper)
   8 (declare-function realgud-get-cmdbuf        'realgud-buffer-helper)
   9 (declare-function realgud-get-srcbuf        'realgud-buffer-helper)
  10 (declare-function buffer-killed?            'realgud-helper)
  11
  12 (declare-function one-window-p(bool))
  13
  14 (defun realgud-window-update-position (buffer marker)
  15   "Update BUFFER to position specified with MARKER.
  16 We assume MARKER points inside BUFFER"
  17   (with-current-buffer buffer
  18     (goto-char marker)
  19     (let ((window (get-buffer-window buffer)))
  20       (if window (set-window-point window marker))
  21       )))
  22
  23
  24 (defun realgud-window-src ( &optional opt-buffer )
  25   "Make sure the source buffer is displayed in a window
  26 We don't care if the command buffer is also displayed.
  27 See also `realgud-window-src-undisturb-cmd'"
  28   (let* ((buffer (or opt-buffer (current-buffer)))
  29          (src-buffer (realgud-get-srcbuf buffer))
  30          (src-window (get-buffer-window src-buffer 'visible))
  31          (window (selected-window)))
  32     (if src-buffer
  33         (unless (and src-window (not (window-minibuffer-p)))
  34           (set-window-buffer window src-buffer))
  35         )
  36     ))
  37
  38 (defun realgud-window-src-undisturb-cmd ( &optional opt-buffer )
  39   "Make sure the source buffers is displayed in windows without
  40 disturbing the command window if it is also displayed. Returns
  41 the command window
  42 See also `realgud-window-src'"
  43   (interactive)
  44   (let* ((buffer (or opt-buffer (current-buffer)))
  45          (src-buffer (realgud-get-srcbuf buffer))
  46          (src-window (get-buffer-window src-buffer))
  47          (cmd-buffer (realgud-get-cmdbuf buffer))
  48          (cmd-window (get-buffer-window cmd-buffer))
  49          (window (selected-window))
  50          )
  51     (if src-buffer
  52         (unless src-window
  53           (setq src-window
  54                 (if (eq window cmd-window)
  55                     ;; FIXME: generalize what to do here.
  56                     (if (one-window-p 't)
  57                         (split-window)
  58                       (next-window window 'no-minibuf))
  59                   window))
  60           (set-window-buffer src-window src-buffer))
  61         )
  62     (select-window src-window)
  63     cmd-window)
  64   )
  65
  66 (defun realgud-window-cmd-undisturb-src ( &optional opt-buffer switch?)
  67   "Make sure the source buffer is displayed in windows without
  68 disturbing the command window if it is also displayed. Returns
  69 the source window.
  70 See also `realgud-window-src'"
  71   (interactive)
  72   (let* ((buffer (or opt-buffer (current-buffer)))
  73          (src-buffer (realgud-get-srcbuf buffer))
  74          (src-window (get-buffer-window src-buffer))
  75          (cmd-buffer (realgud-get-cmdbuf buffer))
  76          (cmd-window (get-buffer-window cmd-buffer))
  77          (window (selected-window))
  78          )
  79     (when cmd-buffer
  80       (unless cmd-window
  81         (setq cmd-window
  82               (if (eq window src-window)
  83                   ;; FIXME: generalize what to do here.
  84                   (if (one-window-p 't)
  85                       (split-window)
  86                     (next-window window 'no-minibuf))
  87                 window))
  88         (set-window-buffer cmd-window cmd-buffer)
  89         )
  90       (if switch?
  91           (and (select-window cmd-window)
  92                (switch-to-buffer cmd-buffer)))
  93
  94       )
  95     (select-window cmd-window)
  96     src-window)
  97   )
  98
  99 (defun realgud:window-bt-undisturb-src ( &optional opt-buffer switch?)
 100   "Make sure the backtrace buffer is displayed in windows without
 101 disturbing the source window if it is also displayed. Returns
 102 the source window
 103 See also `realgud-window-src'"
 104   (interactive)
 105   (let* ((buffer (or opt-buffer (current-buffer)))
 106          (src-buffer (realgud-get-srcbuf buffer))
 107          (src-window (get-buffer-window src-buffer))
 108          (cmd-buffer (realgud-get-cmdbuf buffer))
 109          (cmd-window (get-buffer-window cmd-buffer))
 110          (bt-buffer (realgud-get-backtrace-buf cmd-buffer))
 111          (bt-window (get-buffer-window bt-buffer))
 112          (window (selected-window))
 113          )
 114     (when cmd-buffer
 115       (unless bt-window
 116         (setq bt-window
 117               (if (eq window src-window)
 118                   ;; FIXME: generalize what to do here.
 119                   (if (one-window-p 't)
 120                       (split-window)
 121                     (next-window window 'no-minibuf))
 122                 window))
 123         (set-window-buffer bt-window bt-buffer)
 124         )
 125       (if switch?
 126           (and (select-window bt-window)
 127                (switch-to-buffer bt-buffer)))
 128
 129       )
 130     src-window)
 131   )
 132
 133 (defun realgud:window-bt()
 134   "Refresh backtrace information and display that in a buffer"
 135   (interactive)
 136   (with-current-buffer-safe (realgud-get-cmdbuf)
 137     (realgud:backtrace-init)
 138     (realgud:window-bt-undisturb-src)
 139     )
 140   )
 141
 142
 143 ;; (defun realgud-window-src-and-cmd ( &optional opt-buffer )
 144 ;;   "Make sure the source buffers is displayed in windows without
 145 ;; disturbing the command window if it is also displayed. Returns
 146 ;; the command window
 147 ;; See also `realgud-window-src-window'"
 148 ;;   (interactive)
 149 ;;   (let* ((buffer (or opt-buffer (current-buffer)))
 150 ;;       (src-buffer (realgud-get-srcbuf buffer))
 151 ;;       (src-window (get-buffer-window src-buffer))
 152 ;;       (cmd-buffer (realgud-get-cmdbuf buffer))
 153 ;;       (cmd-window (get-buffer-window cmd-buffer))
 154 ;;       (window (selected-window))
 155 ;;       )
 156 ;;     (if src-buffer
 157 ;;      (unless src-window
 158 ;;        (setq src-window
 159 ;;              (if (eq window cmd-window)
 160 ;;                  (if (one-window-p 't) (split-window) (next-window window))
 161 ;;                window))
 162 ;;        (set-window-buffer src-window src-buffer))
 163 ;;      )
 164 ;;     cmd-window)
 165 ;;   )
 166
 167 (provide-me "realgud-")