PageRenderTime 46ms CodeModel.GetById 21ms RepoModel.GetById 0ms app.codeStats 0ms

/elisp/omake/omake-error.el

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