PageRenderTime 16ms CodeModel.GetById 8ms app.highlight 5ms RepoModel.GetById 1ms app.codeStats 0ms

/elisp/omake/omake-error.el

https://bitbucket.org/yminsky/js-elisp
Lisp | 172 lines | 114 code | 24 blank | 34 comment | 0 complexity | d021a46979d2ee65c08a84f4d9de7fa2 MD5 | raw file
  1;; -*- lexical-binding: t -*-
  2
  3;;----------------------------------------------------------------------------;;
  4;; OCaml errors                                                               ;;
  5;;----------------------------------------------------------------------------;;
  6
  7;; The representation of an ocaml or omake error message.
  8;; Notes:
  9;; - We use the hash value computed by ocaml in hash-table operations
 10;;   for efficiency.  Note also that the full string representation of
 11;;   an error is delayed.
 12;; - The `string' and `full-string' representations of an error are
 13;;   not created until they are called.  They are then cached to avoid
 14;;   recomputation.
 15
 16(require 'cl)
 17(require 'ert)
 18(require 'core)
 19(require 'omake-id)
 20
 21(defstruct
 22  (Omake.Error
 23   (:predicate Omake.Error.is)
 24   (:conc-name Omake.Error.)
 25   (:constructor nil)
 26   (:constructor Omake.Error.make
 27                 (&key
 28                  hash
 29                  id
 30                  relpath
 31                  fullpath
 32                  file
 33                  line
 34                  char-beg
 35                  char-end
 36                  text
 37                  full-text
 38                  &aux
 39                  (_ (assert (stringp id)))
 40                  (id (Omake.Id.of-path id))
 41                  (_ (assert (Omake.Id.is id)))
 42                  (_ (assert (stringp relpath)))
 43                  (_ (assert (stringp fullpath)))
 44                  (_ (assert (stringp file)))
 45                  (_ (assert (integerp line)))
 46                  (_ (assert (integerp char-beg)))
 47                  (_ (assert (integerp char-end)))
 48                  (_ (assert (stringp text)))
 49                  (_ (assert (stringp full-text)))
 50                  (full-text-visible-p nil)
 51                  (string nil)
 52                  (full-string nil))))
 53  (hash            nil :read-only t)
 54  (id              nil :read-only t)
 55  (relpath         nil :read-only t)
 56  (fullpath        nil :read-only t)
 57  (file            nil :read-only t)
 58  (line            nil :read-only t)
 59  (char-beg        nil :read-only t)
 60  (char-end        nil :read-only t)
 61  (text            nil :read-only t)
 62  (full-text       nil :read-only t)
 63  full-text-visible-p
 64  string
 65  full-string)
 66
 67;;----------------------------------------------------------------------------;;
 68;; Hashing                                                                    ;;
 69;;----------------------------------------------------------------------------;;
 70
 71(defun Omake.Error.same-error (e1 e2)
 72  (equal (Omake.Error.hash e1) (Omake.Error.hash e2)))
 73
 74(define-hash-table-test
 75  'Omake.Error.hash-test 'Omake.Error.same-error 'Omake.Error.hash)
 76
 77;;----------------------------------------------------------------------------;;
 78;; Misc                                                                       ;;
 79;;----------------------------------------------------------------------------;;
 80
 81(defun* Omake.Error.to-status-buffer-string (e &key full-text)
 82  (let* ((text (if full-text
 83                   (Omake.Error.full-text e)
 84                 (Omake.Error.text e)))
 85         (relpath (Omake.Error.relpath e))
 86         ;; don't let relpath be too long
 87         ;; CR seanmcl: What should this be?  100 is essentially ignoring it.
 88         (relpath-max-len 100)
 89         (relpath (String.elipses relpath relpath-max-len :truncate-left t)))
 90    (replace-regexp-in-string "File \"" (format "File \"%s/" relpath) text)))
 91
 92(defun* Omake.Error.to-string (e &optional &key is-current)
 93  (assert (Omake.Error.is e))
 94  (let ((error-face (if is-current
 95                        'Omake.Face.error-current
 96                      'Omake.Face.error-pending))
 97        (str (if (Omake.Error.full-text-visible-p e)
 98                  (Omake.Error.full-string e)
 99                (Omake.Error.string e))))
100    (propertize str 'face error-face)))
101
102(defun Omake.Error.mem (e es)
103  (List.exists (lambda (e1) (Omake.Error.same-error e e1)) es))
104
105(defun Omake.Error.toggle-full-text (e)
106  (let ((b (Omake.Error.full-text-visible-p e)))
107    (setf (Omake.Error.full-text-visible-p e) (not b))))
108
109(defun Omake.Error.contract (e)
110  (setf (Omake.Error.full-text-visible-p e) nil))
111
112(defun Omake.Error.expand (e)
113  (setf (Omake.Error.full-text-visible-p e) t))
114
115;;----------------------------------------------------------------------------;;
116;; Sets of errors                                                             ;;
117;;----------------------------------------------------------------------------;;
118
119(defun Omake.Error.make-hash-set (l)
120  (let ((table (make-hash-table :test 'Omake.Error.hash-test)))
121    (List.iter (lambda (e) (puthash e t table)) l)
122    table))
123
124(defstruct
125  (Omake.Error.Set
126   (:predicate Omake.Error.Set.is)
127   (:conc-name Omake.Error.Set.)
128   (:constructor nil)
129   (:constructor
130    Omake.Error.Set.of-list
131    (l &aux (set (Omake.Error.make-hash-set l)))))
132  (set nil :read-only t))
133
134(defun Omake.Error.Set.mem (e s)
135  (assert (Omake.Error.Set.is s))
136  (assert (Omake.Error.is e) t)
137  (gethash e (Omake.Error.Set.set s)))
138
139;;----------------------------------------------------------------------------;;
140;; Global error table                                                         ;;
141;;----------------------------------------------------------------------------;;
142
143;; CR smclaughlin: There's a memory leak here, as the cache is never cleared.
144(with-no-warnings
145  (defconst Omake.Error.table (make-hash-table :test 'Omake.Error.hash-test)))
146;; (hash-table-size Omake.Error.table)
147
148;;----------------------------------------------------------------------------;;
149;; Unit tests                                                                 ;;
150;;----------------------------------------------------------------------------;;
151
152(defun Omake.Error.test-error (&optional text file)
153  "Create an error with a directory that exists and has an OMakeroot.
154Used in various unit tests."
155  (let* ((text (if text text "generic-error"))
156         (file (if file file "test.ml")))
157    (Omake.Error.make
158     :hash (sxhash text)
159     :id "./test/1"
160     :relpath (concat "./test/1" file)
161     :fullpath (concat default-directory "test/1/" file)
162     :file file
163     :line 1
164     :char-beg 1 :char-end 2
165     :text text
166     :full-text text)))
167
168;;----------------------------------------------------------------------------;;
169;; End                                                                        ;;
170;;----------------------------------------------------------------------------;;
171
172(provide 'omake-error)