Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | ;; Copyright (C) 2007 Vesa Karvonen |
2 | ;; | |
3 | ;; MLton is released under a BSD-style license. | |
4 | ;; See the file MLton-LICENSE for details. | |
5 | ||
6 | (require 'cl) | |
7 | (require 'compat) | |
8 | ||
9 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
10 | ;; Utils | |
11 | ||
12 | (defun bg-build-cons-once (entry list) | |
13 | (cons entry (remove* entry list :test (function equal)))) | |
14 | ||
15 | (defun bg-build-flatmap (fn list) | |
16 | (apply (function append) (mapcar fn list))) | |
17 | ||
18 | (defun bg-build-remove-from-assoc (alist key) | |
19 | (remove* | |
20 | nil alist | |
21 | :test (function | |
22 | (lambda (_ key-value) | |
23 | (equal key (car key-value)))))) | |
24 | ||
25 | (defun bg-build-replace-in-assoc (alist key value) | |
26 | (cons (cons key value) | |
27 | (bg-build-remove-from-assoc alist key))) | |
28 | ||
29 | (defun bg-build-assoc-cdr (key alist) | |
30 | "Same as (cdr (assoc key alist)) except that doesn't attempt to call cdr | |
31 | on nil." | |
32 | (let ((key-value (assoc key alist))) | |
33 | (when key-value | |
34 | (cdr key-value)))) | |
35 | ||
36 | (defun bg-build-const (value) | |
37 | "Returns a function that returns the given value." | |
38 | (lexical-let ((value value)) | |
39 | (lambda (&rest _) | |
40 | value))) | |
41 | ||
42 | (defun bg-build-kill-current-buffer () | |
43 | "Kills the current buffer." | |
44 | (interactive) | |
45 | (kill-buffer (current-buffer))) | |
46 | ||
47 | (defun bg-build-make-hash-table () | |
48 | "Makes a hash table with `equal' semantics." | |
49 | (make-hash-table :test 'equal :size 1)) | |
50 | ||
51 | (defun bg-build-point-at-current-line () | |
52 | "Returns point at the beginning of the current line." | |
53 | (save-excursion | |
54 | (beginning-of-line) | |
55 | (point))) | |
56 | ||
57 | (defun bg-build-current-line () | |
58 | "Returns the current line number counting from 1." | |
59 | (+ 1 (count-lines 1 (bg-build-point-at-current-line)))) | |
60 | ||
61 | (defun bg-build-time-to-double (time) | |
62 | "Converts a time to a double." | |
63 | (+ (* (car time) 65536.0) | |
64 | (cadr time) | |
65 | (if (cddr time) (* (caddr time) 1e-06) 0))) | |
66 | ||
67 | (defun bg-build-attr-newer? (attr1 attr2) | |
68 | "Returns non-nil iff the modification time of `attr1' is later than the | |
69 | modification time of `attr2'. Note that this also returns nil when either | |
70 | one of the modification times is nil." | |
71 | (and attr1 attr2 | |
72 | (> (bg-build-time-to-double (nth 5 attr1)) | |
73 | (bg-build-time-to-double (nth 5 attr2))))) | |
74 | ||
75 | (defun bg-build-pos-to-point (pos) | |
76 | "Returns the value of point in the current buffer at the position given | |
77 | as a (line . col) pair." | |
78 | (save-excursion | |
79 | (goto-line (car pos)) | |
80 | (+ (point) (cdr pos)))) | |
81 | ||
82 | (defun bg-build-point-to-pos (point) | |
83 | "Returns the position as a (line . col) pair corresponding to the | |
84 | specified point in the current buffer." | |
85 | (save-excursion | |
86 | (goto-char point) | |
87 | (beginning-of-line) | |
88 | (let ((line (+ (count-lines 1 (point)) 1)) | |
89 | (col (- point (point)))) | |
90 | (cons line col)))) | |
91 | ||
92 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
93 | ||
94 | (provide 'bg-build-util) |