Now on revision 106675. ------------------------------------------------------------ revno: 106675 committer: Alan Mackenzie branch nick: trunk timestamp: Tue 2011-12-13 21:13:51 +0000 message: Add the switch statement to AWK Mode. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-12-13 18:47:08 +0000 +++ lisp/ChangeLog 2011-12-13 21:13:51 +0000 @@ -1,5 +1,15 @@ 2011-12-13 Alan Mackenzie + Add the switch statement to AWK Mode. + + * progmodes/cc-awk (awk-font-lock-keywords): Add "switch", "case", + "default" to the keywords regexp. + + * progmodes/cc-langs (c-label-kwds): Let AWK take the same + expression as the rest. + (c-nonlabel-token-key): Allow string literals for AWK. Refactor + for the other modes. + Large brace-block initialisation makes CC Mode slow: Fix. Tidy up and accelerate c-in-literal, etc. by using the c-parse-state === modified file 'lisp/progmodes/cc-awk.el' --- lisp/progmodes/cc-awk.el 2011-12-12 05:32:49 +0000 +++ lisp/progmodes/cc-awk.el 2011-12-13 21:13:51 +0000 @@ -894,9 +894,9 @@ ;; Keywords. (concat "\\<" (regexp-opt - '("BEGIN" "END" "break" "continue" "delete" "do" "else" - "exit" "for" "getline" "if" "in" "next" "nextfile" - "return" "while") + '("BEGIN" "END" "break" "case" "continue" "default" "delete" + "do" "else" "exit" "for" "getline" "if" "in" "next" + "nextfile" "return" "switch" "while") t) "\\>") ;; Builtins. === modified file 'lisp/progmodes/cc-langs.el' --- lisp/progmodes/cc-langs.el 2011-12-12 05:32:49 +0000 +++ lisp/progmodes/cc-langs.el 2011-12-13 21:13:51 +0000 @@ -2242,8 +2242,7 @@ (c-lang-defconst c-label-kwds "Keywords introducing colon terminated labels in blocks." - t '("case" "default") - awk nil) + t '("case" "default")) (c-lang-defconst c-label-kwds-regexp ;; Adorned regexp matching any keyword that introduces a label. @@ -2998,18 +2997,19 @@ tested at the beginning of every sexp in a suspected label, i.e. before \":\". Only used if `c-recognize-colon-labels' is set." t (concat - ;; Don't allow string literals. - "\"\\|" ;; All keywords except `c-label-kwds' and `c-protection-kwds'. (c-make-keywords-re t (set-difference (c-lang-const c-keywords) (append (c-lang-const c-label-kwds) (c-lang-const c-protection-kwds)) :test 'string-equal))) + ;; Don't allow string literals, except in AWK. Character constants are OK. + (c objc java pike idl) (concat "\"\\|" + (c-lang-const c-nonlabel-token-key)) ;; Also check for open parens in C++, to catch member init lists in ;; constructors. We normally allow it so that macros with arguments ;; work in labels. - c++ (concat "\\s\(\\|" (c-lang-const c-nonlabel-token-key))) + c++ (concat "\\s\(\\|\"\\|" (c-lang-const c-nonlabel-token-key))) (c-lang-defvar c-nonlabel-token-key (c-lang-const c-nonlabel-token-key)) (c-lang-defconst c-nonlabel-token-2-key ------------------------------------------------------------ revno: 106674 committer: Alan Mackenzie branch nick: trunk timestamp: Tue 2011-12-13 18:47:08 +0000 message: Large brace-block initialisation makes CC Mode slow: Fix. Tidy up and accelerate c-in-literal, etc. by using the c-parse-state routines. Limit backward searching in c-font-lock-enclosing.decl. cc-engine.el (c-state-pp-to-literal): Return the pp-state and literal type in addition to the limits. (c-state-safe-place): New defun, extracted from c-state-literal-at. (c-state-literal-at): Use the above new defun. (c-slow-in-literal, c-fast-in-literal): Removed. (c-in-literal, c-literal-limits): Amended to use c-state-pp-to-literal. cc-fonts.el (c-font-lock-enclosing-decls): Check for being in a literal. Add a limit for backward searching. cc-mode.el (awk-mode): Don't alias c-in-literal to c-slow-in-literal. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-12-13 15:33:25 +0000 +++ lisp/ChangeLog 2011-12-13 18:47:08 +0000 @@ -1,3 +1,25 @@ +2011-12-13 Alan Mackenzie + + Large brace-block initialisation makes CC Mode slow: Fix. + Tidy up and accelerate c-in-literal, etc. by using the + c-parse-state + routines. Limit backward searching in c-font-lock-enclosing.decl. + + * progmodes/cc-engine.el (c-state-pp-to-literal): Return the + pp-state and literal type in addition to the limits. + (c-state-safe-place): New defun, extracted from + c-state-literal-at. + (c-state-literal-at): Use the above new defun. + (c-slow-in-literal, c-fast-in-literal): Removed. + (c-in-literal, c-literal-limits): Amended to use + c-state-pp-to-literal. + + * progmodes/cc-fonts.el (c-font-lock-enclosing-decls): Check for + being in a literal. Add a limit for backward searching. + + * progmodes/cc-mode.el (awk-mode): Don't alias c-in-literal to + c-slow-in-literal. + 2011-12-13 Stefan Monnier * progmodes/pascal.el: Declare `ind' as dyn-bound (bug#10264). === modified file 'lisp/progmodes/cc-engine.el' --- lisp/progmodes/cc-engine.el 2011-12-12 05:32:49 +0000 +++ lisp/progmodes/cc-engine.el 2011-12-13 18:47:08 +0000 @@ -195,9 +195,6 @@ (not prevstate) (> arg 0))) -;; Dynamically bound cache for `c-in-literal'. -(defvar c-in-literal-cache t) - ;; Basic handling of preprocessor directives. @@ -2093,28 +2090,35 @@ ;; `c-state-literal-at'. (defsubst c-state-pp-to-literal (from to) - ;; Do a parse-partial-sexp from FROM to TO, returning the bounds of any - ;; literal at TO as a cons, otherwise NIL. - ;; FROM must not be in a literal, and the buffer should already be wide - ;; enough. + ;; Do a parse-partial-sexp from FROM to TO, returning either + ;; (STATE TYPE (BEG . END)) if TO is in a literal; or + ;; (STATE) otherwise, + ;; where STATE is the parsing state at TO, TYPE is the type of the literal + ;; (one of 'c, 'c++, 'string) and (BEG . END) is the boundaries of the literal. + ;; + ;; Only elements 3 (in a string), 4 (in a comment), 5 (following a quote), + ;; 7 (comment type) and 8 (start of comment/string) (and possibly 9) of + ;; STATE are valid. (save-excursion - (let ((s (parse-partial-sexp from to))) + (let ((s (parse-partial-sexp from to)) + ty) (when (or (nth 3 s) (nth 4 s)) ; in a string or comment + (setq ty (cond + ((nth 3 s) 'string) + ((eq (nth 7 s) t) 'c++) + (t 'c))) (parse-partial-sexp (point) (point-max) nil ; TARGETDEPTH nil ; STOPBEFORE s ; OLDSTATE - 'syntax-table) ; stop at end of literal - (cons (nth 8 s) (point)))))) + 'syntax-table)) ; stop at end of literal + (if ty + `(,s ,ty (,(nth 8 s) . ,(point))) + `(,s))))) -(defun c-state-literal-at (here) - ;; If position HERE is inside a literal, return (START . END), the - ;; boundaries of the literal (which may be outside the accessible bit of the - ;; buffer). Otherwise, return nil. - ;; - ;; This function is almost the same as `c-literal-limits'. It differs in - ;; that it is a lower level function, and that it rigorously follows the - ;; syntax from BOB, whereas `c-literal-limits' uses a "local" safe position. +(defun c-state-safe-place (here) + ;; Return a buffer position before HERE which is "safe", i.e. outside any + ;; string, comment, or macro. ;; ;; NOTE: This function manipulates `c-state-nonlit-pos-cache'. This cache ;; MAY NOT contain any positions within macros, since macros are frequently @@ -2137,7 +2141,7 @@ (while (<= (setq npos (+ pos c-state-nonlit-pos-interval)) here) - (setq lit (c-state-pp-to-literal pos npos)) + (setq lit (car (cddr (c-state-pp-to-literal pos npos)))) (setq pos (or (cdr lit) npos)) ; end of literal containing npos. (goto-char pos) (when (and (c-beginning-of-macro) (/= (point) pos)) @@ -2148,9 +2152,22 @@ (if (> pos c-state-nonlit-pos-cache-limit) (setq c-state-nonlit-pos-cache-limit pos)) - (if (< pos here) - (setq lit (c-state-pp-to-literal pos here))) - lit)))) + pos)))) + +(defun c-state-literal-at (here) + ;; If position HERE is inside a literal, return (START . END), the + ;; boundaries of the literal (which may be outside the accessible bit of the + ;; buffer). Otherwise, return nil. + ;; + ;; This function is almost the same as `c-literal-limits'. Previously, it + ;; differed in that it was a lower level function, and that it rigourously + ;; followed the syntax from BOB. `c-literal-limits' is now (2011-12) + ;; virtually identical to this function. + (save-restriction + (widen) + (save-excursion + (let ((pos (c-state-safe-place here))) + (car (cddr (c-state-pp-to-literal pos here))))))) (defsubst c-state-lit-beg (pos) ;; Return the start of the literal containing POS, or POS itself. @@ -4181,7 +4198,7 @@ ;; Tools for handling comments and string literals. -(defun c-slow-in-literal (&optional lim detect-cpp) +(defun c-in-literal (&optional lim detect-cpp) "Return the type of literal point is in, if any. The return value is `c' if in a C-style comment, `c++' if in a C++ style comment, `string' if in a string literal, `pound' if DETECT-CPP @@ -4194,67 +4211,12 @@ Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." - - (if (and (vectorp c-in-literal-cache) - (= (point) (aref c-in-literal-cache 0))) - (aref c-in-literal-cache 1) - (let ((rtn (save-excursion - (let* ((pos (point)) - (lim (or lim (progn - (c-beginning-of-syntax) - (point)))) - (state (parse-partial-sexp lim pos))) - (cond - ((elt state 3) 'string) - ((elt state 4) (if (elt state 7) 'c++ 'c)) - ((and detect-cpp (c-beginning-of-macro lim)) 'pound) - (t nil)))))) - ;; cache this result if the cache is enabled - (if (not c-in-literal-cache) - (setq c-in-literal-cache (vector (point) rtn))) - rtn))) - -;; XEmacs has a built-in function that should make this much quicker. -;; I don't think we even need the cache, which makes our lives more -;; complicated anyway. In this case, lim is only used to detect -;; cpp directives. -;; -;; Note that there is a bug in XEmacs's buffer-syntactic-context when used in -;; conjunction with syntax-table-properties. The bug is present in, e.g., -;; XEmacs 21.4.4. It manifested itself thus: -;; -;; Starting with an empty AWK Mode buffer, type -;; /regexp/ { -;; Point gets wrongly left at column 0, rather than being indented to tab-width. -;; -;; AWK Mode is designed such that when the first / is typed, it gets the -;; syntax-table property "string fence". When the second / is typed, BOTH /s -;; are given the s-t property "string". However, buffer-syntactic-context -;; fails to take account of the change of the s-t property on the opening / to -;; "string", and reports that the { is within a string started by the second /. -;; -;; The workaround for this is for the AWK Mode initialization to switch the -;; defalias for c-in-literal to c-slow-in-literal. This will slow down other -;; cc-modes in XEmacs whenever an awk-buffer has been initialized. -;; -;; (Alan Mackenzie, 2003/4/30). - -(defun c-fast-in-literal (&optional lim detect-cpp) - ;; This function might do hidden buffer changes. - (let ((context (buffer-syntactic-context))) - (cond - ((eq context 'string) 'string) - ((eq context 'comment) 'c++) - ((eq context 'block-comment) 'c) - ((and detect-cpp (save-excursion (c-beginning-of-macro lim))) 'pound)))) - -(defalias 'c-in-literal - (if (fboundp 'buffer-syntactic-context) - 'c-fast-in-literal ; XEmacs - 'c-slow-in-literal)) ; GNU Emacs - -;; The defalias above isn't enough to shut up the byte compiler. -(cc-bytecomp-defun c-in-literal) + (let* ((safe-place (c-state-safe-place (point))) + (lit (c-state-pp-to-literal safe-place (point)))) + (or (cadr lit) + (and detect-cpp + (save-excursion (c-beginning-of-macro)) + 'pound)))) (defun c-literal-limits (&optional lim near not-in-delimiter) "Return a cons of the beginning and end positions of the comment or @@ -4273,64 +4235,56 @@ (save-excursion (let* ((pos (point)) - (lim (or lim (progn - (c-beginning-of-syntax) - (point)))) - (state (parse-partial-sexp lim pos))) - - (cond ((elt state 3) ; String. - (goto-char (elt state 8)) - (cons (point) (or (c-safe (c-forward-sexp 1) (point)) - (point-max)))) - - ((elt state 4) ; Comment. - (goto-char (elt state 8)) - (cons (point) (progn (c-forward-single-comment) (point)))) - - ((and (not not-in-delimiter) - (not (elt state 5)) - (eq (char-before) ?/) - (looking-at "[/*]")) - ;; We're standing in a comment starter. - (backward-char 1) - (cons (point) (progn (c-forward-single-comment) (point)))) - - (near - (goto-char pos) - - ;; Search forward for a literal. - (skip-chars-forward " \t") - - (cond - ((looking-at c-string-limit-regexp) ; String. - (cons (point) (or (c-safe (c-forward-sexp 1) (point)) - (point-max)))) - - ((looking-at c-comment-start-regexp) ; Line or block comment. - (cons (point) (progn (c-forward-single-comment) (point)))) - - (t - ;; Search backward. - (skip-chars-backward " \t") - - (let ((end (point)) beg) - (cond - ((save-excursion - (< (skip-syntax-backward c-string-syntax) 0)) ; String. - (setq beg (c-safe (c-backward-sexp 1) (point)))) - - ((and (c-safe (forward-char -2) t) - (looking-at "*/")) - ;; Block comment. Due to the nature of line - ;; comments, they will always be covered by the - ;; normal case above. - (goto-char end) - (c-backward-single-comment) - ;; If LIM is bogus, beg will be bogus. - (setq beg (point)))) - - (if beg (cons beg end)))))) - )))) + (lim (or lim (c-state-safe-place pos))) + (pp-to-lit (c-state-pp-to-literal lim pos)) + (state (car pp-to-lit)) + (lit-type (cadr pp-to-lit)) + (lit-limits (car (cddr pp-to-lit)))) + + (cond + (lit-limits) + ((and (not not-in-delimiter) + (not (elt state 5)) + (eq (char-before) ?/) + (looking-at "[/*]")) ; FIXME!!! use c-line/block-comment-starter. 2008-09-28. + ;; We're standing in a comment starter. + (backward-char 1) + (cons (point) (progn (c-forward-single-comment) (point)))) + + (near + (goto-char pos) + ;; Search forward for a literal. + (skip-chars-forward " \t") + (cond + ((looking-at c-string-limit-regexp) ; String. + (cons (point) (or (c-safe (c-forward-sexp 1) (point)) + (point-max)))) + + ((looking-at c-comment-start-regexp) ; Line or block comment. + (cons (point) (progn (c-forward-single-comment) (point)))) + + (t + ;; Search backward. + (skip-chars-backward " \t") + + (let ((end (point)) beg) + (cond + ((save-excursion + (< (skip-syntax-backward c-string-syntax) 0)) ; String. + (setq beg (c-safe (c-backward-sexp 1) (point)))) + + ((and (c-safe (forward-char -2) t) + (looking-at "*/")) + ;; Block comment. Due to the nature of line + ;; comments, they will always be covered by the + ;; normal case above. + (goto-char end) + (c-backward-single-comment) + ;; If LIM is bogus, beg will be bogus. + (setq beg (point)))) + + (if beg (cons beg end)))))) + )))) ;; In case external callers use this; it did have a docstring. (defalias 'c-literal-limits-fast 'c-literal-limits) === modified file 'lisp/progmodes/cc-fonts.el' --- lisp/progmodes/cc-fonts.el 2011-12-12 05:32:49 +0000 +++ lisp/progmodes/cc-fonts.el 2011-12-13 18:47:08 +0000 @@ -1539,10 +1539,11 @@ ;; Fontification". (let* ((paren-state (c-parse-state)) (start (point)) + (bod-lim (max (- (point) 500) (point-min))) decl-context bo-decl in-typedef type-type ps-elt) ;; First, are we actually in a "local" declaration? - (setq decl-context (c-beginning-of-decl-1) + (setq decl-context (c-beginning-of-decl-1 bod-lim) bo-decl (point) in-typedef (looking-at c-typedef-key)) (if in-typedef (c-forward-token-2)) === modified file 'lisp/progmodes/cc-mode.el' --- lisp/progmodes/cc-mode.el 2011-12-12 05:32:49 +0000 +++ lisp/progmodes/cc-mode.el 2011-12-13 18:47:08 +0000 @@ -1562,10 +1562,6 @@ (c-common-init 'awk-mode) (c-awk-unstick-NL-prop) - ;; Prevent XEmacs's buffer-syntactic-context being used. See the comment - ;; in cc-engine.el, just before (defun c-fast-in-literal ... - (defalias 'c-in-literal 'c-slow-in-literal) - (c-run-mode-hooks 'c-mode-common-hook 'awk-mode-hook) (c-update-modeline)) ------------------------------------------------------------ revno: 106673 fixes bug(s): http://debbugs.gnu.org/cgi/bugreport.cgi?bug=10264 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2011-12-13 10:33:25 -0500 message: * lisp/progmodes/pascal.el: Declare `ind' as dyn-bound. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-12-13 13:37:48 +0000 +++ lisp/ChangeLog 2011-12-13 15:33:25 +0000 @@ -1,3 +1,7 @@ +2011-12-13 Stefan Monnier + + * progmodes/pascal.el: Declare `ind' as dyn-bound (bug#10264). + 2011-12-13 Martin Rudalics * window.el (delete-other-windows): Use correct frame in call to === modified file 'lisp/progmodes/pascal.el' --- lisp/progmodes/pascal.el 2011-11-20 03:48:53 +0000 +++ lisp/progmodes/pascal.el 2011-12-13 15:33:25 +0000 @@ -786,6 +786,7 @@ (if (looking-at "[ \t]+$") (skip-chars-forward " \t")))) +(defvar ind) ;Used via `eval' in pascal-indent-alist. (defun pascal-indent-line () "Indent current line as a Pascal statement." (let* ((indent-str (pascal-calculate-indent)) === added file 'test/indent/pascal.pas' --- test/indent/pascal.pas 1970-01-01 00:00:00 +0000 +++ test/indent/pascal.pas 2011-12-13 15:33:25 +0000 @@ -0,0 +1,1088 @@ +{ GPC demo program for the CRT unit. + +Copyright (C) 1999-2006 Free Software Foundation, Inc. + +Author: Frank Heckenbach + +This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License as +published by the Free Software Foundation, version 2. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +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 this program; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. + +As a special exception, if you incorporate even large parts of the +code of this demo program into another program with substantially +different functionality, this does not cause the other program to +be covered by the GNU General Public License. This exception does +not however invalidate any other reasons why it might be covered +by the GNU General Public License. } + +{$gnu-pascal,I+} + +program CRTDemo; + +uses GPC, CRT; + +type + TFrameChars = array [1 .. 8] of Char; + TSimulateBlockCursorKind = (bc_None, bc_Blink, bc_Static); + +const + SingleFrame: TFrameChars = (chCornerTLS, chLineHS, chCornerTRS, chLineVS, chLineVS, chCornerBLS, chLineHS, chCornerBRS); + DoubleFrame: TFrameChars = (chCornerTLD, chLineHD, chCornerTRD, chLineVD, chLineVD, chCornerBLD, chLineHD, chCornerBRD); + +var + ScrollState: Boolean = True; + SimulateBlockCursorKind: TSimulateBlockCursorKind = bc_None; + CursorShape: TCursorShape = CursorNormal; + MainPanel: TPanel; + OrigScreenSize: TPoint; + +procedure FrameWin (const Title: String; const Frame: TFrameChars; TitleInverse: Boolean); +var + w, h, y, Color: Integer; + Attr: TTextAttr; +begin + HideCursor; + SetPCCharSet (True); + ClrScr; + w := GetXMax; + h := GetYMax; + WriteCharAt (1, 1, 1, Frame[1], TextAttr); + WriteCharAt (2, 1, w - 2, Frame[2], TextAttr); + WriteCharAt (w, 1, 1, Frame[3], TextAttr); + for y := 2 to h - 1 do + begin + WriteCharAt (1, y, 1, Frame[4], TextAttr); + WriteCharAt (w, y, 1, Frame[5], TextAttr) + end; + WriteCharAt (1, h, 1, Frame[6], TextAttr); + WriteCharAt (2, h, w - 2, Frame[7], TextAttr); + WriteCharAt (w, h, 1, Frame[8], TextAttr); + SetPCCharSet (False); + Attr := TextAttr; + if TitleInverse then + begin + Color := GetTextColor; + TextColor (GetTextBackground); + TextBackground (Color) + end; + WriteStrAt ((w - Length (Title)) div 2 + 1, 1, Title, TextAttr); + TextAttr := Attr +end; + +function GetKey (TimeOut: Integer) = Key: TKey; forward; + +procedure ClosePopUpWindow; +begin + PanelDelete (GetActivePanel); + PanelDelete (GetActivePanel) +end; + +function PopUpConfirm (XSize, YSize: Integer; const Msg: String): Boolean; +var + ax, ay: Integer; + Key: TKey; + SSize: TPoint; +begin + repeat + SSize := ScreenSize; + ax := (SSize.x - XSize - 4) div 2 + 1; + ay := (SSize.y - YSize - 4) div 2 + 1; + PanelNew (ax, ay, ax + XSize + 3, ay + YSize + 1, False); + TextBackground (Black); + TextColor (Yellow); + SetControlChars (True); + FrameWin ('', DoubleFrame, False); + NormalCursor; + PanelNew (ax + 2, ay + 1, ax + XSize + 2, ay + YSize, False); + ClrScr; + Write (Msg); + Key := GetKey (-1); + if Key = kbScreenSizeChanged then ClosePopUpWindow + until Key <> kbScreenSizeChanged; + PopUpConfirm := not (Key in [kbEsc, kbAltEsc]) +end; + +procedure MainDraw; +begin + WriteLn ('3, F3 : Open a window'); + WriteLn ('4, F4 : Close window'); + WriteLn ('5, F5 : Previous window'); + WriteLn ('6, F6 : Next window'); + WriteLn ('7, F7 : Move window'); + WriteLn ('8, F8 : Resize window'); + Write ('q, Esc: Quit') +end; + +procedure StatusDraw; +const + YesNo: array [Boolean] of String [3] = ('No', 'Yes'); + SimulateBlockCursorIDs: array [TSimulateBlockCursorKind] of String [8] = ('Off', 'Blinking', 'Static'); + CursorShapeIDs: array [TCursorShape] of String [7] = ('Ignored', 'Hidden', 'Normal', 'Fat', 'Block'); +var + SSize: TPoint; +begin + WriteLn ('You can change some of the following'); + WriteLn ('settings by pressing the key shown'); + WriteLn ('in parentheses. Naturally, color and'); + WriteLn ('changing the cursor shape or screen'); + WriteLn ('size does not work on all terminals.'); + WriteLn; + WriteLn ('XCurses version: ', YesNo[XCRT]); + WriteLn ('CRTSavePreviousScreen: ', YesNo[CRTSavePreviousScreenWorks]); + WriteLn ('(M)onochrome: ', YesNo[IsMonochrome]); + SSize := ScreenSize; + WriteLn ('Screen (C)olumns: ', SSize.x); + WriteLn ('Screen (L)ines: ', SSize.y); + WriteLn ('(R)estore screen size'); + WriteLn ('(B)reak checking: ', YesNo[CheckBreak]); + WriteLn ('(S)crolling: ', YesNo[ScrollState]); + WriteLn ('S(i)mulated block cursor: ', SimulateBlockCursorIDs[SimulateBlockCursorKind]); + Write ('C(u)rsor shape: ', CursorShapeIDs[CursorShape]); + GotoXY (36, WhereY) +end; + +procedure RedrawAll; forward; +procedure CheckScreenSize; forward; + +procedure StatusKey (Key: TKey); +var SSize, NewSize: TPoint; +begin + case LoCase (Key2Char (Key)) of + 'm': begin + SetMonochrome (not IsMonochrome); + RedrawAll + end; + 'c': begin + SSize := ScreenSize; + if SSize.x > 40 then + NewSize.x := 40 + else + NewSize.x := 80; + if SSize.y > 25 then + NewSize.y := 50 + else + NewSize.y := 25; + SetScreenSize (NewSize.x, NewSize.y); + CheckScreenSize + end; + 'l': begin + SSize := ScreenSize; + if SSize.x > 40 then + NewSize.x := 80 + else + NewSize.x := 40; + if SSize.y > 25 then + NewSize.y := 25 + else + NewSize.y := 50; + SetScreenSize (NewSize.x, NewSize.y); + CheckScreenSize + end; + 'r': begin + SetScreenSize (OrigScreenSize.x, OrigScreenSize.y); + CheckScreenSize + end; + 'b': CheckBreak := not CheckBreak; + 's': ScrollState := not ScrollState; + 'i': if SimulateBlockCursorKind = High (SimulateBlockCursorKind) then + SimulateBlockCursorKind := Low (SimulateBlockCursorKind) + else + Inc (SimulateBlockCursorKind); + 'u': case CursorShape of + CursorNormal: CursorShape := CursorBlock; + CursorFat, + CursorBlock : CursorShape := CursorHidden; + else CursorShape := CursorNormal + end; + end; + ClrScr; + StatusDraw +end; + +procedure TextAttrDemo; +var f, b, y, x1, y1, x2, y2, Fill, n1, n2, n3: Integer; +begin + GetWindow (x1, y1, x2, y2); + Window (x1 - 1, y1, x2, y2); + TextColor (White); + TextBackground (Blue); + ClrScr; + SetScroll (False); + Fill := GetXMax - 32; + for y := 1 to GetYMax do + begin + GotoXY (1, y); + b := (y - 1) mod 16; + n1 := 0; + for f := 0 to 15 do + begin + TextAttr := f + 16 * b; + n2 := (Fill * (1 + 2 * f) + 16) div 32; + n3 := (Fill * (2 + 2 * f) + 16) div 32; + Write ('' : n2 - n1, NumericBaseDigitsUpper[b], NumericBaseDigitsUpper[f], '' : n3 - n2); + n1 := n3 + end + end +end; + +procedure CharSetDemo (UsePCCharSet: Boolean); +var h, l, y, x1, y1, x2, y2, Fill, n1, n2: Integer; +begin + GetWindow (x1, y1, x2, y2); + Window (x1 - 1, y1, x2, y2); + ClrScr; + SetScroll (False); + SetPCCharSet (UsePCCharSet); + SetControlChars (False); + Fill := GetXMax - 35; + for y := 1 to GetYMax do + begin + GotoXY (1, y); + h := (y - 2) mod 16; + n1 := (Fill + 9) div 18; + if y = 1 then + Write ('' : 3 + n1) + else + Write (16 * h : 3 + n1); + for l := 0 to 15 do + begin + n2 := (Fill * (2 + l) + 9) div 18; + if y = 1 then + Write ('' : n2 - n1, l : 2) + else + Write ('' : n2 - n1 + 1, Chr (16 * h + l)); + n1 := n2 + end + end +end; + +procedure NormalCharSetDemo; +begin + CharSetDemo (False) +end; + +procedure PCCharSetDemo; +begin + CharSetDemo (True) +end; + +procedure FKeyDemoDraw; +var x1, y1, x2, y2: Integer; +begin + GetWindow (x1, y1, x2, y2); + Window (x1, y1, x2 - 1, y2); + ClrScr; + SetScroll (False); + WriteLn ('You can type the following keys'); + WriteLn ('(function keys if present on the'); + WriteLn ('terminal, letters as alternatives):'); + GotoXY (1, 4); + WriteLn ('S, Left : left (wrap-around)'); + WriteLn ('D, Right : right (wrap-around)'); + WriteLn ('E, Up : up (wrap-around)'); + WriteLn ('X, Down : down (wrap-around)'); + WriteLn ('A, Home : go to first column'); + WriteLn ('F, End : go to last column'); + WriteLn ('R, Page Up : go to first line'); + WriteLn ('C, Page Down: go to last line'); + WriteLn ('Y, Ctrl-PgUp: first column and line'); + GotoXY (1, 13); + WriteLn ('B, Ctrl-PgDn: last column and line'); + WriteLn ('Z, Ctrl-Home: clear screen'); + WriteLn ('N, Ctrl-End : clear to end of line'); + WriteLn ('V, Insert : insert a line'); + WriteLn ('T, Delete : delete a line'); + WriteLn ('# : beep'); + WriteLn ('* : flash'); + WriteLn ('Tab, Enter, Backspace, other'); + WriteLn (' normal characters: write text') +end; + +procedure FKeyDemoKey (Key: TKey); +const TabSize = 8; +var + ch: Char; + NewX: Integer; +begin + case LoCaseKey (Key) of + Ord ('s'), kbLeft : if WhereX = 1 then GotoXY (GetXMax, WhereY) else GotoXY (WhereX - 1, WhereY); + Ord ('d'), kbRight : if WhereX = GetXMax then GotoXY (1, WhereY) else GotoXY (WhereX + 1, WhereY); + Ord ('e'), kbUp : if WhereY = 1 then GotoXY (WhereX, GetYMax) else GotoXY (WhereX, WhereY - 1); + Ord ('x'), kbDown : if WhereY = GetYMax then GotoXY (WhereX, 1) else GotoXY (WhereX, WhereY + 1); + Ord ('a'), kbHome : Write (chCR); + Ord ('f'), kbEnd : GotoXY (GetXMax, WhereY); + Ord ('r'), kbPgUp : GotoXY (WhereX, 1); + Ord ('c'), kbPgDn : GotoXY (WhereX, GetYMax); + Ord ('y'), kbCtrlPgUp: GotoXY (1, 1); + Ord ('b'), kbCtrlPgDn: GotoXY (GetXMax, GetYMax); + Ord ('z'), kbCtrlHome: ClrScr; + Ord ('n'), kbCtrlEnd : ClrEOL; + Ord ('v'), kbIns : InsLine; + Ord ('t'), kbDel : DelLine; + Ord ('#') : Beep; + Ord ('*') : Flash; + kbTab : begin + NewX := ((WhereX - 1) div TabSize + 1) * TabSize + 1; + if NewX <= GetXMax then GotoXY (NewX, WhereY) else WriteLn + end; + kbCR : WriteLn; + kbBkSp : Write (chBkSp, ' ', chBkSp); + else ch := Key2Char (Key); + if ch <> #0 then Write (ch) + end +end; + +procedure KeyDemoDraw; +begin + WriteLn ('Press some keys ...') +end; + +procedure KeyDemoKey (Key: TKey); +var ch: Char; +begin + ch := Key2Char (Key); + if ch <> #0 then + begin + Write ('Normal key'); + if IsPrintable (ch) then Write (' `', ch, ''''); + WriteLn (', ASCII #', Ord (ch)) + end + else + WriteLn ('Special key ', Ord (Key2Scan (Key))) +end; + +procedure IOSelectPeriodical; +var + CurrentTime: TimeStamp; + s: String (8); + i: Integer; +begin + GetTimeStamp (CurrentTime); + with CurrentTime do + WriteStr (s, Hour : 2, ':', Minute : 2, ':', Second : 2); + for i := 1 to Length (s) do + if s[i] = ' ' then s[i] := '0'; + GotoXY (1, 12); + Write ('The time is: ', s) +end; + +procedure IOSelectDraw; +begin + WriteLn ('IOSelect is a way to handle I/O from'); + WriteLn ('or to several places simultaneously,'); + WriteLn ('without having to use threads or'); + WriteLn ('signal/interrupt handlers or waste'); + WriteLn ('CPU time with busy waiting.'); + WriteLn; + WriteLn ('This demo shows how IOSelect works'); + WriteLn ('in connection with CRT. It displays'); + WriteLn ('a clock, but still reacts to user'); + WriteLn ('input immediately.'); + IOSelectPeriodical +end; + +procedure ModifierPeriodical; +const + Pressed: array [Boolean] of String [8] = ('Released', 'Pressed'); + ModifierNames: array [1 .. 7] of record + Modifier: Integer; + Name: String (17) + end = + ((shLeftShift, 'Left Shift'), + (shRightShift, 'Right Shift'), + (shLeftCtrl, 'Left Control'), + (shRightCtrl, 'Right Control'), + (shAlt, 'Alt (left)'), + (shAltGr, 'AltGr (right Alt)'), + (shExtra, 'Extra')); +var + ShiftState, i: Integer; +begin + ShiftState := GetShiftState; + for i := 1 to 7 do + with ModifierNames[i] do + begin + GotoXY (1, 4 + i); + ClrEOL; + Write (Name, ':'); + GotoXY (20, WhereY); + Write (Pressed[(ShiftState and Modifier) <> 0]) + end +end; + +procedure ModifierDraw; +begin + WriteLn ('Modifier keys (NOTE: only'); + WriteLn ('available on some systems;'); + WriteLn ('X11: only after key press):'); + ModifierPeriodical +end; + +procedure ChecksDraw; +begin + WriteLn ('(O)S shell'); + WriteLn ('OS shell with (C)learing'); + WriteLn ('(R)efresh check'); + Write ('(S)ound check') +end; + +procedure ChecksKey (Key: TKey); +var + i, j: Integer; + WasteTime: Real; attribute (volatile); + + procedure DoOSShell; + var + Result: Integer; + Shell: TString; + begin + Shell := GetShellPath (Null); + {$I-} + Result := Execute (Shell); + {$I+} + if (InOutRes <> 0) or (Result <> 0) then + begin + ClrScr; + if InOutRes <> 0 then + WriteLn (GetIOErrorMessage, ' while trying to execute `', Shell, '''.') + else + WriteLn ('`', Shell, ''' returned status ', Result, '.'); + Write ('Any key to continue.'); + BlockCursor; + Discard (GetKey (-1)) + end + end; + +begin + case LoCase (Key2Char (Key)) of + 'o': begin + if PopUpConfirm (36, 12, 'You will now get an OS shell. Unless' + NewLine + + 'CRTDemo is running in its own (GUI)' + NewLine + + 'window, the shell will run on the' + NewLine + + 'same screen as CRTDemo which is not' + NewLine + + 'cleared before the shell is started.' + NewLine + + 'If possible, the screen contents are' + NewLine + + 'restored to the state before CRTDemo' + NewLine + + 'was started. After leaving the shell' + NewLine + + 'in the usual way (usually by enter-' + NewLine + + 'ing `exit''), you will get back to' + NewLine + + 'the demo. to abort, any other' + NewLine + + 'key to start.') then + begin + RestoreTerminal (True); + DoOSShell + end; + ClosePopUpWindow + end; + 'c': begin + if PopUpConfirm (36, 9, 'You will now get an OS shell. Unless' + NewLine + + 'CRTDemo is running in its own (GUI)' + NewLine + + 'window, the screen will be cleared,' + NewLine + + 'and the cursor will be moved to the' + NewLine + + 'top before the shell is started.' + NewLine + + 'After leaving the shell in the usual' + NewLine + + 'way (usually by entering `exit''),' + NewLine + + 'you will get back to the demo. ' + NewLine + + 'to abort, any other key to start.') then + begin + RestoreTerminalClearCRT; + DoOSShell + end; + ClosePopUpWindow + end; + 'r': begin + if PopUpConfirm (36, 11, 'The program will now get busy with' + NewLine + + 'some dummy computations. However,' + NewLine + + 'CRT output in the form of dots will' + NewLine + + 'still appear continuously one by one' + NewLine + + '(rather than the whole line at once' + NewLine + + 'in the end). While running, the test' + NewLine + + 'cannot be interrupted. to' + NewLine + + 'abort, any other key to start.') then + begin + SetCRTUpdate (UpdateRegularly); + BlockCursor; + WriteLn; + WriteLn; + for i := 1 to GetXMax - 2 do + begin + Write ('.'); + for j := 1 to 400000 do WasteTime := Random + end; + SetCRTUpdate (UpdateInput); + WriteLn; + Write ('Press any key.'); + Discard (GetKey (-1)) + end; + ClosePopUpWindow + end; + 's': begin + if PopUpConfirm (32, 4, 'You will now hear some sounds if' + NewLine + + 'supported (otherwise there will' + NewLine + + 'just be a short pause). to' + NewLine + + 'abort, any other key to start.') then + begin + BlockCursor; + for i := 0 to 7 do + begin + Sound (Round (440 * 2 ** (Round (i * 12 / 7 + 0.3) / 12))); + if GetKey (400000) in [kbEsc, kbAltEsc] then Break + end; + NoSound + end; + ClosePopUpWindow + end; + end +end; + +type + PWindowList = ^TWindowList; + TWindowList = record + Next, Prev: PWindowList; + Panel, FramePanel: TPanel; + WindowType: Integer; + x1, y1, xs, ys: Integer; + State: (ws_None, ws_Moving, ws_Resizing); + end; + +TKeyProc = procedure (Key: TKey); +TProcedure = procedure; + +const + MenuNameLength = 16; + WindowTypes: array [0 .. 9] of record + DrawProc, + PeriodicalProc: procedure; + KeyProc : TKeyProc; + Name : String (MenuNameLength); + Color, + Background, + MinSizeX, + MinSizeY, + PrefSizeX, + PrefSizeY : Integer; + RedrawAlways, + WantCursor : Boolean + end = +((MainDraw , nil , nil , 'CRT Demo' , LightGreen, Blue , 26, 7, 0, 0, False, False), + (StatusDraw , nil , StatusKey , 'Status' , White , Red , 38, 16, 0, 0, True, True), + (TextAttrDemo , nil , nil , 'Text Attributes' , White , Blue , 32, 16, 64, 16, False, False), + (NormalCharSetDemo, nil , nil , 'Character Set' , Black , Green , 35, 17, 53, 17, False, False), + (PCCharSetDemo , nil , nil , 'PC Character Set', Black , Brown , 35, 17, 53, 17, False, False), + (KeyDemoDraw , nil , KeyDemoKey , 'Keys' , Blue , LightGray, 29, 5, -1, -1, False, True), + (FKeyDemoDraw , nil , FKeyDemoKey, 'Function Keys' , Blue , LightGray, 37, 22, -1, -1, False, True), + (ModifierDraw , ModifierPeriodical, nil , 'Modifier Keys' , Black , Cyan , 29, 11, 0, 0, True, False), + (IOSelectDraw , IOSelectPeriodical, nil , 'IOSelect Demo' , White , Magenta , 38, 12, 0, 0, False, False), + (ChecksDraw , nil , ChecksKey , 'Various Checks' , Black , Red , 26, 4, 0, 0, False, False)); + +MenuMax = High (WindowTypes); +MenuXSize = MenuNameLength + 4; +MenuYSize = MenuMax + 2; + +var + WindowList: PWindowList = nil; + + procedure RedrawFrame (p: PWindowList); + begin + with p^, WindowTypes[WindowType] do + begin + PanelActivate (FramePanel); + Window (x1, y1, x1 + xs - 1, y1 + ys - 1); + ClrScr; + case State of + ws_None : if p = WindowList then + FrameWin (' ' + Name + ' ', DoubleFrame, True) + else + FrameWin (' ' + Name + ' ', SingleFrame, False); + ws_Moving : FrameWin (' Move Window ', SingleFrame, True); + ws_Resizing: FrameWin (' Resize Window ', SingleFrame, True); + end + end + end; + + procedure DrawWindow (p: PWindowList); + begin + with p^, WindowTypes[WindowType] do + begin + RedrawFrame (p); + PanelActivate (Panel); + Window (x1 + 2, y1 + 1, x1 + xs - 2, y1 + ys - 2); + ClrScr; + DrawProc + end + end; + + procedure RedrawAll; + var + LastPanel: TPanel; + p: PWindowList; + x2, y2: Integer; + begin + LastPanel := GetActivePanel; + PanelActivate (MainPanel); + TextBackground (Blue); + ClrScr; + p := WindowList; + if p <> nil then + repeat + with p^ do + begin + PanelActivate (FramePanel); + GetWindow (x1, y1, x2, y2); { updated automatically by CRT } + xs := x2 - x1 + 1; + ys := y2 - y1 + 1 + end; + DrawWindow (p); + p := p^.Next + until p = WindowList; + PanelActivate (LastPanel) + end; + + procedure CheckScreenSize; + var + LastPanel: TPanel; + MinScreenSizeX, MinScreenSizeY, i: Integer; + SSize: TPoint; + begin + LastPanel := GetActivePanel; + PanelActivate (MainPanel); + HideCursor; + MinScreenSizeX := MenuXSize; + MinScreenSizeY := MenuYSize; + for i := Low (WindowTypes) to High (WindowTypes) do + with WindowTypes[i] do + begin + MinScreenSizeX := Max (MinScreenSizeX, MinSizeX + 2); + MinScreenSizeY := Max (MinScreenSizeY, MinSizeY + 2) + end; + SSize := ScreenSize; + Window (1, 1, SSize.x, SSize.y); + if (SSize.x < MinScreenSizeX) or (SSize.y < MinScreenSizeY) then + begin + NormVideo; + ClrScr; + RestoreTerminal (True); + WriteLn (StdErr, 'Sorry, your screen is too small for this demo (', SSize.x, 'x', SSize.y, ').'); + WriteLn (StdErr, 'You need at least ', MinScreenSizeX, 'x', MinScreenSizeY, ' characters.'); + Halt (2) + end; + PanelActivate (LastPanel); + RedrawAll + end; + + procedure Die; attribute (noreturn); + begin + NoSound; + RestoreTerminalClearCRT; + WriteLn (StdErr, 'You''re trying to kill me. Since I have break checking turned off,'); + WriteLn (StdErr, 'I''m not dying, but I''ll do you a favour and terminate now.'); + Halt (3) + end; + + function GetKey (TimeOut: Integer) = Key: TKey; + var + NeedSelect, SelectValue: Integer; + SimulateBlockCursorCurrent: TSimulateBlockCursorKind; + SelectInput: array [1 .. 1] of PAnyFile = (@Input); + NextSelectTime: MicroSecondTimeType = 0; attribute (static); + TimeOutTime: MicroSecondTimeType; + LastPanel: TPanel; + p: PWindowList; + begin + LastPanel := GetActivePanel; + if TimeOut < 0 then + TimeOutTime := High (TimeOutTime) + else + TimeOutTime := GetMicroSecondTime + TimeOut; + NeedSelect := 0; + if TimeOut >= 0 then + Inc (NeedSelect); + SimulateBlockCursorCurrent := SimulateBlockCursorKind; + if SimulateBlockCursorCurrent <> bc_None then + Inc (NeedSelect); + p := WindowList; + repeat + if @WindowTypes[p^.WindowType].PeriodicalProc <> nil then + Inc (NeedSelect); + p := p^.Next + until p = WindowList; + p := WindowList; + repeat + with p^, WindowTypes[WindowType] do + if RedrawAlways then + begin + PanelActivate (Panel); + ClrScr; + DrawProc + end; + p := p^.Next + until p = WindowList; + if NeedSelect <> 0 then + repeat + CRTUpdate; + SelectValue := IOSelectRead (SelectInput, Max (0, Min (NextSelectTime, TimeOutTime) - GetMicroSecondTime)); + if SelectValue = 0 then + begin + case SimulateBlockCursorCurrent of + bc_None : ; + bc_Blink : SimulateBlockCursor; + bc_Static: begin + SimulateBlockCursor; + SimulateBlockCursorCurrent := bc_None; + Dec (NeedSelect) + end + end; + NextSelectTime := GetMicroSecondTime + 120000; + p := WindowList; + repeat + with p^, WindowTypes[WindowType] do + if @PeriodicalProc <> nil then + begin + PanelActivate (Panel); + PeriodicalProc + end; + p := p^.Next + until p = WindowList + end; + until (NeedSelect = 0) or (SelectValue <> 0) or ((TimeOut >= 0) and (GetMicroSecondTime >= TimeOutTime)); + if NeedSelect = 0 then + SelectValue := 1; + if SelectValue = 0 then + Key := 0 + else + Key := ReadKeyWord; + if SimulateBlockCursorKind <> bc_None then + SimulateBlockCursorOff; + if IsDeadlySignal (Key) then Die; + if Key = kbScreenSizeChanged then CheckScreenSize; + PanelActivate (LastPanel) + end; + + function Menu = n: Integer; + var + i, ax, ay: Integer; + Key: TKey; + Done: Boolean; + SSize: TPoint; + begin + n := 1; + repeat + SSize := ScreenSize; + ax := (SSize.x - MenuXSize) div 2 + 1; + ay := (SSize.y - MenuYSize) div 2 + 1; + PanelNew (ax, ay, ax + MenuXSize - 1, ay + MenuYSize - 1, False); + SetControlChars (True); + TextColor (Blue); + TextBackground (LightGray); + FrameWin (' Select Window ', DoubleFrame, True); + IgnoreCursor; + PanelNew (ax + 1, ay + 1, ax + MenuXSize - 2, ay + MenuYSize - 2, False); + ClrScr; + TextColor (Black); + SetScroll (False); + Done := False; + repeat + for i := 1 to MenuMax do + begin + GotoXY (1, i); + if i = n then + TextBackground (Green) + else + TextBackground (LightGray); + ClrEOL; + Write (' ', WindowTypes[i].Name); + ChangeTextAttr (2, i, 1, Red + $10 * GetTextBackground) + end; + Key := GetKey (-1); + case LoCaseKey (Key) of + kbUp : if n = 1 then n := MenuMax else Dec (n); + kbDown : if n = MenuMax then n := 1 else Inc (n); + kbHome, + kbPgUp, + kbCtrlPgUp, + kbCtrlHome : n := 1; + kbEnd, + kbPgDn, + kbCtrlPgDn, + kbCtrlEnd : n := MenuMax; + kbCR : Done := True; + kbEsc, kbAltEsc : begin + n := -1; + Done := True + end; + Ord ('a') .. Ord ('z'): begin + i := MenuMax; + while (i > 0) and (LoCase (Key2Char (Key)) <> LoCase (WindowTypes[i].Name[1])) do Dec (i); + if i > 0 then + begin + n := i; + Done := True + end + end; + end + until Done or (Key = kbScreenSizeChanged); + ClosePopUpWindow + until Key <> kbScreenSizeChanged + end; + + procedure NewWindow (WindowType, ax, ay: Integer); + var + p, LastWindow: PWindowList; + MaxX1, MaxY1: Integer; + SSize: TPoint; + begin + New (p); + if WindowList = nil then + begin + p^.Prev := p; + p^.Next := p + end + else + begin + p^.Prev := WindowList; + p^.Next := WindowList^.Next; + p^.Prev^.Next := p; + p^.Next^.Prev := p; + end; + p^.WindowType := WindowType; + with p^, WindowTypes[WindowType] do + begin + SSize := ScreenSize; + if PrefSizeX > 0 then xs := PrefSizeX else xs := MinSizeX; + if PrefSizeY > 0 then ys := PrefSizeY else ys := MinSizeY; + xs := Min (xs + 2, SSize.x); + ys := Min (ys + 2, SSize.y); + MaxX1 := SSize.x - xs + 1; + MaxY1 := SSize.y - ys + 1; + if ax = 0 then x1 := Random (MaxX1) + 1 else x1 := Min (ax, MaxX1); + if ay = 0 then y1 := Random (MaxY1) + 1 else y1 := Min (ay, MaxY1); + if (ax = 0) and (PrefSizeX < 0) then Inc (xs, Random (SSize.x - x1 - xs + 2)); + if (ax = 0) and (PrefSizeY < 0) then Inc (ys, Random (SSize.y - y1 - ys + 2)); + State := ws_None; + PanelNew (1, 1, 1, 1, False); + FramePanel := GetActivePanel; + SetControlChars (True); + TextColor (Color); + TextBackground (Background); + PanelNew (1, 1, 1, 1, False); + SetPCCharSet (False); + Panel := GetActivePanel; + end; + LastWindow := WindowList; + WindowList := p; + if LastWindow <> nil then RedrawFrame (LastWindow); + DrawWindow (p) + end; + + procedure OpenWindow; + var WindowType: Integer; + begin + WindowType := Menu; + if WindowType >= 0 then NewWindow (WindowType, 0, 0) + end; + + procedure NextWindow; + var LastWindow: PWindowList; + begin + LastWindow := WindowList; + WindowList := WindowList^.Next; + PanelTop (WindowList^.FramePanel); + PanelTop (WindowList^.Panel); + RedrawFrame (LastWindow); + RedrawFrame (WindowList) + end; + + procedure PreviousWindow; + var LastWindow: PWindowList; + begin + PanelMoveAbove (WindowList^.Panel, MainPanel); + PanelMoveAbove (WindowList^.FramePanel, MainPanel); + LastWindow := WindowList; + WindowList := WindowList^.Prev; + RedrawFrame (LastWindow); + RedrawFrame (WindowList) + end; + + procedure CloseWindow; + var p: PWindowList; + begin + if WindowList^.WindowType <> 0 then + begin + p := WindowList; + NextWindow; + PanelDelete (p^.FramePanel); + PanelDelete (p^.Panel); + p^.Next^.Prev := p^.Prev; + p^.Prev^.Next := p^.Next; + Dispose (p) + end + end; + + procedure MoveWindow; + var + Done, Changed: Boolean; + SSize: TPoint; + begin + with WindowList^ do + begin + Done := False; + Changed := True; + State := ws_Moving; + repeat + if Changed then DrawWindow (WindowList); + Changed := True; + case LoCaseKey (GetKey (-1)) of + Ord ('s'), kbLeft : if x1 > 1 then Dec (x1); + Ord ('d'), kbRight : if x1 + xs - 1 < ScreenSize.x then Inc (x1); + Ord ('e'), kbUp : if y1 > 1 then Dec (y1); + Ord ('x'), kbDown : if y1 + ys - 1 < ScreenSize.y then Inc (y1); + Ord ('a'), kbHome : x1 := 1; + Ord ('f'), kbEnd : x1 := ScreenSize.x - xs + 1; + Ord ('r'), kbPgUp : y1 := 1; + Ord ('c'), kbPgDn : y1 := ScreenSize.y - ys + 1; + Ord ('y'), kbCtrlPgUp: begin + x1 := 1; + y1 := 1 + end; + Ord ('b'), kbCtrlPgDn: begin + SSize := ScreenSize; + x1 := SSize.x - xs + 1; + y1 := SSize.y - ys + 1 + end; + kbCR, + kbEsc, kbAltEsc : Done := True; + else Changed := False + end + until Done; + State := ws_None; + DrawWindow (WindowList) + end + end; + + procedure ResizeWindow; + var + Done, Changed: Boolean; + SSize: TPoint; + begin + with WindowList^, WindowTypes[WindowType] do + begin + Done := False; + Changed := True; + State := ws_Resizing; + repeat + if Changed then DrawWindow (WindowList); + Changed := True; + case LoCaseKey (GetKey (-1)) of + Ord ('s'), kbLeft : if xs > MinSizeX + 2 then Dec (xs); + Ord ('d'), kbRight : if x1 + xs - 1 < ScreenSize.x then Inc (xs); + Ord ('e'), kbUp : if ys > MinSizeY + 2 then Dec (ys); + Ord ('x'), kbDown : if y1 + ys - 1 < ScreenSize.y then Inc (ys); + Ord ('a'), kbHome : xs := MinSizeX + 2; + Ord ('f'), kbEnd : xs := ScreenSize.x - x1 + 1; + Ord ('r'), kbPgUp : ys := MinSizeY + 2; + Ord ('c'), kbPgDn : ys := ScreenSize.y - y1 + 1; + Ord ('y'), kbCtrlPgUp: begin + xs := MinSizeX + 2; + ys := MinSizeY + 2 + end; + Ord ('b'), kbCtrlPgDn: begin + SSize := ScreenSize; + xs := SSize.x - x1 + 1; + ys := SSize.y - y1 + 1 + end; + kbCR, + kbEsc, kbAltEsc : Done := True; + else Changed := False + end + until Done; + State := ws_None; + DrawWindow (WindowList) + end + end; + + procedure ActivateCursor; + begin + with WindowList^, WindowTypes[WindowType] do + begin + PanelActivate (Panel); + if WantCursor then + SetCursorShape (CursorShape) + else + HideCursor + end; + SetScroll (ScrollState) + end; + +var + Key: TKey; + ScreenShot, Done: Boolean; + +begin + ScreenShot := ParamStr (1) = '--screenshot'; + if ParamCount <> Ord (ScreenShot) then + begin + RestoreTerminal (True); + WriteLn (StdErr, ParamStr (0), ': invalid argument `', ParamStr (Ord (ScreenShot) + 1), ''''); + Halt (1) + end; + CRTSavePreviousScreen (True); + SetCRTUpdate (UpdateInput); + MainPanel := GetActivePanel; + CheckScreenSize; + OrigScreenSize := ScreenSize; + if ScreenShot then + begin + CursorShape := CursorBlock; + NewWindow (6, 1, 1); + NewWindow (2, 1, MaxInt); + NewWindow (8, MaxInt, 1); + NewWindow (5, 1, 27); + KeyDemoKey (Ord ('f')); + KeyDemoKey (246); + KeyDemoKey (kbDown); + NewWindow (3, MaxInt, 13); + NewWindow (4, MaxInt, 31); + NewWindow (7, MaxInt, MaxInt); + NewWindow (9, MaxInt, 33); + NewWindow (0, 1, 2); + NewWindow (1, 1, 14); + ActivateCursor; + OpenWindow + end + else + NewWindow (0, 3, 2); + Done := False; + repeat + ActivateCursor; + Key := GetKey (-1); + case LoCaseKey (Key) of + Ord ('3'), kbF3 : OpenWindow; + Ord ('4'), kbF4 : CloseWindow; + Ord ('5'), kbF5 : PreviousWindow; + Ord ('6'), kbF6 : NextWindow; + Ord ('7'), kbF7 : MoveWindow; + Ord ('8'), kbF8 : ResizeWindow; + Ord ('q'), kbEsc, + kbAltEsc: Done := True; + else + if WindowList <> nil then + with WindowList^, WindowTypes[WindowType] do + if @KeyProc <> nil then + begin + TextColor (Color); + TextBackground (Background); + KeyProc (Key) + end + end + until Done +end. ------------------------------------------------------------ revno: 106672 committer: martin rudalics branch nick: trunk timestamp: Tue 2011-12-13 14:58:20 +0100 message: Fix doc-string typo. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-12-13 13:53:00 +0000 +++ src/ChangeLog 2011-12-13 13:58:20 +0000 @@ -5,6 +5,7 @@ doc-strings. (Vrecenter_redisplay): Add first sentence of doc-string on separate line. + (Frecenter): Fix doc-string typo. 2011-12-11 Kenichi Handa === modified file 'src/window.c' --- src/window.c 2011-12-13 13:53:00 +0000 +++ src/window.c 2011-12-13 13:58:20 +0000 @@ -4995,7 +4995,7 @@ also erase the entire frame and redraw it (when `auto-resize-tool-bars' is set to `grow-only', this resets the tool-bar's height to the minimum height needed); if `recenter-redisplay' has the special value `tty', -then only tty frame are redrawn. +then only tty frames are redrawn. Just C-u as prefix means put point in the center of the window and redisplay normally--don't erase and redraw the frame. */) ------------------------------------------------------------ revno: 106671 committer: martin rudalics branch nick: trunk timestamp: Tue 2011-12-13 14:53:00 +0100 message: Fix doc-string of recenter-redisplay. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-12-13 13:37:48 +0000 +++ src/ChangeLog 2011-12-13 13:53:00 +0000 @@ -3,6 +3,8 @@ * window.c (Vwindow_combination_resize) (Vwindow_combination_limit): Use t instead of non-nil in doc-strings. + (Vrecenter_redisplay): Add first sentence of doc-string on + separate line. 2011-12-11 Kenichi Handa === modified file 'src/window.c' --- src/window.c 2011-12-13 13:37:48 +0000 +++ src/window.c 2011-12-13 13:53:00 +0000 @@ -6500,9 +6500,10 @@ Vwindow_configuration_change_hook = Qnil; DEFVAR_LISP ("recenter-redisplay", Vrecenter_redisplay, - doc: /* If non-nil, then the `recenter' command with a nil argument -will redraw the entire frame; the special value `tty' causes the -frame to be redrawn only if it is a tty frame. */); + doc: /* Non-nil means `recenter' redraws entire frame. +If this option is non-nil, then the `recenter' command with a nil +argument will redraw the entire frame; the special value `tty' causes +the frame to be redrawn only if it is a tty frame. */); Vrecenter_redisplay = Qtty; DEFVAR_LISP ("window-combination-resize", Vwindow_combination_resize, ------------------------------------------------------------ revno: 106670 committer: martin rudalics branch nick: trunk timestamp: Tue 2011-12-13 14:37:48 +0100 message: Minor fixes in window handling code and docs. * window.c (Vwindow_combination_resize) (Vwindow_combination_limit): Use t instead of non-nil in doc-strings. * window.el (delete-other-windows): Use correct frame in call to window-with-parameter. * windows.texi (Splitting Windows): Use t instead of non-nil when describing window-combination-resize. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2011-12-12 05:32:49 +0000 +++ doc/lispref/ChangeLog 2011-12-13 13:37:48 +0000 @@ -1,3 +1,8 @@ +2011-12-13 Martin Rudalics + + * windows.texi (Splitting Windows): Use t instead of non-nil + when describing window-combination-resize. + 2011-12-05 Stefan Monnier * text.texi (Special Properties): Warn against `intangible' properties === modified file 'doc/lispref/windows.texi' --- doc/lispref/windows.texi 2011-11-25 14:24:05 +0000 +++ doc/lispref/windows.texi 2011-12-13 13:37:48 +0000 @@ -793,20 +793,20 @@ @defopt window-combination-resize If this variable is @code{nil}, @code{split-window} can only split a -window (denoted by @var{window}) if @var{window}'s screen area is -large enough to accommodate both itself and the new window. This is -the default. - -If this variable is non-@code{nil}, @code{split-window} tries to -resize all windows that are part of the same combination as -@var{window}, in order to accommodate the new window. In particular, -this may allow @code{split-window} to succeed even if @var{window} is -a fixed-size window or too small to ordinarily split. Furthermore, -subsequently resizing or deleting @var{window} may resize all other -windows in its combination. - -This variable has no effect if @code{window-combination-limit} is -non-@code{nil} (see below). +window (denoted by @var{window}) if @var{window}'s screen area is large +enough to accommodate both itself and the new window. + +If this variable is @code{t}, @code{split-window} tries to resize all +windows that are part of the same combination as @var{window}, in order +to accommodate the new window. In particular, this may allow +@code{split-window} to succeed even if @var{window} is a fixed-size +window or too small to ordinarily split. Furthermore, subsequently +resizing or deleting @var{window} may resize all other windows in its +combination. + +The default is @code{nil}. Other values are reserved for future use. +The value of this variable is ignored when +@code{window-combination-limit} is non-@code{nil} (see below). @end defopt To illustrate the effect of @code{window-combination-resize}, @@ -857,9 +857,9 @@ @end smallexample @noindent -If @code{window-combination-resize} is non-@code{nil}, splitting -@code{W3} instead leaves all three live windows with approximately the -same height: +If @code{window-combination-resize} is @code{t}, splitting @code{W3} +instead leaves all three live windows with approximately the same +height: @smallexample @group === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-12-12 21:23:42 +0000 +++ lisp/ChangeLog 2011-12-13 13:37:48 +0000 @@ -1,3 +1,8 @@ +2011-12-13 Martin Rudalics + + * window.el (delete-other-windows): Use correct frame in call to + window-with-parameter. + 2011-12-12 Daniel Pfeiffer * progmodes/make-mode.el: Bring it up to date with makepp V2.0. === modified file 'lisp/window.el' --- lisp/window.el 2011-12-11 10:38:11 +0000 +++ lisp/window.el 2011-12-13 13:37:48 +0000 @@ -2455,7 +2455,7 @@ (throw 'done (delete-other-windows atom-root))) ((eq window-side 'none) ;; Set side-main to the major non-side window. - (setq side-main (window-with-parameter 'window-side 'none nil t))) + (setq side-main (window-with-parameter 'window-side 'none frame t))) ((memq window-side window-sides) (error "Cannot make side window the only window"))) ;; If WINDOW is the main non-side window, do nothing. === modified file 'src/ChangeLog' --- src/ChangeLog 2011-12-11 12:08:51 +0000 +++ src/ChangeLog 2011-12-13 13:37:48 +0000 @@ -1,3 +1,9 @@ +2011-12-13 Martin Rudalics + + * window.c (Vwindow_combination_resize) + (Vwindow_combination_limit): Use t instead of non-nil in + doc-strings. + 2011-12-11 Kenichi Handa * coding.c (Funencodable_char_position): Pay attention to the === modified file 'src/window.c' --- src/window.c 2011-12-04 08:02:42 +0000 +++ src/window.c 2011-12-13 13:37:48 +0000 @@ -6506,22 +6506,24 @@ Vrecenter_redisplay = Qtty; DEFVAR_LISP ("window-combination-resize", Vwindow_combination_resize, - doc: /* Non-nil means resize window combinations proportionally. + doc: /* If t, resize window combinations proportionally. If this variable is nil, splitting a window gets the entire screen space for displaying the new window from the window to split. Deleting and resizing a window preferably resizes one adjacent window only. -If this variable is non-nil, splitting a window tries to get the space +If this variable is t, splitting a window tries to get the space proportionally from all windows in the same combination. This also allows to split a window that is otherwise too small or of fixed size. Resizing and deleting a window proportionally resize all windows in the same combination. +Other values are reserved for future use. + This variable takes no effect if `window-combination-limit' is non-nil. */); Vwindow_combination_resize = Qnil; DEFVAR_LISP ("window-combination-limit", Vwindow_combination_limit, - doc: /* Non-nil means splitting a window makes a new parent window. + doc: /* If t, splitting a window makes a new parent window. If this variable is nil, splitting a window will create a new parent window only if the window has no parent window or the window shall become a combination orthogonal to the one it is part of. ------------------------------------------------------------ revno: 106669 author: Daniel Pfeiffer committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-12-12 16:23:42 -0500 message: * lisp/progmodes/make-mode.el: Bring it up to date with makepp V2.0. (makefile-make-font-lock-keywords): Extend meaning of `keywords'. (makefile-gmake-statements, makefile-makepp-statements): Use it and add new makepp keywords. (makefile-makepp-font-lock-keywords): Add new patterns. (makefile-match-function-end): Match new [...] and [[...]]. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-12-11 17:08:11 +0000 +++ lisp/ChangeLog 2011-12-12 21:23:42 +0000 @@ -1,3 +1,12 @@ +2011-12-12 Daniel Pfeiffer + + * progmodes/make-mode.el: Bring it up to date with makepp V2.0. + (makefile-make-font-lock-keywords): Extend meaning of `keywords'. + (makefile-gmake-statements, makefile-makepp-statements): + Use it and add new makepp keywords. + (makefile-makepp-font-lock-keywords): Add new patterns. + (makefile-match-function-end): Match new [...] and [[...]]. + 2011-12-11 Juanma Barranquero * ses.el (ses-call-printer-return, ses-cell-property-get) === modified file 'lisp/progmodes/make-mode.el' --- lisp/progmodes/make-mode.el 2011-11-26 08:26:37 +0000 +++ lisp/progmodes/make-mode.el 2011-12-12 21:23:42 +0000 @@ -315,25 +315,32 @@ "List of keywords understood by automake.") (defconst makefile-gmake-statements - `("-sinclude" "sinclude" "vpath" ; makefile-makepp-statements takes rest + `("-sinclude" "sinclude" ; makefile-makepp-statements takes rest "ifdef" "ifndef" "ifeq" "ifneq" "-include" "define" "endef" "export" - "override define" "override" "unexport" + "override define" "override" "unexport" "vpath" ,@(cdr makefile-automake-statements)) "List of keywords understood by gmake.") -;; These are even more silly, because you can have more spaces in between. (defconst makefile-makepp-statements - `("and ifdef" "and ifndef" "and ifeq" "and ifneq" "and ifperl" - "and ifmakeperl" "and ifsys" "and ifnsys" "build_cache" "build_check" + `(t ; - alternately means _ + ;; todo: take if* out of these lists, and let the negation regexp do it all + "ifperl" "ifmakeperl" "ifsys" "ifnsys" "iftrue" "ifntrue" + "and ifdef" "and ifndef" "and ifeq" "and ifneq" "and ifperl" + "and ifmakeperl" "and ifsys" "and ifnsys" "and iftrue" "and ifntrue" "else ifdef" "else ifndef" "else ifeq" "else ifneq" "else ifperl" - "else ifmakeperl" "else ifsys" "else ifnsys" "enddef" "global" - "load_makefile" "ifperl" "ifmakeperl" "ifsys" "ifnsys" "_include" - "makeperl" "makesub" "no_implicit_load" "perl" "perl-begin" "perl_begin" - "perl-end" "perl_end" "prebuild" "or ifdef" "or ifndef" "or ifeq" - "or ifneq" "or ifperl" "or ifmakeperl" "or ifsys" "or ifnsys" - "override export" "override global" "register_command_parser" - "register_scanner" "repository" "runtime" "signature" "sub" - ,@(nthcdr 3 makefile-gmake-statements)) + "else ifmakeperl" "else ifsys" "else ifnsys" "else iftrue" "else ifntrue" + "or ifdef" "or ifndef" "or ifeq" "or ifneq" "or ifperl" + "or ifmakeperl" "or ifsys" "or ifnsys" "or iftrue" "or ifntrue" + + "autoload" "build-cache" "build-check" "enddef" "export define" + "global" "global build-cache" "global build-check" "global define" + "global signature" "global override signature" "load-makefile" + "make" "makeperl" "makesub" "no-implicit-load" "perl" "perl-begin" + "perl-end" "prebuild" "override export" "override global" "register-parser" + "register-command-parser" "register-input-suffix" + "register-scanner" "repository" "runtime" "signature" "sub" + + ,@(nthcdr 2 makefile-gmake-statements)) "List of keywords understood by gmake.") (defconst makefile-bsdmake-statements @@ -372,7 +379,12 @@ ;; Fontify conditionals and includes. (,(concat "^\\(?: [ \t]*\\)?" - (regexp-opt keywords t) + (replace-regexp-in-string + " " "[ \t]+" + (if (eq (car keywords) t) + (replace-regexp-in-string "-" "[_-]" + (regexp-opt (cdr keywords) t)) + (regexp-opt keywords t))) "\\>[ \t]*\\([^: \t\n#]*\\)") (1 font-lock-keyword-face) (2 font-lock-variable-name-face)) @@ -436,7 +448,7 @@ makefile-var-use-regex makefile-makepp-statements nil - "^\\(?: [ \t]*\\)?\\(?:and[ \t]+\\|else[ \t]+\\|or[ \t]+\\)?if\\(n\\)\\(?:def\\|eq\\|sys\\)\\>" + "^\\(?: [ \t]*\\)?\\(?:and[ \t]+\\|else[ \t]+\\|or[ \t]+\\)?if\\(n\\)\\(?:def\\|eq\\|sys\\|true\\)\\>" '("[^$]\\(\\$[({]\\(?:output\\|stem\\|target\\)s?\\_>.*?[})]\\)" 1 'makefile-targets append) @@ -447,17 +459,17 @@ (2 font-lock-keyword-face t) (3 font-lock-variable-name-face t)) - ;; $(function ...) $((function ...)) ${function ...} ${{function ...}} - '("[^$]\\$\\(?:((?\\|{{?\\)\\([-a-zA-Z0-9_.]+\\s \\)" + ;; $(function ...) $((function ...)) ${...} ${{...}} $[...] $[[...]] + '("[^$]\\$\\(?:((?\\|{{?\\|\\[\\[?\\)\\([-a-zA-Z0-9_.]+\\s \\)" 1 font-lock-function-name-face prepend) - ;; $(shell ...) $((shell ...)) ${shell ...} ${{shell ...}} - '("[^$]\\$\\(((?\\|{{?\\)shell\\(?:[-_]\\(?:global[-_]\\)?once\\)?[ \t]+" + ;; $(shell ...) $((shell ...)) ${...} ${{...}} $[...] $[[...]] + '("[^$]\\$\\(((?\\|{{?\\|\\[\\[?\\)shell\\(?:[-_]\\(?:global[-_]\\)?once\\)?[ \t]+" makefile-match-function-end nil nil (1 'makefile-shell prepend t)) - ;; $(perl ...) $((perl ...)) ${perl ...} ${{perl ...}} - '("[^$]\\$\\(((?\\|{{?\\)makeperl[ \t]+" + ;; $(perl ...) $((perl ...)) ${...} ${{...}} $[...] $[[...]] + '("[^$]\\$\\(((?\\|{{?\\|\\[\\[?\\)makeperl[ \t]+" makefile-match-function-end nil nil (1 'makefile-makepp-perl prepend t)) '("[^$]\\$\\(((?\\|{{?\\)perl[ \t]+" @@ -1688,8 +1700,10 @@ ;; FIXME forward-sexp or somesuch would be better? (if (setq s (cond ((string= s "(") ")") ((string= s "{") "}") + ((string= s "[") "]") ((string= s "((") "))") - ((string= s "{{") "}}"))) + ((string= s "{{") "}}") + ((string= s "[[") "]]"))) (re-search-forward (concat "\\(.*\\)[ \t]*" s) (line-end-position) t)))) (defun makefile-match-dependency (bound)