"Fossies" - the Fresh Open Source Software Archive

Member "scm/split.scm" (2 Aug 2015, 2255 Bytes) of package /linux/privat/scm-5f3.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Lisp source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "split.scm": 5f2_vs_5f3.

    1 ;;;; "split.scm", split input, output, and error streams into windows.
    2 ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
    3 ;; 
    4 ;; This program is free software: you can redistribute it and/or modify
    5 ;; it under the terms of the GNU Lesser General Public License as
    6 ;; published by the Free Software Foundation, either version 3 of the
    7 ;; License, or (at your option) any later version.
    8 ;;
    9 ;; This program is distributed in the hope that it will be useful, but
   10 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
   11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   12 ;; Lesser General Public License for more details.
   13 ;;
   14 ;; You should have received a copy of the GNU Lesser General Public
   15 ;; License along with this program.  If not, see
   16 ;; <http://www.gnu.org/licenses/>.
   17 
   18 ;;; Author: Aubrey Jaffer.
   19 
   20 (require 'curses)
   21 (define *stdscr* (initscr))
   22 (cbreak)
   23 (echo)
   24 (nl)
   25 (define subwindow-height (max 2 (quotient (output-port-height) 5)))
   26 (define *output-window*
   27   (newwin (- (output-port-height) (* 2 subwindow-height) 2)
   28       (output-port-width)
   29       0
   30       0))
   31 (define *input-window*
   32   (newwin subwindow-height
   33       (output-port-width)
   34       (- (output-port-height) (* 2 subwindow-height) 1)
   35       0))
   36 (define *error-window*
   37   (newwin subwindow-height
   38       (output-port-width)
   39       (- (output-port-height) subwindow-height)
   40       0))
   41 (wmove *stdscr* (- (output-port-height) subwindow-height 1) 0)
   42 (wstandout *stdscr*)
   43 (display (make-string (output-port-width) #\-) *stdscr*)
   44 (wmove *stdscr* (- (output-port-height) (* 2 subwindow-height) 2) 0)
   45 (display (make-string (output-port-width) #\-) *stdscr*)
   46 (wstandend *stdscr*)
   47 (touchwin *stdscr*)
   48 (force-output *stdscr*)
   49 (scrollok *output-window* #t)
   50 (scrollok *input-window* #t)
   51 (scrollok *error-window* #t)
   52 (define *default-output-port* (set-current-output-port *output-window*))
   53 (define *default-input-port* (set-current-input-port *input-window*))
   54 (define *default-error-port* (set-current-error-port *error-window*))
   55 (leaveok *output-window* #t)
   56 (leaveok *input-window* #f)
   57 (leaveok *error-window* #t)
   58 
   59 (define (unsplit)
   60   (cond ((endwin)
   61      (set-current-output-port *default-output-port*)
   62      (set-current-input-port *default-input-port*)
   63      (set-current-error-port *default-error-port*))))