home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34src.zip / me3 / mutt / builtin / window.mut < prev    next >
Text File  |  1995-01-14  |  6KB  |  242 lines
  1. ;; window.mut : The window routines for ME.
  2. ;; This file is part of ME.
  3. ;; C Durland    Public Domain
  4.  
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Windows ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8.  
  9. (defun
  10.   next-window
  11.   {
  12.     (current-window (+ (arg-prefix) (current-window)))
  13.     (arg-flag FALSE 1)        ;; reset arg count
  14.   }
  15.   previous-window { (arg-prefix (- 0 (arg-prefix))) (next-window) }
  16. )
  17.  
  18. (defun
  19.   grow-window   { (window-height -1 (+ (window-height -1) (arg-prefix))) }
  20.   shrink-window { (window-height -1 (- (window-height -1) (arg-prefix))) }
  21.   shrink-window-to-dot { (window-height -1 (window-row -1)) }
  22. )
  23.  
  24. (defun
  25.   delete-current-window
  26.     { (if (not (free-window -1)) (msg "Could not delete window.")) }
  27.   delete-other-windows
  28.   {
  29.     (int n)
  30.  
  31.     (n 0)
  32.     (while (!= 1 (windows))
  33.       {
  34.     (if (== n (current-window))
  35.       (n 1)
  36.       (free-window n))
  37.       })
  38.   }
  39. )
  40.  
  41. (defun
  42.   scroll-up
  43.   {
  44.     (scroll-window  -1 (arg-prefix))
  45.     (arg-flag FALSE 1)        ;; reset arg count
  46.     TRUE
  47.   }
  48.   scroll-down
  49.   {
  50.     (scroll-window  -1 (- 0 (arg-prefix)))
  51.     (arg-flag FALSE 1)        ;; reset arg count
  52.     TRUE
  53.   }
  54.   scroll-other-window
  55.   {
  56.     (bool f)
  57.  
  58.     (if (== 1 (windows)) (done))
  59.  
  60. ;    (n (arg-prefix))
  61.     (f (arg-flag))
  62.  
  63.     (arg-prefix 1)(next-window)
  64.     (page-window FALSE 0 (not f))
  65.     (arg-prefix 1)(previous-window)
  66.  
  67. ;    (scroll-window (+ 1 (current-window)) (- 0 (arg-prefix)))
  68.  
  69.     (arg-flag FALSE 1)        ;; reset arg count
  70.     TRUE
  71.   }
  72. )
  73.  
  74. ;; Scroll the current window forward (or backwards if n is negative) by n
  75. ;;   lines, or by a full page if no argument.  The dot is left at the top
  76. ;;   of the window (if n is positive) or at the end if negative - if the
  77. ;;   top line of the window ends up at the last line of the buffer, the dot
  78. ;;   is centered.
  79. ;; Notes:
  80. ;;   If n == 1, this acts just like scroll-up (except at the end of the
  81. ;;     buffer).
  82.  
  83.       ;; NEXT-SCREEN-CONTEXT-LINES in the arithmetic on the window size
  84.       ;;   is the overlap; 2 is the default overlap value in ITS and
  85.       ;;   GNU Emacs.
  86. (const NEXT-SCREEN-CONTEXT-LINES    2)
  87. (defun
  88.   page-window (bool f)(int n)(bool forward) HIDDEN
  89.   {
  90.     (int z)
  91.  
  92.     (if (not f)        ;; Default scroll
  93.       {
  94.     (z (- (window-length) NEXT-SCREEN-CONTEXT-LINES))
  95.     (if (<= z 0) (z 1))        ;; Forget overlap if tiny window
  96.       }
  97.       (z n))
  98.     (if forward (z (- 0 z)))
  99.  
  100.     (scroll-window -1 z)
  101.  
  102.     (if (EoB) (scroll-window -1 0 0))        ;; Center dot
  103.  
  104.     (arg-flag FALSE 1)        ;; reset arg count
  105.  
  106.     TRUE
  107.   }
  108.   next-page     { (page-window (arg-flag)(arg-prefix) TRUE)  }
  109.   previous-page { (page-window (arg-flag)(arg-prefix) FALSE) }
  110. )
  111.  
  112.     ;; Horzontal window scrolling
  113.     ;; Manually scroll the current window horizontally.
  114.     ;;   Trys to keep the cursor on screen to prevent the update routines
  115.     ;;   from undoing the scroll.
  116. (defun
  117.   center-screen-around-cursor-horizontally
  118.     { (window-ledge -1 (- (current-column) (/ (screen-width) 2))) }
  119.   scroll-current-window-horizontally (int n)
  120.   {
  121.     (int left-edge right-edge)
  122.  
  123. ;;!!!??? what does GNU do?
  124.     (if (== 0 n) { (center-screen-around-cursor-horizontally) (done) })
  125.  
  126.     (right-edge
  127.       (+ (screen-width)
  128.      (left-edge (window-ledge -1 (+ (window-ledge -1) n)))))
  129.  
  130.     (if (< right-edge (current-column))
  131.       (current-column right-edge)
  132.       (if (and (<= (current-column)            left-edge)
  133.            (<= (current-column (+ left-edge 1)) left-edge))
  134.     (window-ledge -1 (- (current-column) 1))))
  135.   }
  136.   scroll-right        ;; move text in window right
  137.   {
  138.     (scroll-current-window-horizontally
  139.     (- 0 (if (arg-flag) (arg-prefix) (- (screen-width) 3))))
  140.  
  141.     (arg-flag FALSE 1)        ;; reset arg count
  142.   }
  143.   scroll-left        ;; move text in window left
  144.   {
  145.     (scroll-current-window-horizontally
  146.     (if (arg-flag) (arg-prefix) (- (screen-width) 3)))
  147.  
  148.     (arg-flag FALSE 1)        ;; reset arg count
  149.   }
  150. )
  151.  
  152. ;; Reposition window dot to the nth line from the top (or bottom if n is
  153. ;;   negative) of the current window.  If n is 0 the window is centered
  154. ;;   (this is what the standard redisplay code does).  With no argument it
  155. ;;   defaults to 1.  Because of the default, it works like Gosling Emacs.
  156. ;; Bound to "M-!"
  157. (defun
  158.   reposition-window
  159.   {
  160.     (scroll-window -1 0 (arg-prefix))
  161.  
  162.     (arg-flag FALSE 1)        ;; reset arg count
  163.  
  164.     TRUE
  165.   }
  166. )
  167. ;; Refresh the screen.  With no argument, it just does the refresh.  With an
  168. ;;   argument it [re]centers dot in the current window.
  169. ;; Notes:
  170. ;;   The screen is NOT changed in this call - it will be when (update) is
  171. ;;     called in the main loop.
  172. ;; Bound to "C-l"
  173. (defun
  174.   refresh-screen
  175.   {
  176.     (if (arg-flag)
  177.       (scroll-window -1 0 0)        ;; Center dot
  178.       (update FALSE TRUE))
  179.  
  180.     (arg-flag FALSE 1)        ;; reset arg count
  181.  
  182.     TRUE
  183.   }
  184. )
  185.  
  186. ;; Split the current window.  A window smaller than 3 lines cannot be split.
  187. ;;   The only other error possible is a malloc() failure allocating the
  188. ;;   structure for the new window.
  189. ;; Bound to "C-x 2"
  190. (defun
  191.   split-window-vertically
  192.   {
  193.     (bool resize-window)
  194.     (int rows)
  195.  
  196.     (resize-window (arg-flag))
  197.     (rows (arg-prefix))
  198.  
  199.     (arg-flag FALSE 1)        ;; reset arg count
  200.  
  201.     (if (not (split-window))
  202.       {
  203.     (msg "Cannot split a " (window-length) " line window.")
  204.     FALSE
  205.     (done)
  206.       })
  207.  
  208.     (if resize-window
  209.       (window-length -1 rows)
  210.       TRUE)
  211.   }
  212. )
  213.  
  214. (defun MAIN
  215. {
  216.   (bind-key GLOBAL-KEYMAP
  217.     "next-window"            "C-xo"
  218.     "previous-window"        "C-xp"        ;; !!!Not GNU
  219.  
  220.     "delete-current-window"        "C-x0"
  221.     "delete-other-windows"        "C-x1"
  222.  
  223.     "grow-window"            'C-x^'
  224.     "shrink-window"            "C-xC-z"    ;; !!!GNU doesn't bind
  225.  
  226.     "scroll-up"            "C-xC-p"    ;; !!!Not GNU
  227.     "scroll-down"            "C-xC-n"    ;; !!!GNU doesn't bind
  228.  
  229.     "scroll-other-window"        "M-C-v"
  230.  
  231.     "scroll-right"            "C-x>"
  232.     "scroll-left"            "C-x<"
  233.  
  234.     "next-page"            "C-v"
  235.     "previous-page"            "M-v"
  236.  
  237.     "reposition-window"        "M-!"
  238.     "refresh-screen"        "C-l"
  239.  
  240.     "split-window-vertically"    "C-x2")
  241. })
  242.