/usr/share/sawfish/site-lisp/merlin/util.jl is in sawfish-merlin-ugliness 1.3.1-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 | ;; merlin/util.jl -- some utilities
;; version 0.7.3
;; Copyright (C) 2000-2001 merlin <merlin@merlin.org>
;; http://merlin.org/sawfish/
;; this 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; either version 2, or (at your option)
;; any later version.
;; this 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 sawfish; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure merlin.util
(export
fontify
colorify
wm-initialized
percent
assqd
split
index-of
rplac
cons-op
op-cons
cons+ cons- cons* cons% cons/ cons< cons> cons<= cons>= cons= cons%/ cons/%
cons-percent cons-quotient cons-min cons-max cons-and cons-or
and-cons or-cons +cons
trim
gravitate
screen-dimensions
viewport-offset
ceil)
(open
rep
rep.regexp
rep.system
sawfish.wm.colors
sawfish.wm.fonts
sawfish.wm.misc
sawfish.wm.windows)
;; string/font -> font
(define (fontify font)
(if (stringp font) (get-font font) font))
;; string/color -> color
(define (colorify color)
(if (stringp color) (get-color color) color))
(define after-initialization nil)
(add-hook 'after-initialization-hook
(lambda () (setq after-initialization t)))
;; is the window manager initialized yet
(define (wm-initialized) ;; a hack
(or after-initialization (managed-windows)))
;; b % of a
(define (percent a b)
(quotient (* a b) 100))
;; assq with default
(define (assqd key alist default)
(if (assq key alist)
(assq key alist)
(cons key default)))
;; split of "" is ("")
(define (split string separator)
(let
((n (length string))
(m (length separator))
(point 0)
out end)
(while (<= point n)
(setq end (if (string-match separator string point)
(match-start)
(length string)))
(setq out (cons (substring string point end) out))
(setq point (+ m end)))
(nreverse out)))
;; the index of item in list or -1
(define (index-of item list)
(let loop ((rest list) (i 0))
(cond
((null rest) -1)
((eq (car rest) item) i)
(t (loop (cdr rest) (1+ i))))))
;; replace car and cdr
(define (rplac a b)
(rplaca a (car b))
(rplacd a (cdr b)))
;; op of cons cells and values
(define (cons-op op a . rest)
(let
((cars (mapcar (lambda (x) (if (consp x) (car x) x)) (list* a rest)))
(cdrs (mapcar (lambda (x) (if (consp x) (cdr x) x)) (list* a rest))))
(cons (apply (or (car op) op) cars) (apply (or (cdr op) op) cdrs))))
;; op of car and cdr
(define (op-cons op a)
(op (car a) (cdr a)))
(defmacro defcons-ops ops
(append `(progn) (apply append (mapcar (lambda (op)
(let*
((name (or (car op) op))
(func (or (cdr op) op))
(alpha (alpha-char-p (aref (symbol-name name) 0)))
(consop (intern (format nil (if alpha "cons-%s" "cons%s") name)))
(opcons (intern (format nil (if alpha "%s-cons" "%scons") name))))
`((define (,consop a . rest) (apply cons-op ,func a rest))
(define (,opcons a) (op-cons ,func a))))) ops))))
(define (myand . args) (let loop ((a args))
(if (or (null (cdr a)) (not (car a))) (car a) (loop (cdr a)))))
(define (myor . args) (let loop ((a args))
(if (or (null (cdr a)) (car a)) (car a) (loop (cdr a)))))
(defcons-ops + - * % / < > <= >= = percent quotient min max
(and . myand) (or . myor) (%/ . (cons % quotient)) (/% . (cons quotient %)))
;; trim text in specified font to specified width, appending ...
(define (trim text font width)
(if (<= (text-width text font) width)
text
(let loop ((s (concat text "...")) (n (length text)))
(if (or (= 0 n) (<= (text-width s font) width))
s
(aset s (1- n) 46)
(loop (substring s 0 (+ 2 n)) (1- n))))))
;; return position of object of specified dimensions gravitated around speified point
(define (gravitate pos dim gravity)
(cons (cond ((memq gravity '(north center south)) (- (car pos) (quotient (car dim) 2)))
((memq gravity '(north-west west south-west)) (- (car pos) (car dim)))
(t (car pos)))
(cond ((memq gravity '(west center east)) (- (cdr pos) (quotient (cdr dim) 2)))
((memq gravity '(north-west north north-west)) (- (cdr pos) (cdr dim)))
(t (cdr pos)))))
;; screen dimensions
(define (screen-dimensions)
(cons (screen-width) (screen-height)))
;; viewport offset
(define (viewport-offset)
(cons viewport-x-offset viewport-y-offset))
;; ceiling quotient
(define (ceil a b)
(quotient (+ a (1- b)) b)))
|