"SfR Fresh" - the SfR Freeware/Shareware Archive 
Member "vil96w32/shifts.rc" of archive vile-w32.zip:
As a special service "SfR Fresh" has tried to format the requested source page into HTML format using source code syntax highlighting with prefixed line numbers.
Alternatively you can here view or download the uninterpreted source code file.
That can be also achieved for any archive member file by clicking within an archive contents listing on the first character of the file(path) respectively on the according byte size field.
1 ; $Id: shifts.rc,v 1.4 2000/05/19 09:54:12 tom Exp $
2 ; These macros are reimplementations for vile of scripts which I wrote for
3 ; xedit in 1981-1983. Editing with xedit or ispf on IBM 3270 terminals has the
4 ; odd quirk that when you put the terminal into insert-mode, it is possible
5 ; (easy) to shift characters off the end of the line and lose them. So I wrote
6 ; macros to make it simple to shift text left or right.
7 ;
8 ; The IBM terminals did not use tabs; these macros detab/entab the line.
9
10 ; Shifts the current line left or right so the first nonblank character aligns
11 ; with the cursor. Unlike ShiftRite and ShiftLeft, does not squeeze out blanks.
12 store-procedure AlignToCol int="Column"
13 ~local $curcol $curline
14 ~local %col %row %original %detabbed %entabbed %replacer %n %n1
15 setv %col=$1
16 ~if &greater $cmd-count 1
17 setv %n &subtract $cmd-count 1
18 ~hidden %n next-line
19 ~endif
20 setv %row $curline
21 ; read the original line contents, for reference
22 setv $curcol 1
23 setv %original $line
24 ; convert the tabs in the line to spaces
25 setv $curline=%row $curcol=%col
26 detab-lines-til
27 ; ...and read its contents
28 setv $curcol 1
29 setv %detabbed $line
30 ; restore the contents of the line
31 ~if ¬ &seq %detabbed %original
32 undo-changes-backward
33 ~endif
34 ; See if there are nonblanks to the left or right of the cursor
35 ~if &sequal &trim %detabbed ''
36 write-message "Line is empty"
37 ~else
38 setv %n 1
39 setv %n1 $1
40 ~while ¬ &greater %n &length %detabbed
41 ~if ¬ &sequal &middle %detabbed %n 1 ' '
42 setv %n1 %n
43 ~break
44 ~endif
45 setv %n &add %n 1
46 ~endwhile
47 ~if &equal %n1 $1
48 write-message "No change"
49 ~else
50 ~if &greater %n1 $1
51 setv %n1 &add %n1 1
52 setv %replacer &right %detabbed &subtract %n1 $1
53 ~else
54 setv %replacer %detabbed
55 ~while ¬ &equal %n1 $1
56 setv %replacer &cat ' ' %replacer
57 setv %n1 &add %n1 1
58 ~endwhile
59 ~endif
60 setv $line %replacer
61 ; if the original line had tabs, entab the line.
62 ; juggle a little to make this a single-undo
63 ~if ¬ &seq %detabbed %original
64 entab-lines-til
65 setv $curcol 1
66 setv %entabbed $line
67 ~if ¬ &seq %entabbed %replacer
68 undo-changes-backward
69 undo-changes-backward
70 setv $line %entabbed
71 ~endif
72 ~endif
73 ~endif
74 ~endif
75 ~endm
76
77 ; Shifts the current line left or right so the first nonblank character aligns
78 ; with the cursor. Unlike ShiftRite and ShiftLeft, does not squeeze out blanks.
79 store-procedure AlignToCursor
80 AlignToCol $curcol
81 ~endm
82 bind-key AlignToCursor #0
83
84 ; Drags the word beginning to the left of the cursor to the cursor's column.
85 ; Compresses extra blanks between that word and the following ones on the
86 ; current line.
87 ;
88 ; FIXME: If the line is then longer than the fillcolumn, split the line
89 ; accordingly.
90 store-procedure ShiftRite
91 ~local $curcol $curline
92 ~local %row %col
93 ~local %detabbed %diff %entabbed %n %n1 %n2
94 ~local %original %pad %replacer %s1 %s2
95 setv %col $curcol
96 setv %row $curline
97 ; read the original line contents, for reference
98 setv $curcol 1
99 setv %original $line
100 ; convert the tabs in the line to spaces
101 setv $curline=%row $curcol=%col
102 detab-lines-til
103 ; ...and read its contents
104 setv $curcol 1
105 setv %detabbed $line
106 ; restore the contents of the line
107 ~if ¬ &seq %detabbed %original
108 undo-changes-backward
109 ~endif
110 setv %n %col
111 ; if we are on a nonblank, check if the previous character is a
112 ; blank. if so, we'll skip over _those_ blanks.
113 ~if ¬ &seq ' ' &middle %detabbed %n 1
114 setv %n1 &subtract %n 1
115 ~if &and &greater %n1 0 &seq ' ' &middle %detabbed %n1 1
116 setv %n %n1
117 ~endif
118 ~endif
119 ; if not on a non-blank, find one
120 ~while &seq ' ' &middle %detabbed %n 1
121 setv %n &subtract %n 1
122 ~if &less %n 1
123 write-message "No change"
124 ~return
125 ~endif
126 ~endwhile
127 ; find the last blank immediately to the left of the non-blanks
128 ~while &greater %n 0
129 setv %n &subtract %n 1
130 ~if &seq ' ' &middle %detabbed %n 1
131 ~break
132 ~endif
133 ~endwhile
134 ~if &or &equal %n 0 &seq ' ' &middle %detabbed %n 1
135 setv %diff &subtract %col %n
136 ~if &greater %diff 1
137 setv %pad ''
138 ~if &greater %n 0
139 setv %n1 &subtract %n 1
140 ~else
141 setv %n1 %n
142 setv %n &add %n 1
143 ~endif
144 setv %s1 &left %detabbed %n1
145 setv %s2 &right %detabbed %n
146 ~while &greater %diff 1
147 setv %diff &subtract %diff 1
148 setv %pad &cat %pad ' '
149 setv %n2 &sindex %s2 ' '
150 ~if &greater %n2 0
151 setv %s2 &cat \
152 &left %s2 %n2 \
153 &right %s2 &add %n2 2
154 ~endif
155 ~endwhile
156 setv $curline %row
157 setv %replacer &cat %s1 &cat %pad %s2
158 setv $line %replacer
159 ; if the original line had tabs, entab the line.
160 ; juggle a little to make this a single-undo
161 ~if ¬ &seq %detabbed %original
162 entab-lines-til
163 setv $curcol 1
164 setv %entabbed $line
165 ~if ¬ &seq %entabbed %replacer
166 undo-changes-backward
167 undo-changes-backward
168 setv $line %entabbed
169 ~endif
170 ~endif
171 ~return
172 ~endif
173 ~endif
174 write-message "No change"
175 ~endm
176 bind-key ShiftRite #!
177
178 ; Drags the word beginning to the right of the cursor to the cursor's column.
179 ; If needed, compresses extra blanks on the left, but does not split the line.
180 store-procedure ShiftLeft
181 ~local $curcol $curline
182 ~local %col %row
183 ~local %detabbed %diff %entabbed %len %n %n1 %n2 %original %replacer
184 setv %col $curcol
185 setv %row $curline
186 ; read the original line contents, for reference
187 setv $curcol 1
188 setv %original $line
189 ; convert the tabs in the line to spaces
190 setv $curline=%row $curcol=%col
191 detab-lines-til
192 ; ...and read its contents
193 setv $curcol 1
194 setv %detabbed $line
195 ; restore the contents of the line
196 ~if ¬ &seq %detabbed %original
197 undo-changes-backward
198 ~endif
199 setv %len &length %detabbed
200 setv %n %col
201 ; if we're on a nonblank, skip to the end of that.
202 ~while ¬ &seq ' ' &middle %detabbed %n 1
203 setv %n &add %n 1
204 ~if &greater %n %len
205 write-message "No change"
206 ~return
207 ~endif
208 ~endwhile
209 ; skip blanks to the first nonblank
210 ~while &seq ' ' &middle %detabbed %n 1
211 setv %n &add %n 1
212 ~if &greater %n %len
213 write-message "No change"
214 ~return
215 ~endif
216 ~endwhile
217 setv %diff &subtract %n %col
218 ~if &greater %diff 1
219 ; trim blanks to move the word left to the cursor position.
220 ; we prefer to take blanks from the right, between the cursor
221 ; and the word, but will trim blanks from the right end of the
222 ; segment to the left of the cursor.
223 setv %replacer %detabbed
224 ~while ¬ &equal %n %col
225 setv %n1 %n
226 setv %n2 0
227 ~while ¬ &greater %n1 %n
228 ~if &seq ' ' &middle %replacer %n1 2
229 setv %n2 %n1
230 ~break
231 ~endif
232 setv %n1 &add %n1 1
233 ~endwhile
234 ~if &equal %n2 0
235 setv %n1 %n
236 ~while &greater %n1 1
237 ~if &seq ' ' &middle %replacer %n1 2
238 setv %n2 %n1
239 ~break
240 ~endif
241 setv %n1 &subtract %n1 1
242 ~endwhile
243 ~endif
244 ~if &equal %n2 0
245 ~if &and \
246 &equal %n1 1 \
247 &seq ' ' &middle %replacer %n1 1
248 setv %n2 1
249 ~else
250 ~break
251 ~endif
252 ~endif
253 setv %replacer &cat \
254 &left %replacer &subtract %n2 1 \
255 &right %replacer &add %n2 1
256 setv %n &subtract %n 1
257 ~endwhile
258 ~if ¬ &seq %replacer %detabbed
259 setv $line %replacer
260 ; if the original line had tabs, entab the line.
261 ; juggle a little to make this a single-undo
262 ~if ¬ &seq %detabbed %original
263 entab-lines-til
264 setv $curcol 1
265 setv %entabbed $line
266 ~if ¬ &seq %entabbed %replacer
267 undo-changes-backward
268 undo-changes-backward
269 setv $line %entabbed
270 ~endif
271 ~endif
272 ~return
273 ~endif
274 ~endif
275 write-message "No change"
276 ~endm
277 bind-key ShiftLeft #@