/elisp/omake/omake-error.el
Emacs Lisp | 172 lines | 114 code | 24 blank | 34 comment | 0 complexity | d021a46979d2ee65c08a84f4d9de7fa2 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.1, AGPL-3.0, Apache-2.0, GPL-3.0, LGPL-2.0
- ;; -*- lexical-binding: t -*-
- ;;----------------------------------------------------------------------------;;
- ;; OCaml errors ;;
- ;;----------------------------------------------------------------------------;;
- ;; The representation of an ocaml or omake error message.
- ;; Notes:
- ;; - We use the hash value computed by ocaml in hash-table operations
- ;; for efficiency. Note also that the full string representation of
- ;; an error is delayed.
- ;; - The `string' and `full-string' representations of an error are
- ;; not created until they are called. They are then cached to avoid
- ;; recomputation.
- (require 'cl)
- (require 'ert)
- (require 'core)
- (require 'omake-id)
- (defstruct
- (Omake.Error
- (:predicate Omake.Error.is)
- (:conc-name Omake.Error.)
- (:constructor nil)
- (:constructor Omake.Error.make
- (&key
- hash
- id
- relpath
- fullpath
- file
- line
- char-beg
- char-end
- text
- full-text
- &aux
- (_ (assert (stringp id)))
- (id (Omake.Id.of-path id))
- (_ (assert (Omake.Id.is id)))
- (_ (assert (stringp relpath)))
- (_ (assert (stringp fullpath)))
- (_ (assert (stringp file)))
- (_ (assert (integerp line)))
- (_ (assert (integerp char-beg)))
- (_ (assert (integerp char-end)))
- (_ (assert (stringp text)))
- (_ (assert (stringp full-text)))
- (full-text-visible-p nil)
- (string nil)
- (full-string nil))))
- (hash nil :read-only t)
- (id nil :read-only t)
- (relpath nil :read-only t)
- (fullpath nil :read-only t)
- (file nil :read-only t)
- (line nil :read-only t)
- (char-beg nil :read-only t)
- (char-end nil :read-only t)
- (text nil :read-only t)
- (full-text nil :read-only t)
- full-text-visible-p
- string
- full-string)
- ;;----------------------------------------------------------------------------;;
- ;; Hashing ;;
- ;;----------------------------------------------------------------------------;;
- (defun Omake.Error.same-error (e1 e2)
- (equal (Omake.Error.hash e1) (Omake.Error.hash e2)))
- (define-hash-table-test
- 'Omake.Error.hash-test 'Omake.Error.same-error 'Omake.Error.hash)
- ;;----------------------------------------------------------------------------;;
- ;; Misc ;;
- ;;----------------------------------------------------------------------------;;
- (defun* Omake.Error.to-status-buffer-string (e &key full-text)
- (let* ((text (if full-text
- (Omake.Error.full-text e)
- (Omake.Error.text e)))
- (relpath (Omake.Error.relpath e))
- ;; don't let relpath be too long
- ;; CR seanmcl: What should this be? 100 is essentially ignoring it.
- (relpath-max-len 100)
- (relpath (String.elipses relpath relpath-max-len :truncate-left t)))
- (replace-regexp-in-string "File \"" (format "File \"%s/" relpath) text)))
- (defun* Omake.Error.to-string (e &optional &key is-current)
- (assert (Omake.Error.is e))
- (let ((error-face (if is-current
- 'Omake.Face.error-current
- 'Omake.Face.error-pending))
- (str (if (Omake.Error.full-text-visible-p e)
- (Omake.Error.full-string e)
- (Omake.Error.string e))))
- (propertize str 'face error-face)))
- (defun Omake.Error.mem (e es)
- (List.exists (lambda (e1) (Omake.Error.same-error e e1)) es))
- (defun Omake.Error.toggle-full-text (e)
- (let ((b (Omake.Error.full-text-visible-p e)))
- (setf (Omake.Error.full-text-visible-p e) (not b))))
- (defun Omake.Error.contract (e)
- (setf (Omake.Error.full-text-visible-p e) nil))
- (defun Omake.Error.expand (e)
- (setf (Omake.Error.full-text-visible-p e) t))
- ;;----------------------------------------------------------------------------;;
- ;; Sets of errors ;;
- ;;----------------------------------------------------------------------------;;
- (defun Omake.Error.make-hash-set (l)
- (let ((table (make-hash-table :test 'Omake.Error.hash-test)))
- (List.iter (lambda (e) (puthash e t table)) l)
- table))
- (defstruct
- (Omake.Error.Set
- (:predicate Omake.Error.Set.is)
- (:conc-name Omake.Error.Set.)
- (:constructor nil)
- (:constructor
- Omake.Error.Set.of-list
- (l &aux (set (Omake.Error.make-hash-set l)))))
- (set nil :read-only t))
- (defun Omake.Error.Set.mem (e s)
- (assert (Omake.Error.Set.is s))
- (assert (Omake.Error.is e) t)
- (gethash e (Omake.Error.Set.set s)))
- ;;----------------------------------------------------------------------------;;
- ;; Global error table ;;
- ;;----------------------------------------------------------------------------;;
- ;; CR smclaughlin: There's a memory leak here, as the cache is never cleared.
- (with-no-warnings
- (defconst Omake.Error.table (make-hash-table :test 'Omake.Error.hash-test)))
- ;; (hash-table-size Omake.Error.table)
- ;;----------------------------------------------------------------------------;;
- ;; Unit tests ;;
- ;;----------------------------------------------------------------------------;;
- (defun Omake.Error.test-error (&optional text file)
- "Create an error with a directory that exists and has an OMakeroot.
- Used in various unit tests."
- (let* ((text (if text text "generic-error"))
- (file (if file file "test.ml")))
- (Omake.Error.make
- :hash (sxhash text)
- :id "./test/1"
- :relpath (concat "./test/1" file)
- :fullpath (concat default-directory "test/1/" file)
- :file file
- :line 1
- :char-beg 1 :char-end 2
- :text text
- :full-text text)))
- ;;----------------------------------------------------------------------------;;
- ;; End ;;
- ;;----------------------------------------------------------------------------;;
- (provide 'omake-error)