["Validation" rng-validate-mode
:style toggle
:selected rng-validate-mode]
- ["Electric Pairs" sgml-electric-tag-pair-mode
- :style toggle
- :selected sgml-electric-tag-pair-mode]
"---"
("Set Schema"
["Automatically" rng-auto-set-schema]
(setq arg (1- arg))))
\f
-;;;; Text clones
-
-(defvar text-clone--maintaining nil)
-
-(defun text-clone--maintain (ol1 after beg end &optional _len)
- "Propagate the changes made under the overlay OL1 to the other clones.
-This is used on the `modification-hooks' property of text clones."
- (when (and after (not undo-in-progress)
- (not text-clone--maintaining)
- (overlay-start ol1))
- (let ((margin (if (overlay-get ol1 'text-clone-spreadp) 1 0)))
- (setq beg (max beg (+ (overlay-start ol1) margin)))
- (setq end (min end (- (overlay-end ol1) margin)))
- (when (<= beg end)
- (save-excursion
- (when (overlay-get ol1 'text-clone-syntax)
- ;; Check content of the clone's text.
- (let ((cbeg (+ (overlay-start ol1) margin))
- (cend (- (overlay-end ol1) margin)))
- (goto-char cbeg)
- (save-match-data
- (if (not (re-search-forward
- (overlay-get ol1 'text-clone-syntax) cend t))
- ;; Mark the overlay for deletion.
- (setq end cbeg)
- (when (< (match-end 0) cend)
- ;; Shrink the clone at its end.
- (setq end (min end (match-end 0)))
- (move-overlay ol1 (overlay-start ol1)
- (+ (match-end 0) margin)))
- (when (> (match-beginning 0) cbeg)
- ;; Shrink the clone at its beginning.
- (setq beg (max (match-beginning 0) beg))
- (move-overlay ol1 (- (match-beginning 0) margin)
- (overlay-end ol1)))))))
- ;; Now go ahead and update the clones.
- (let ((head (- beg (overlay-start ol1)))
- (tail (- (overlay-end ol1) end))
- (str (buffer-substring beg end))
- (nothing-left t)
- (text-clone--maintaining t))
- (dolist (ol2 (overlay-get ol1 'text-clones))
- (let ((oe (overlay-end ol2)))
- (unless (or (eq ol1 ol2) (null oe))
- (setq nothing-left nil)
- (let ((mod-beg (+ (overlay-start ol2) head)))
- ;;(overlay-put ol2 'modification-hooks nil)
- (goto-char (- (overlay-end ol2) tail))
- (unless (> mod-beg (point))
- (save-excursion (insert str))
- (delete-region mod-beg (point)))
- ;;(overlay-put ol2 'modification-hooks '(text-clone--maintain))
- ))))
- (if nothing-left (delete-overlay ol1))))))))
-
-(defun text-clone-create (start end &optional spreadp syntax)
- "Create a text clone of START...END at point.
-Text clones are chunks of text that are automatically kept identical:
-changes done to one of the clones will be immediately propagated to the other.
-
-The buffer's content at point is assumed to be already identical to
-the one between START and END.
-If SYNTAX is provided it's a regexp that describes the possible text of
-the clones; the clone will be shrunk or killed if necessary to ensure that
-its text matches the regexp.
-If SPREADP is non-nil it indicates that text inserted before/after the
-clone should be incorporated in the clone."
- ;; To deal with SPREADP we can either use an overlay with `nil t' along
- ;; with insert-(behind|in-front-of)-hooks or use a slightly larger overlay
- ;; (with a one-char margin at each end) with `t nil'.
- ;; We opted for a larger overlay because it behaves better in the case
- ;; where the clone is reduced to the empty string (we want the overlay to
- ;; stay when the clone's content is the empty string and we want to use
- ;; `evaporate' to make sure those overlays get deleted when needed).
- ;;
- (let* ((pt-end (+ (point) (- end start)))
- (start-margin (if (or (not spreadp) (bobp) (<= start (point-min)))
- 0 1))
- (end-margin (if (or (not spreadp)
- (>= pt-end (point-max))
- (>= start (point-max)))
- 0 1))
- ;; FIXME: Reuse overlays at point to extend dups!
- (ol1 (make-overlay (- start start-margin) (+ end end-margin) nil t))
- (ol2 (make-overlay (- (point) start-margin) (+ pt-end end-margin) nil t))
- (dups (list ol1 ol2)))
- (overlay-put ol1 'modification-hooks '(text-clone--maintain))
- (when spreadp (overlay-put ol1 'text-clone-spreadp t))
- (when syntax (overlay-put ol1 'text-clone-syntax syntax))
- ;;(overlay-put ol1 'face 'underline)
- (overlay-put ol1 'evaporate t)
- (overlay-put ol1 'text-clones dups)
- ;;
- (overlay-put ol2 'modification-hooks '(text-clone--maintain))
- (when spreadp (overlay-put ol2 'text-clone-spreadp t))
- (when syntax (overlay-put ol2 'text-clone-syntax syntax))
- ;;(overlay-put ol2 'face 'underline)
- (overlay-put ol2 'evaporate t)
- (overlay-put ol2 'text-clones dups)))
-\f
;;;; Mail user agents.
;; Here we include just enough for other packages to be able
(let ((forward-sexp-function nil))
(forward-sexp n)))
-(defvar sgml-electric-tag-pair-overlays nil)
-(defvar sgml-electric-tag-pair-timer nil)
-
-(defun sgml-electric-tag-pair-before-change-function (_beg end)
- (condition-case err
- (save-excursion
- (goto-char end)
- (skip-chars-backward "-[:alnum:]_.:")
- (if (and ;; (<= (point) beg) ; This poses problems for downcase-word.
- (or (eq (char-before) ?<)
- (and (eq (char-before) ?/)
- (eq (char-before (1- (point))) ?<)))
- (null (get-char-property (point) 'text-clones)))
- (let* ((endp (eq (char-before) ?/))
- (cl-start (point))
- (cl-end (progn (skip-chars-forward "-[:alnum:]_.:") (point)))
- (match
- (if endp
- (when (sgml-skip-tag-backward 1) (forward-char 1) t)
- (with-syntax-table sgml-tag-syntax-table
- (let ((forward-sexp-function nil))
- (up-list -1)
- (when (sgml-skip-tag-forward 1)
- (backward-sexp 1)
- (forward-char 2)
- t)))))
- (clones (get-char-property (point) 'text-clones)))
- (when (and match
- (/= cl-end cl-start)
- (equal (buffer-substring cl-start cl-end)
- (buffer-substring (point)
- (save-excursion
- (skip-chars-forward
- "-[:alnum:]_.:")
- (point))))
- (or (not endp) (eq (char-after cl-end) ?>)))
- (when clones
- (mapc #'delete-overlay clones))
- (text-clone-create cl-start cl-end 'spread "[[:alnum:]-_.:]+")
- (setq sgml-electric-tag-pair-overlays
- (append (get-char-property (point) 'text-clones)
- sgml-electric-tag-pair-overlays))))))
- (scan-error nil)
- (error (message "Error in sgml-electric-pair-mode: %s" err))))
-
-(defun sgml-electric-tag-pair-flush-overlays ()
- (while sgml-electric-tag-pair-overlays
- (delete-overlay (pop sgml-electric-tag-pair-overlays))))
-
-(define-minor-mode sgml-electric-tag-pair-mode
- "Toggle SGML Electric Tag Pair mode.
-
-SGML Electric Tag Pair mode is a buffer-local minor mode for use
-with `sgml-mode' and related major modes. When enabled, editing
-an opening markup tag automatically updates the closing tag."
- :lighter "/e"
- (if sgml-electric-tag-pair-mode
- (progn
- (add-hook 'before-change-functions
- #'sgml-electric-tag-pair-before-change-function
- nil t)
- (unless sgml-electric-tag-pair-timer
- (setq sgml-electric-tag-pair-timer
- (run-with-idle-timer 5 'repeat #'sgml-electric-tag-pair-flush-overlays))))
- (remove-hook 'before-change-functions
- #'sgml-electric-tag-pair-before-change-function
- t)
- ;; We leave the timer running for other buffers.
- ))
-
-
(defun sgml-skip-tag-forward (arg)
"Skip to end of tag or matching closing tag if present.
With prefix argument ARG, repeat this ARG times.
;; The text between \end{verbatim} and \n is ignored, so we'll treat
;; it as a comment.
(put-text-property end (min (1+ end) (line-end-position))
- 'syntax-table (string-to-syntax "<"))))))
- ;; Mark env args for possible electric pairing.
- (unless (get-char-property (1+ start) 'text-clones) ;Already paired-up.
- (put-text-property start end 'latex-env-pair t)))
-
-(define-minor-mode latex-electric-env-pair-mode
- "Toggle Latex Electric Env Pair mode.
-
-Latex Electric Env Pair mode is a buffer-local minor mode for use
-with `latex-mode'. When enabled, typing a \\begin or \\end tag
-automatically inserts its partner."
- :lighter "/e"
- (if latex-electric-env-pair-mode
- (add-hook 'before-change-functions
- #'latex-env-before-change nil 'local)
- (remove-hook 'before-change-functions
- #'latex-env-before-change 'local)))
-
-(defun latex-env-before-change (start end)
- (when (get-text-property start 'latex-env-pair)
- (condition-case err
- (with-silent-modifications
- ;; Remove properties even if don't find a pair.
- (remove-list-of-text-properties
- (previous-single-property-change (1+ start) 'latex-env-pair)
- (next-single-property-change start 'latex-env-pair)
- '(latex-env-pair))
- (unless (or (get-char-property start 'text-clones)
- (get-char-property (1+ start) 'text-clones)
- (save-excursion
- (goto-char start)
- (not (re-search-backward
- "\\\\\\(?:end\\|begi\\(n\\)\\) *{"
- (line-beginning-position) t))))
- (let ((cmd-start (match-beginning 0))
- (type (match-end 1)) ;nil for \end, else \begin.
- (arg-start (1- (match-end 0))))
- (save-excursion
- (goto-char (match-end 0))
- (when (and (looking-at "[^\n{}]*}")
- (> (match-end 0) end))
- (let ((arg-end (match-end 0)))
- (if (null type) ;\end
- (progn (goto-char arg-end)
- (latex-forward-sexp -1)
- (forward-word-strictly 1))
- (goto-char cmd-start)
- (latex-forward-sexp 1)
- (let (forward-sexp-function) (backward-sexp)))
- (when (looking-at
- (regexp-quote (buffer-substring arg-start arg-end)))
- (text-clone-create arg-start arg-end))))))))
- (scan-error nil)
- (error (message "Error in latex-env-before-change: %S" err)))))
+ 'syntax-table (string-to-syntax "<")))))))
(defun tex-font-lock-unfontify-region (beg end)
(font-lock-default-unfontify-region beg end)
("@\\(anchor\\){\\([^}]+\\)" 2 font-lock-type-face)
("@\\(dmn\\|acronym\\|value\\){\\([^}]+\\)" 2 font-lock-builtin-face)
("@\\(end\\|itemx?\\) +\\(.+\\)" 2 font-lock-keyword-face keep)
- ;; (,texinfo-environment-regexp
- ;; 1 (texinfo-clone-environment (match-beginning 1) (match-end 1)) keep)
(,(concat "^@" (regexp-opt (mapcar #'car texinfo-section-list) t)
".*\n")
0 'texinfo-heading t))
"Additional expressions to highlight in Texinfo mode.")
-(defun texinfo-clone-environment (start end)
- (let ((endp nil))
- (save-excursion
- (ignore-errors
- (goto-char start)
- (when (looking-at "end\\Sw+\\(\\sw+\\)")
- (setq endp t start (match-beginning 1) end (match-end 1)))
- (unless (get-char-property start 'text-clones)
- (if endp
- (texinfo-last-unended-begin)
- (forward-word-strictly 1)
- (texinfo-next-unmatched-end))
- (skip-syntax-forward "^w")
- (when (looking-at
- (concat (regexp-quote (buffer-substring start end)) "\\>"))
- (text-clone-create start end 'spread "\\w*")))))))
-
\f
;;; Keybindings
projects / emacs.git / commitdiff