Skip to content

Commit 5b91179

Browse files
committed
Merge pull request #672 from gracjan/pr-throw-catch
Switch from signal to throw/catch in haskell-indentation
2 parents 489bf2d + 9c6b575 commit 5b91179

File tree

1 file changed

+53
-68
lines changed

1 file changed

+53
-68
lines changed

haskell-indentation.el

+53-68
Original file line numberDiff line numberDiff line change
@@ -148,20 +148,10 @@ clashing with other modes."
148148
(interactive)
149149
(haskell-indentation-mode t))
150150

151-
(put 'parse-error
152-
'error-conditions
153-
'(error parse-error))
154-
(put 'parse-error 'error-message "Parse error")
155-
156-
(defun parse-error (&rest args)
157-
(signal 'parse-error (apply 'format args)))
158-
159-
(defmacro on-parse-error (except &rest body)
160-
`(condition-case parse-error-string
161-
(progn ,@body)
162-
(parse-error
163-
,except
164-
(message "%s" (cdr parse-error-string)))))
151+
(defun haskell-indentation-parse-error (&rest args)
152+
(let ((msg (apply 'format args)))
153+
(message "%s" msg)
154+
(throw 'parse-error msg)))
165155

166156
(defvar haskell-literate)
167157
(defun haskell-indentation-birdp ()
@@ -244,15 +234,11 @@ Handles bird style literate haskell too."
244234
(if (haskell-indentation-bird-outside-codep)
245235
(haskell-indentation-delete-horizontal-space-and-newline)
246236
;; - just jump to the next line if parse-error
247-
(on-parse-error
237+
(catch 'parse-error
248238
(haskell-indentation-delete-horizontal-space-and-newline)
249239
(let* ((cc (current-column))
250240
(ci (haskell-indentation-current-indentation))
251241
(indentations (haskell-indentation-find-indentations-safe)))
252-
;; - jump to the next line and reindent to at the least same level
253-
;; if parsing was OK
254-
(skip-syntax-forward "-")
255-
(haskell-indentation-delete-horizontal-space-and-newline)
256242
(when (haskell-indentation-birdp) (insert "> "))
257243
(haskell-indentation-reindent-to
258244
(haskell-indentation-next-indentation (- ci 1) indentations 'nofail)
@@ -414,52 +400,51 @@ the current buffer."
414400
(if (and (memq major-mode '(haskell-mode literate-haskell-mode))
415401
(memq 'haskell-indentation-mode minor-mode-list)
416402
haskell-indentation-dyn-show-indentations)
417-
(save-excursion
418-
(let* ((columns (progn
419-
(end-of-line)
420-
(current-column)))
421-
(ci (haskell-indentation-current-indentation))
422-
(allinds (save-excursion
423-
(move-to-column ci); XXX: remove when haskell-indentation-find-indentations is fixed
424-
;; don't freak out on parse-error
425-
(condition-case e
426-
(haskell-indentation-find-indentations-safe)
427-
(parse-error nil))))
428-
;; indentations that are easy to show
429-
(inds (cl-remove-if (lambda (i) (>= i columns)) allinds))
430-
;; tricky indentations, that are after the current EOL
431-
(overinds (cl-member-if (lambda (i) (>= i columns)) allinds))
432-
;; +1: leave space for an extra overlay to show overinds
433-
(overlays (haskell-indentation-init-overlays (+ 1 (length inds)))))
434-
(while inds
435-
(move-to-column (car inds))
436-
(overlay-put (car overlays) 'face 'haskell-indentation-show-normal-face)
437-
(overlay-put (car overlays) 'after-string nil)
438-
(move-overlay (car overlays) (point) (+ 1 (point)))
439-
(setq inds (cdr inds))
440-
(setq overlays (cdr overlays)))
441-
(when (and overinds
442-
haskell-indentation-show-indentations-after-eol)
443-
(let ((o (car overlays))
444-
(s (make-string (+ 1 (- (car (last overinds)) columns)) ? )))
445-
;; needed for the cursor to be in the good position, see:
446-
;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2013-03/msg00079.html
447-
(put-text-property 0 1 'cursor t s)
448-
;; color the whole line ending overlay with hl-line face if needed
449-
(when (or hl-line-mode global-hl-line-mode)
450-
(put-text-property 0 (length s) 'face 'hl-line s))
451-
;; put in the underlines at the correct positions
452-
(dolist (i overinds)
453-
(put-text-property
454-
(- i columns) (+ 1 (- i columns))
455-
'face (if (or hl-line-mode global-hl-line-mode)
456-
'haskell-indentation-show-hl-line-face
457-
'haskell-indentation-show-normal-face)
458-
s))
459-
(overlay-put o 'face nil)
460-
(overlay-put o 'after-string s)
461-
(end-of-line)
462-
(move-overlay o (point) (point))))))))
403+
(catch 'parse-error
404+
(save-excursion
405+
(let* ((columns (progn
406+
(end-of-line)
407+
(current-column)))
408+
(ci (haskell-indentation-current-indentation))
409+
(allinds (save-excursion
410+
(move-to-column ci); XXX: remove when haskell-indentation-find-indentations is fixed
411+
;; don't freak out on parse-error
412+
(haskell-indentation-find-indentations-safe)))
413+
;; indentations that are easy to show
414+
(inds (cl-remove-if (lambda (i) (>= i columns)) allinds))
415+
;; tricky indentations, that are after the current EOL
416+
(overinds (cl-member-if (lambda (i) (>= i columns)) allinds))
417+
;; +1: leave space for an extra overlay to show overinds
418+
(overlays (haskell-indentation-init-overlays (+ 1 (length inds)))))
419+
(while inds
420+
(move-to-column (car inds))
421+
(overlay-put (car overlays) 'face 'haskell-indentation-show-normal-face)
422+
(overlay-put (car overlays) 'after-string nil)
423+
(move-overlay (car overlays) (point) (+ 1 (point)))
424+
(setq inds (cdr inds))
425+
(setq overlays (cdr overlays)))
426+
(when (and overinds
427+
haskell-indentation-show-indentations-after-eol)
428+
(let ((o (car overlays))
429+
(s (make-string (+ 1 (- (car (last overinds)) columns)) ? )))
430+
;; needed for the cursor to be in the good position, see:
431+
;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2013-03/msg00079.html
432+
(put-text-property 0 1 'cursor t s)
433+
;; color the whole line ending overlay with hl-line face if needed
434+
(when (or hl-line-mode global-hl-line-mode)
435+
(put-text-property 0 (length s) 'face 'hl-line s))
436+
;; put in the underlines at the correct positions
437+
(dolist (i overinds)
438+
(put-text-property
439+
(- i columns) (+ 1 (- i columns))
440+
'face (if (or hl-line-mode global-hl-line-mode)
441+
'haskell-indentation-show-hl-line-face
442+
'haskell-indentation-show-normal-face)
443+
s))
444+
(overlay-put o 'face nil)
445+
(overlay-put o 'after-string s)
446+
(end-of-line)
447+
(move-overlay o (point) (point)))))))))
463448

464449
(defun haskell-indentation-enable-show-indentations ()
465450
"Enable showing of indentation points in the current buffer."
@@ -566,7 +551,7 @@ the current buffer."
566551
(catch 'parse-end
567552
(haskell-indentation-toplevel)
568553
(unless (eq current-token 'end-tokens)
569-
(parse-error "Illegal token: %s" current-token)))
554+
(haskell-indentation-parse-error "Illegal token: %s" current-token)))
570555
possible-indentations))))
571556

572557
(defun haskell-indentation-first-indentation ()
@@ -815,7 +800,7 @@ the current buffer."
815800
(when end (throw 'parse-end nil))) ;; add no more indentations if we expect a closing keyword
816801
((equal current-token end)
817802
(haskell-indentation-read-next-token)) ;; continue
818-
(end (parse-error "Illegal token: %s" current-token))))))
803+
(end (haskell-indentation-parse-error "Illegal token: %s" current-token))))))
819804

820805
(defun haskell-indentation-case-alternative ()
821806
(setq left-indent (current-column))
@@ -1083,7 +1068,7 @@ the current buffer."
10831068
(haskell-indentation-phrase-rest (cddr phrase))))
10841069

10851070
((string= (cadr phrase) "in")) ;; fallthrough
1086-
(t (parse-error "Expecting %s" (cadr phrase))))))
1071+
(t (haskell-indentation-parse-error "Expecting %s" (cadr phrase))))))
10871072

10881073
(defun haskell-indentation-add-indentation (indent)
10891074
(haskell-indentation-push-indentation

0 commit comments

Comments
 (0)