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