From b1d39ccce419eeec83a4bc723f6c9daf4ffb2be4 Mon Sep 17 00:00:00 2001 From: Simon Law Date: Sun, 21 Oct 2012 23:15:44 -0400 Subject: [PATCH] * lisp/delsel.el (delete-selection-helper): New function, extracted from delete-selection-pre-hook. (delete-selection-pre-hook): Use it. (delete-selection-self-insert-function): New function. (delete-selection-self-insert-hooks): New hook. (self-insert-command, self-insert-iso): Use it. * lisp/electric.el (electric-pair-syntax): New function, extracted from electric-pair-post-self-insert-function. (electric-pair-post-self-insert-function): Use it. (electric-pair-delete-selection-self-insert-function): New function. (electric-pair-mode): Require delsel and setup delete-selection-self-insert-hooks. Fixes: debbugs:11520 --- lisp/ChangeLog | 19 ++++++- lisp/delsel.el | 143 ++++++++++++++++++++++++++++++----------------- lisp/electric.el | 33 ++++++++--- 3 files changed, 134 insertions(+), 61 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7d532ba899..6edf13719c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,18 @@ +2012-10-22 Simon Law (tiny change) + + * delsel.el (delete-selection-helper): New function, extracted from + delete-selection-pre-hook. + (delete-selection-pre-hook): Use it. + (delete-selection-self-insert-function): New function. + (delete-selection-self-insert-hooks): New hook. + (self-insert-command, self-insert-iso): Use it. + * electric.el (electric-pair-syntax): New function, extracted from + electric-pair-post-self-insert-function. + (electric-pair-post-self-insert-function): Use it. + (electric-pair-delete-selection-self-insert-function): New function. + (electric-pair-mode): Require delsel and setup + delete-selection-self-insert-hooks (bug#11520). + 2012-10-20 Chong Yidong * vc/vc.el (vc-diff-internal): Set up Diff mode even if there are @@ -8,8 +23,8 @@ 2012-10-20 Arne Jørgensen - * progmodes/flymake.el (flymake-create-temp-inplace): Use - file-truename. + * progmodes/flymake.el (flymake-create-temp-inplace): + Use file-truename. 2012-10-20 Eli Zaretskii diff --git a/lisp/delsel.el b/lisp/delsel.el index a643567220..09f58e086a 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -47,6 +47,9 @@ ;; non-nil ;; The normal case: delete the active region prior to executing ;; the command which will insert replacement text. +;; hooks +;; For commands which need to dynamically determine this behaviour. +;; Each hook should return one of the above values or nil. ;;; Code: @@ -71,66 +74,106 @@ any selection." (transient-mark-mode t))) (defun delete-active-region (&optional killp) + "Delete the active region. +If KILLP in not-nil, the active region is killed instead of deleted." (if killp (kill-region (point) (mark)) (delete-region (point) (mark))) t) +(defun delete-selection-helper (type) + "Deletes selection according to TYPE: + 'yank + For commands which do a yank; ensures the region about to be + deleted isn't yanked. + 'supersede + Delete the active region and ignore the current command, + i.e. the command will just delete the region. + 'kill + `kill-region' is used on the selection, rather than + `delete-region'. (Text selected with the mouse will typically + be yankable anyhow.) + non-nil + The normal case: delete the active region prior to executing + the command which will insert replacement text. + hooks + For commands which need to dynamically determine this behaviour. + Each hook should return one of the above values or nil." + (condition-case data + (cond ((eq type 'kill) + (delete-active-region t)) + ((eq type 'yank) + ;; Before a yank command, make sure we don't yank the + ;; head of the kill-ring that really comes from the + ;; currently active region we are going to delete. + ;; That would make yank a no-op. + (when (and (string= (buffer-substring-no-properties + (point) (mark)) + (car kill-ring)) + (fboundp 'mouse-region-match) + (mouse-region-match)) + (current-kill 1)) + (delete-active-region)) + ((eq type 'supersede) + (let ((empty-region (= (point) (mark)))) + (delete-active-region) + (unless empty-region + (setq this-command 'ignore)))) + ((and (symbolp type) (not (booleanp type))) + (delete-selection-helper + (run-hook-with-args-until-success type))) + (type + (delete-active-region) + (if (and overwrite-mode + (eq this-command 'self-insert-command)) + (let ((overwrite-mode nil)) + (self-insert-command + (prefix-numeric-value current-prefix-arg)) + (setq this-command 'ignore))))) + ;; If ask-user-about-supersession-threat signals an error, + ;; stop safe_run_hooks from clearing out pre-command-hook. + (file-supersession (message "%s" (cadr data)) (ding)) + (text-read-only + ;; This signal may come either from `delete-active-region' or + ;; `self-insert-command' (when `overwrite-mode' is non-nil). + ;; To avoid clearing out `pre-command-hook' we handle this case + ;; by issuing a simple message. Note, however, that we do not + ;; handle all related problems: When read-only text ends before + ;; the end of the region, the latter is not deleted but any + ;; subsequent insertion will succeed. We could avoid this case + ;; by doing a (setq this-command 'ignore) here. This would, + ;; however, still not handle the case where read-only text ends + ;; precisely where the region starts: In that case the deletion + ;; would succeed but the subsequent insertion would fail with a + ;; text-read-only error. To handle that case we would have to + ;; investigate text properties at both ends of the region and + ;; skip the deletion when inserting text is forbidden there. + (message "Text is read-only") (ding)))) + (defun delete-selection-pre-hook () + "Normal hook run before commands that delete selections are executed. +Commands which will delete the selection need a 'delete-selection +property on their symbols; commands which insert text but don't +have this property won't delete the selection. + +See `delete-selection-helper'. +" (when (and delete-selection-mode transient-mark-mode mark-active (not buffer-read-only)) (let ((type (and (symbolp this-command) (get this-command 'delete-selection)))) - (condition-case data - (cond ((eq type 'kill) - (delete-active-region t)) - ((eq type 'yank) - ;; Before a yank command, make sure we don't yank the - ;; head of the kill-ring that really comes from the - ;; currently active region we are going to delete. - ;; That would make yank a no-op. - (when (and (string= (buffer-substring-no-properties - (point) (mark)) - (car kill-ring)) - (fboundp 'mouse-region-match) - (mouse-region-match)) - (current-kill 1)) - (delete-active-region)) - ((eq type 'supersede) - (let ((empty-region (= (point) (mark)))) - (delete-active-region) - (unless empty-region - (setq this-command 'ignore)))) - (type - (delete-active-region) - (if (and overwrite-mode - (eq this-command 'self-insert-command)) - (let ((overwrite-mode nil)) - (self-insert-command - (prefix-numeric-value current-prefix-arg)) - (setq this-command 'ignore))))) - ;; If ask-user-about-supersession-threat signals an error, - ;; stop safe_run_hooks from clearing out pre-command-hook. - (file-supersession (message "%s" (cadr data)) (ding)) - (text-read-only - ;; This signal may come either from `delete-active-region' or - ;; `self-insert-command' (when `overwrite-mode' is non-nil). - ;; To avoid clearing out `pre-command-hook' we handle this case - ;; by issuing a simple message. Note, however, that we do not - ;; handle all related problems: When read-only text ends before - ;; the end of the region, the latter is not deleted but any - ;; subsequent insertion will succeed. We could avoid this case - ;; by doing a (setq this-command 'ignore) here. This would, - ;; however, still not handle the case where read-only text ends - ;; precisely where the region starts: In that case the deletion - ;; would succeed but the subsequent insertion would fail with a - ;; text-read-only error. To handle that case we would have to - ;; investigate text properties at both ends of the region and - ;; skip the deletion when inserting text is forbidden there. - (message "Text is read-only") (ding)))))) - -(put 'self-insert-command 'delete-selection t) -(put 'self-insert-iso 'delete-selection t) + (delete-selection-helper type)))) + +(defun delete-selection-self-insert-function () + t) + +(defvar delete-selection-self-insert-hooks + '(delete-selection-self-insert-function) + "Abnormal hook run before commands that insert characters. +This hook should return a TYPE that `delete-selection-helper' understands.") + +(put 'self-insert-command 'delete-selection 'delete-selection-self-insert-hooks) +(put 'self-insert-iso 'delete-selection 'delete-selection-self-insert-hooks) (put 'yank 'delete-selection 'yank) (put 'clipboard-yank 'delete-selection 'yank) diff --git a/lisp/electric.el b/lisp/electric.el index 3108a0ed4c..e6fa1df914 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -301,14 +301,17 @@ This can be convenient for people who find it easier to hit ) than C-f." :version "24.1" :type 'boolean) +(defun electric-pair-syntax (command-event) + (and electric-pair-mode + (let ((x (assq command-event electric-pair-pairs))) + (cond + (x (if (eq (car x) (cdr x)) ?\" ?\()) + ((rassq command-event electric-pair-pairs) ?\)) + (t (char-syntax command-event)))))) + (defun electric-pair-post-self-insert-function () (let* ((syntax (and (eq (char-before) last-command-event) ; Sanity check. - electric-pair-mode - (let ((x (assq last-command-event electric-pair-pairs))) - (cond - (x (if (eq (car x) (cdr x)) ?\" ?\()) - ((rassq last-command-event electric-pair-pairs) ?\)) - (t (char-syntax last-command-event)))))) + (electric-pair-syntax last-command-event))) ;; FIXME: when inserting the closer, we should maybe use ;; self-insert-command, although it may prove tricky running ;; post-self-insert-hook recursively, and we wouldn't want to trigger @@ -355,6 +358,12 @@ This can be convenient for people who find it easier to hit ) than C-f." (eq (char-syntax (following-char)) ?w))) (save-excursion (insert closer)))))) +(defun electric-pair-delete-selection-self-insert-function () + (let ((syntax (electric-pair-syntax last-command-event))) + (if (and (memq syntax '(?\( ?\" ?\$)) (use-region-p)) + 'keep + t))) + ;;;###autoload (define-minor-mode electric-pair-mode "Toggle automatic parens pairing (Electric Pair mode). @@ -370,10 +379,16 @@ See options `electric-pair-pairs' and `electric-pair-skip-self'." :global t :group 'electricity (if electric-pair-mode - (add-hook 'post-self-insert-hook - #'electric-pair-post-self-insert-function) + (progn + (require 'delsel) + (add-hook 'post-self-insert-hook + #'electric-pair-post-self-insert-function) + (add-hook 'delete-selection-self-insert-hooks + #'electric-pair-delete-selection-self-insert-function)) (remove-hook 'post-self-insert-hook - #'electric-pair-post-self-insert-function))) + #'electric-pair-post-self-insert-function) + (remove-hook 'delete-selection-self-insert-hooks + #'electric-pair-delete-selection-self-insert-function))) ;; Automatically add newlines after/before/around some chars. -- 2.39.2