branch: externals/a68-mode
commit 3112f430e7b2632abe9cf99fddcca72d144f9790
Author: Jose E. Marchesi <jose.march...@oracle.com>
Commit: Jose E. Marchesi <jose.march...@oracle.com>
Remove pretty-bold-tags mode and auto-stropping mode
---
a68-mode.el | 138 ------------------------------------------------------------
1 file changed, 138 deletions(-)
diff --git a/a68-mode.el b/a68-mode.el
index 971a7d04bf..257073e506 100644
--- a/a68-mode.el
+++ b/a68-mode.el
@@ -536,144 +536,6 @@
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.a68\\'" . a68-mode))
-;;;; Pretty-printing of bold tags (minor mode).
-
-(defface a68-bold-tag-face '((t :inherit font-lock-keyword-face))
- "Face for ALGOL 68 bold tags")
-
-;;;###autoload(defvar a68-pretty-bold-tags-mode nil "Non-nil if A68 pretty
print bold tags mode is enabled.")
-;;;###autoload
-(define-minor-mode a68-pretty-bold-tags-mode
- "Toggle pretty-printing of bold tags in a68-mode."
- :group a68
- (if a68-pretty-bold-tags-mode
- (a68--pretty-print-bold-tags-on)
- (a68--pretty-print-bold-tags-off)))
-
-(defun a68--pretty-print-bold-tags-on ()
- (save-excursion
- (goto-char (point-min))
- (a68--pretty-print-bold-tags (point-min) (point-max))
- (add-hook 'after-change-functions #'a68--after-change-function nil t)))
-
-(defun a68--pretty-print-bold-tags-off ()
- (remove-hook 'after-change-functions #'a68--after-change-function t)
- (save-excursion
- (goto-char (point-min))
- (let (match)
- (while (not (equal (setq match (next-overlay-change (point)))
- (point-max)))
- (let ((propandmore (get-char-property-and-overlay (point) 'display)))
- (when (cdr propandmore) (delete-overlay (cdr propandmore))))
- (goto-char match)))))
-
-(defun a68--pretty-print-bold-tag ()
- "Pretty-print an ALGOL 68 bold tag."
- (save-excursion
- (unless (or (a68-within-comment)
- (a68-within-string))
- (skip-chars-forward "A-Z_")
- (let* ((bold-tag-end (point))
- (bold-tag-begin (save-excursion
- (skip-chars-backward "A-Z_")
- (point))))
- (let ((replacedtext (downcase (buffer-substring bold-tag-begin
bold-tag-end)))
- (overlay (make-overlay bold-tag-begin bold-tag-end)))
- (let ((old-overlay (get-char-property-and-overlay bold-tag-begin
'display)))
- (when (cdr old-overlay) (delete-overlay (cdr old-overlay))))
- (overlay-put overlay 'face 'a68-bold-tag-face)
- (overlay-put overlay 'display replacedtext)
- (overlay-put overlay 'evaporate t))))))
-
-(defun a68--pretty-print-bold-tags (beginning end)
- "Pretty-print ALGOL 68 bold tags in the given region."
- (unless (or (a68-within-comment)
- (a68-within-string))
- (save-excursion
- (goto-char beginning)
- (while (let ((case-fold-search nil))
- (re-search-forward (rx word-start upper (zero-or-more upper)
word-end)
- end t))
- (unless (or (a68-within-comment)
- (a68-within-string))
- (let* ((bold-tag-end (match-end 0))
- (bold-tag-begin (match-beginning 0)))
- (let ((replacedtext (downcase (buffer-substring bold-tag-begin
bold-tag-end)))
- (overlay (make-overlay bold-tag-begin bold-tag-end)))
- (let ((old-overlay (get-char-property-and-overlay bold-tag-begin
'display)))
- (when (cdr old-overlay) (delete-overlay (cdr old-overlay))))
- (overlay-put overlay 'face 'a68-bold-tag-face)
- (overlay-put overlay 'display replacedtext)
- (overlay-put overlay 'evaporate t))))))))
-
-(defun a68--after-change-function (start stop len)
- "Save the current buffer and point for the mode's post-command hook."
- (when a68-pretty-bold-tags-mode
- (let* ((pos (point))
- (in-bold-tag-already (get-char-property pos 'display)))
- (save-match-data
- (if (equal len 0)
- (a68--pretty-print-bold-tag)
- (a68--pretty-print-bold-tags start stop)))
- (when (and (equal len 0) in-bold-tag-already) (backward-char)))))
-
-;;;; Auto-stropping (minor mode).
-
-(defvar a68--mode-indicants
- nil
- "List of mode indicants declared in current buffer.")
-
-;;;###autoload
-(define-minor-mode a68-auto-stropping-mode
- "Toggle auto-stropping in a68-mode."
- :group a68
- (if a68-auto-stropping-mode
- (progn
- (a68--collect-modes)
- (run-with-idle-timer 0.5 t #'a68--collect-modes)
- (add-hook 'post-self-insert-hook
- #'a68--do-auto-stropping 'append 'local))
- (remove-hook 'post-self-insert-hook
- #'a68--do-auto-stropping)
- (setq a68--mode-indicants nil)))
-
-(defun a68--collect-modes ()
- "Collect mode-indicants of modes defined in the current buffer
-into a68--mode-indicants."
- (save-excursion
- (goto-char (point-min))
- (let ((case-fold-search nil))
- (setq a68--mode-indicants nil)
- (while (re-search-forward (rx bow "MODE" eow
- (one-or-more white)
- (group (any "A-Z") (zero-or-more (any
"A-Z0-9_")))
- (zero-or-more white)
- "=") nil t)
- (setq a68--mode-indicants
- (cons (buffer-substring-no-properties (match-beginning 1)
- (match-end 1))
- a68--mode-indicants)))))
- a68--mode-indicants)
-
-(defun a68--do-auto-stropping ()
- (when (and (not (a68-within-comment))
- (not (a68-within-string))
- (or (eq (char-before) ?\s)
- (eq (char-before) ?\n)))
- (let (id beginning end)
- (save-excursion
- (goto-char (- (point) 1))
- (when (looking-back (rx bow (group (any "a-z") (zero-or-more (any
"a-z0-9_"))))
- nil t)
- (setq beginning (match-beginning 1))
- (setq end (match-end 1))
- (setq id (upcase (buffer-substring-no-properties beginning end)))
- ;; XXX Optimize away this `append' with `eval-when-compile'?
- (when (member id (append a68-std-modes a68-keywords
a68--mode-indicants))
- (goto-char end)
- (delete-region beginning end)
- (insert id)))))))
-
(provide 'a68-mode)
;;; a68-mode.el ends here
