|
|
1.1 ! root 1: % Copyright Barbara Liskov 1985 ! 2: ! 3: x_flush = proc () ! 4: x_buf$flush() ! 5: end x_flush ! 6: ! 7: x_feep = proc (volume: int) ! 8: or: oreq, er: ereq := x_buf$get() ! 9: er.code := x_feep_ ! 10: er.s0 := volume ! 11: end x_feep ! 12: ! 13: x_store_cut = proc (buf: int, s: string) ! 14: or: oreq, er: ereq := x_buf$get() ! 15: er.code := x_storebytes + (buf * 2**8) ! 16: er.s0 := string$size(s) ! 17: x_buf$send_data(s2b(s), 1, string$size(s)) ! 18: end x_store_cut ! 19: ! 20: x_fetch_cut = proc (buf: int) returns (string) signals (error(string)) ! 21: or: oreq, er: ereq := x_buf$get() ! 22: er.code := x_fetchbytes + (buf * 2**8) ! 23: x_buf$receive() ! 24: resignal error ! 25: b: _bytevec := _bytevec$create(x_buf$get_sp0()) ! 26: x_buf$receive_data(b) ! 27: return(b2s(b)) ! 28: end x_fetch_cut ! 29: ! 30: x_rotate_cuts = proc (buf: int) ! 31: or: oreq, er: ereq := x_buf$get() ! 32: er.code := x_rotatecuts + (buf * 2**8) ! 33: end x_rotate_cuts ! 34: ! 35: x_mouse_control = proc (accel, thresh: int) ! 36: or: oreq, er: ereq := x_buf$get() ! 37: er.code := x_mousecontrol ! 38: er.s0 := accel ! 39: or.s1 := thresh ! 40: end x_mouse_control ! 41: ! 42: x_feep_control = proc (volume: int) ! 43: or: oreq, er: ereq := x_buf$get() ! 44: er.code := x_feepcontrol ! 45: er.s0 := volume ! 46: end x_feep_control ! 47: ! 48: x_shift_lock = proc (toggle: bool) ! 49: or: oreq, er: ereq := x_buf$get() ! 50: if toggle ! 51: then er.code := x_shiftlock + (LockToggleMode * 2**8) ! 52: else er.code := x_shiftlock + (LockUpDownMode * 2**8) ! 53: end ! 54: end x_shift_lock ! 55: ! 56: x_key_click = proc (volume: int) ! 57: or: oreq, er: ereq := x_buf$get() ! 58: er.code := x_keyclick + (volume * 2**8) ! 59: end x_key_click ! 60: ! 61: x_auto_repeat = proc (on: bool) ! 62: or: oreq, er: ereq := x_buf$get() ! 63: if on ! 64: then er.code := x_autorepeat + 2**8 ! 65: else er.code := x_autorepeat ! 66: end ! 67: end x_auto_repeat ! 68: ! 69: x_screen_saver = proc (video: bool, timeout, shift: int) ! 70: or: oreq, er: ereq := x_buf$get() ! 71: if video ! 72: then er.code := x_screensaver + 2**8 ! 73: else er.code := x_screensaver ! 74: end ! 75: er.s0 := timeout ! 76: or.s1 := shift ! 77: end x_screen_saver ! 78: ! 79: x_default = proc (prog, option: string) returns (string) signals (not_found) ! 80: as = array[string] ! 81: own init: bool := false ! 82: own lines: as ! 83: if ~init ! 84: then lines := as$new() ! 85: buf: _bytevec := _bytevec$create(128) ! 86: init := true ! 87: c: _chan := _chan$open(file_name$parse("~/.Xdefaults"), "read", 0) ! 88: s: string ! 89: l: int := 1 ! 90: h: int := 0 ! 91: while true do ! 92: s, l, h := _chan$get(c, buf, l, h, "\n", false) ! 93: if l <= h ! 94: then l := l + 1 end ! 95: if ~string$empty(s) cand s[1] ~= '#' ! 96: then as$addl(lines, s) end ! 97: end except when end_of_file, not_possible (*): end ! 98: _chan$close(c) ! 99: end except when not_possible (*): end ! 100: match1: int := string$size(prog) + 1 ! 101: for s: string in as$elements(lines) do ! 102: i: int := 1 ! 103: if s[1] ~= '.' ! 104: then if string$size(s) <= match1 cor ! 105: string$indexs(prog, s) ~= 1 cor s[match1] ~= '.' ! 106: then continue end ! 107: i := match1 ! 108: end ! 109: i := i + 1 ! 110: j: int := _bytevec$indexc(':', s2b(s), i) ! 111: if j = 0 cor j - i ~= string$size(option) cor ! 112: _bytevec$nc_indexv(s2b(option), s2b(s), i) ~= i ! 113: then continue end ! 114: k: int := j + 1 ! 115: while s[k] = ' ' cor s[k] = '\t' do ! 116: k := k + 1 ! 117: end except when bounds: continue end ! 118: return(string$rest(s, k)) ! 119: end ! 120: signal not_found ! 121: end x_default ! 122: ! 123: x_parse_color = proc (spec: string) returns (int, int, int) ! 124: signals (bad_format, undefined) ! 125: zero = char$c2i('0') ! 126: upper = char$c2i('A') - 10 ! 127: lower = char$c2i('a') - 10 ! 128: if string$empty(spec) ! 129: then signal bad_format ! 130: elseif spec[1] ~= '#' ! 131: then r, g, b, dr, dg, db: int := x_display$lookup_color(spec) ! 132: except when error (*): signal undefined end ! 133: return(r, g, b) ! 134: elseif ~(string$size(spec) = 4 cor string$size(spec) = 7 cor ! 135: string$size(spec) = 10 cor string$size(spec) = 13) ! 136: then signal bad_format end ! 137: n: int := string$size(spec) / 3 ! 138: r: int := 0 ! 139: g: int := 0 ! 140: b: int := 0 ! 141: for i: int in int$from_to_by(2, string$size(spec), n) do ! 142: r := g ! 143: g := b ! 144: b := 0 ! 145: for j: int in int$from_to(i, i + n - 1) do ! 146: c: char := spec[j] ! 147: if c >= '0' cand c <= '9' ! 148: then b := b * 16 + (char$c2i(c) - zero) ! 149: elseif c >= 'A' cand c <= 'F' ! 150: then b := b * 16 + (char$c2i(c) - upper) ! 151: elseif c >= 'a' cand c <= 'f' ! 152: then b := b * 16 + (char$c2i(c) - lower) ! 153: else signal bad_format end ! 154: end ! 155: end ! 156: n := 2 ** (16 - 4 * n) ! 157: return(r * n, g * n, b * n) ! 158: end x_parse_color
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.