Skip to content

Switch from signal to throw/catch in haskell-indentation #672

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Jun 1, 2015
Merged

Switch from signal to throw/catch in haskell-indentation #672

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
121 changes: 53 additions & 68 deletions haskell-indentation.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -148,20 +148,10 @@ clashing with other modes."
(interactive)
(haskell-indentation-mode t))

(put 'parse-error
'error-conditions
'(error parse-error))
(put 'parse-error 'error-message "Parse error")

(defun parse-error (&rest args)
(signal 'parse-error (apply 'format args)))

(defmacro on-parse-error (except &rest body)
`(condition-case parse-error-string
(progn ,@body)
(parse-error
,except
(message "%s" (cdr parse-error-string)))))
(defun haskell-indentation-parse-error (&rest args)
(let ((msg (apply 'format args)))
(message "%s" msg)
(throw 'parse-error msg)))

(defvar haskell-literate)
(defun haskell-indentation-birdp ()
Expand Down Expand Up @@ -244,15 +234,11 @@ Handles bird style literate haskell too."
(if (haskell-indentation-bird-outside-codep)
(haskell-indentation-delete-horizontal-space-and-newline)
;; - just jump to the next line if parse-error
(on-parse-error
(catch 'parse-error
(haskell-indentation-delete-horizontal-space-and-newline)
(let* ((cc (current-column))
(ci (haskell-indentation-current-indentation))
(indentations (haskell-indentation-find-indentations-safe)))
;; - jump to the next line and reindent to at the least same level
;; if parsing was OK
(skip-syntax-forward "-")
(haskell-indentation-delete-horizontal-space-and-newline)
(when (haskell-indentation-birdp) (insert "> "))
(haskell-indentation-reindent-to
(haskell-indentation-next-indentation (- ci 1) indentations 'nofail)
Expand Down Expand Up @@ -414,52 +400,51 @@ the current buffer."
(if (and (memq major-mode '(haskell-mode literate-haskell-mode))
(memq 'haskell-indentation-mode minor-mode-list)
haskell-indentation-dyn-show-indentations)
(save-excursion
(let* ((columns (progn
(end-of-line)
(current-column)))
(ci (haskell-indentation-current-indentation))
(allinds (save-excursion
(move-to-column ci); XXX: remove when haskell-indentation-find-indentations is fixed
;; don't freak out on parse-error
(condition-case e
(haskell-indentation-find-indentations-safe)
(parse-error nil))))
;; indentations that are easy to show
(inds (cl-remove-if (lambda (i) (>= i columns)) allinds))
;; tricky indentations, that are after the current EOL
(overinds (cl-member-if (lambda (i) (>= i columns)) allinds))
;; +1: leave space for an extra overlay to show overinds
(overlays (haskell-indentation-init-overlays (+ 1 (length inds)))))
(while inds
(move-to-column (car inds))
(overlay-put (car overlays) 'face 'haskell-indentation-show-normal-face)
(overlay-put (car overlays) 'after-string nil)
(move-overlay (car overlays) (point) (+ 1 (point)))
(setq inds (cdr inds))
(setq overlays (cdr overlays)))
(when (and overinds
haskell-indentation-show-indentations-after-eol)
(let ((o (car overlays))
(s (make-string (+ 1 (- (car (last overinds)) columns)) ? )))
;; needed for the cursor to be in the good position, see:
;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2013-03/msg00079.html
(put-text-property 0 1 'cursor t s)
;; color the whole line ending overlay with hl-line face if needed
(when (or hl-line-mode global-hl-line-mode)
(put-text-property 0 (length s) 'face 'hl-line s))
;; put in the underlines at the correct positions
(dolist (i overinds)
(put-text-property
(- i columns) (+ 1 (- i columns))
'face (if (or hl-line-mode global-hl-line-mode)
'haskell-indentation-show-hl-line-face
'haskell-indentation-show-normal-face)
s))
(overlay-put o 'face nil)
(overlay-put o 'after-string s)
(end-of-line)
(move-overlay o (point) (point))))))))
(catch 'parse-error
(save-excursion
(let* ((columns (progn
(end-of-line)
(current-column)))
(ci (haskell-indentation-current-indentation))
(allinds (save-excursion
(move-to-column ci); XXX: remove when haskell-indentation-find-indentations is fixed
;; don't freak out on parse-error
(haskell-indentation-find-indentations-safe)))
;; indentations that are easy to show
(inds (cl-remove-if (lambda (i) (>= i columns)) allinds))
;; tricky indentations, that are after the current EOL
(overinds (cl-member-if (lambda (i) (>= i columns)) allinds))
;; +1: leave space for an extra overlay to show overinds
(overlays (haskell-indentation-init-overlays (+ 1 (length inds)))))
(while inds
(move-to-column (car inds))
(overlay-put (car overlays) 'face 'haskell-indentation-show-normal-face)
(overlay-put (car overlays) 'after-string nil)
(move-overlay (car overlays) (point) (+ 1 (point)))
(setq inds (cdr inds))
(setq overlays (cdr overlays)))
(when (and overinds
haskell-indentation-show-indentations-after-eol)
(let ((o (car overlays))
(s (make-string (+ 1 (- (car (last overinds)) columns)) ? )))
;; needed for the cursor to be in the good position, see:
;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2013-03/msg00079.html
(put-text-property 0 1 'cursor t s)
;; color the whole line ending overlay with hl-line face if needed
(when (or hl-line-mode global-hl-line-mode)
(put-text-property 0 (length s) 'face 'hl-line s))
;; put in the underlines at the correct positions
(dolist (i overinds)
(put-text-property
(- i columns) (+ 1 (- i columns))
'face (if (or hl-line-mode global-hl-line-mode)
'haskell-indentation-show-hl-line-face
'haskell-indentation-show-normal-face)
s))
(overlay-put o 'face nil)
(overlay-put o 'after-string s)
(end-of-line)
(move-overlay o (point) (point)))))))))

(defun haskell-indentation-enable-show-indentations ()
"Enable showing of indentation points in the current buffer."
Expand Down Expand Up @@ -566,7 +551,7 @@ the current buffer."
(catch 'parse-end
(haskell-indentation-toplevel)
(unless (eq current-token 'end-tokens)
(parse-error "Illegal token: %s" current-token)))
(haskell-indentation-parse-error "Illegal token: %s" current-token)))
possible-indentations))))

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

(defun haskell-indentation-case-alternative ()
(setq left-indent (current-column))
Expand Down Expand Up @@ -1083,7 +1068,7 @@ the current buffer."
(haskell-indentation-phrase-rest (cddr phrase))))

((string= (cadr phrase) "in")) ;; fallthrough
(t (parse-error "Expecting %s" (cadr phrase))))))
(t (haskell-indentation-parse-error "Expecting %s" (cadr phrase))))))

(defun haskell-indentation-add-indentation (indent)
(haskell-indentation-push-indentation
Expand Down