From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.devel Subject: Re: ctl-x-map key binding conventions for new major/minor modes Date: Wed, 17 May 2017 15:18:37 +0900 (JST) Message-ID: References: <83vap58c4t.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; format=flowed; charset=US-ASCII X-Trace: blaine.gmane.org 1495001941 19614 195.159.176.226 (17 May 2017 06:19:01 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 17 May 2017 06:19:01 +0000 (UTC) User-Agent: Alpine 2.20 (DEB 67 2015-01-07) Cc: Kaushal Modi , Emacs developers , Drew Adams , Tino Calancha To: Eli Zaretskii Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed May 17 08:18:56 2017 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dAsIR-0004vJ-Sb for ged-emacs-devel@m.gmane.org; Wed, 17 May 2017 08:18:56 +0200 Original-Received: from localhost ([::1]:45652 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dAsIV-0001Oy-Pv for ged-emacs-devel@m.gmane.org; Wed, 17 May 2017 02:18:59 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:56431) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dAsIM-0001Of-Cd for emacs-devel@gnu.org; Wed, 17 May 2017 02:18:52 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dAsIK-0006DZ-GV for emacs-devel@gnu.org; Wed, 17 May 2017 02:18:50 -0400 Original-Received: from mail-pg0-x244.google.com ([2607:f8b0:400e:c05::244]:36612) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dAsIG-0006Cs-Ed; Wed, 17 May 2017 02:18:44 -0400 Original-Received: by mail-pg0-x244.google.com with SMTP id h64so557321pge.3; Tue, 16 May 2017 23:18:43 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:date:to:cc:subject:in-reply-to:message-id:references :user-agent:mime-version; bh=VI1vb0tt6Q0YtimO/47wd0t5jbFTJ+x5R4U2JKjSBEs=; b=TboL5dQldfjCsqDJQLBRLgynRo+gb3zvAIiMku6dJ86gohumtjfuAxCsgdnjC8WU9y fmV1yf/k5ss7q9EmSMkOZJboRt32Hw01ghNdKbN3zH/galOdUWHr0YGfEX6vR11eJSfD lxpKsN7Rg2y6avKIkiSFngsQbdQQAeqWZswpikg2djqY6QV9SUT1OfzYAvEAwPbu3u04 IP6dskHgn02LbB84gXevVNHn7nCqErz8+bPZzANGG7yZz6kbKp8qi0nSniuq+kt+9odH HYKOsViEeC0Lzvbk0nw8T07A7ACAPB3masubyGrIWvKdyJ2oUvt0CQAS9BjNZP1UjPBn uqLA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:date:to:cc:subject:in-reply-to:message-id :references:user-agent:mime-version; bh=VI1vb0tt6Q0YtimO/47wd0t5jbFTJ+x5R4U2JKjSBEs=; b=ieU3V5SBX8sxuTLWdaK+15ar1yFl7nb9mdE5e7NeeONbZ2892Z84x1c0deII/x6EmJ 17lInM3sJtgEwJN7Ix7WalUyRQGOM+UrdfEfP+lzifavEhexqxx1I0C1GCgsSMHz2YXU pQyOEbxfBwMdTAU46ssJOh/k9mFGugZCzsgZSR0hndeT7DcwACMcvgaCH+90UMaTGAvt RfVgb7xOoTlT4yM8CrkVFD9aoseh4UX5BhxdNF0cgdpNfx6hLom/OIoY8mLgIwQ8dOZS dBADGJ8go6RGfhxYmd4DzpPEQ0rg1HW9AcG1O2x9dMlnFF4RlVg0OtLEcItODfMO8ei/ PqIA== X-Gm-Message-State: AODbwcBB0HZbThSYCcgC9KyW8mOTT1/N4BB4APrp7Gnb/ah6DD98tGxf 9s6RB2lyaDsGuOXJ X-Received: by 10.84.179.99 with SMTP id a90mr2325946plc.26.1495001922868; Tue, 16 May 2017 23:18:42 -0700 (PDT) Original-Received: from calancha-pc (222.139.137.133.dy.bbexcite.jp. [133.137.139.222]) by smtp.gmail.com with ESMTPSA id d86sm1739678pfj.75.2017.05.16.23.18.39 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Tue, 16 May 2017 23:18:41 -0700 (PDT) X-Google-Original-From: Tino Calancha X-X-Sender: calancha@calancha-pc In-Reply-To: <83vap58c4t.fsf@gnu.org> X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2607:f8b0:400e:c05::244 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:214904 Archived-At: On Sat, 13 May 2017, Eli Zaretskii wrote: >> From: Tino Calancha >> Date: Sat, 13 May 2017 14:33:45 +0900 (JST) >> Cc: Emacs developers , >> Tino Calancha >> >> Imagine one user sets that binding in her .emacs file. Now she loads >> a lib `foo.el' which automatically sets a global binding >> 'C-x g' to `foo-whatever'. > > Perhaps instead of adding recommendations about this, we could have a > feature where define-key invoked as part as 'load' or 'require' would > check, once, if the key being rebound already has a binding, and ask > the user what she would like to do about, with 3 possible answers > being "rebind", "don't rebind", and "error out of 'load'"? That feature might be a new minor mode; where the user can customize what key bindings protect and/or what directories to look at/ignore. =============================================================================== I) pkb.el: =============================================================================== --8<-----------------------------cut here---------------start------------->8--- ;;; pkb.el --- Prevent unnoticed key rebindings -*- lexical-binding: t; -*- ;; Copyright (C) 2017 Tino Calancha ;; Author: Tino Calancha ;; Version: 0.2 ;; Package-Version: 20170517.1359 ;; Package-Requires: ((emacs "24.4")) ;; Keywords: lisp, convenience, keyboard ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is NOT part of GNU Emacs. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; ;; This file prevents from inadvertently changes on key bindings ;; during the load of an elisp library. ;; ;; The file defines a new minor mode `pkb-protect-key-bindings'. ;; When the mode is enabled and a library is loaded, ask what ;; to do if a call to `define-key' rebinds a previous key. ;; Possible actions are: ;; y: Rebind it. ;; n: Skip it. ;; Y or !: Rebind all and not prompt me more. ;; N: Skip all and not prompt me more. ;; The latter two actions are permanent. After them, you must toggle ;; OFF/ON the mode if you want to be prompted again when loading ;; a new library. ;; ;; By default, the protected keys are those reserved for users. You can ;; add more protected keys by customizing `pkb-protected-prefices'. ;; ;;; Code: (require 'cl-lib) (defgroup pkb nil "Prevent unnoticed key rebindings." :prefix "pkb-" :group 'keyboard) (defcustom pkb-protect-global-bindings-only t "If nil, then protect local key bindings as well." :type 'boolean :group 'protect-key-bindings :version "26.1") ;; Protect keys reserved for users. You might also want "C-x" and "M-". (defcustom pkb-protected-prefices '("\\`C-c [a-zA-Z]\\'" "\\`\\'" "\\`\\'" "\\`\\'" "\\`\\'" "\\`\\'") "List of protected key bindings when loading a library." :type 'list :group 'protect-key-bindings :version "26.1") (defcustom pkb-dirs-to-ignore nil "List of directories to ignore for key rebindings." :type '(choice (const :tag "Unset" nil) (repeat :tag "Directories to ignore" string)) :group 'protect-key-bindings :version "26.1") (defcustom pkb-dirs-to-check nil "List of directories to check for key rebindings." :type '(choice (const :tag "Unset" nil) (repeat :tag "Directories to check" string)) :group 'protect-key-bindings :version "26.1") (defcustom pkb-protect-action 'ask "What to do when the load of a lib changes a protected key binding." :type '(choice (const :tag "Unset" nil) (const :tag "Ask" ask) (const :tag "Accept all" accept) (const :tag "Cancel all" cancel) (const :tag "Signal Error" signal-error)) :group 'keyboard :version "26.1") (defun pkb--current-def (keymap key) (let ((special-global-maps (list ctl-x-map ctl-x-4-map ctl-x-5-map esc-map))) (if (memq keymap special-global-maps) (lookup-key keymap key) (or (global-key-binding key) (and (null pkb-protect-global-bindings-only) (lookup-key keymap key)))))) (defun pkb--read-input (key-descr keymap) (let* ((special-global-maps (list ctl-x-map ctl-x-4-map ctl-x-5-map esc-map)) (id-prefix '((0 . "C-x ") (1 . "C-x 4 ") (2 . "C-x 5 ") (3 . "M-"))) (lib (file-name-nondirectory load-file-name)) (prompt (format "[%s] Key '%s%s' already bound. Rebind? [ynY!N] " lib (if (memq keymap special-global-maps) (cdr (assq (cl-position keymap special-global-maps) id-prefix)) "") key-descr)) (res (string (read-char prompt))) (valid-answers '("y" "n" "Y" "!" "N"))) (if (member res valid-answers) res (while (not (member res valid-answers)) (ding) (let ((prompt (concat prompt "Valid answers are chars in [ynY!N] "))) (setq res (string (read-char prompt))))) res))) (defvar pkb--rebind-all nil) (defvar pkb--cancel-all-rebindings nil) (defun pkb-define-key--check-rebindings (fn keymap key def &rest args) "What to do when the load of a lib changes a protected key binding." (let* ((key-descr (key-description key)) (current-def (pkb--current-def keymap key)) (auto (or pkb--rebind-all pkb--cancel-all-rebindings)) (rebind-all (or (eq pkb-protect-action 'accept) (and auto pkb--rebind-all))) (cancel-all (or (eq pkb-protect-action 'cancel) (and auto pkb--cancel-all-rebindings))) (in-dirs-ignore-p (and pkb-dirs-to-ignore load-file-name (file-in-directory-p (file-name-directory load-file-name) pkb-dirs-to-ignore))) (not-in-dirs-check-p (and pkb-dirs-to-check load-file-name (not (file-in-directory-p (file-name-directory load-file-name) pkb-dirs-to-check))))) (cond ((and load-in-progress (not in-dirs-ignore-p) (not not-in-dirs-check-p) current-def (and (functionp current-def) (not (eq current-def 'self-insert-command))) (not (equal current-def def))) (let (input) (if (cl-notany (lambda (prefix) (unless (string-suffix-p " " prefix) (setq prefix (concat prefix " "))) (cond ((and (equal prefix "C-x ") (eq keymap ctl-x-map)) t) ((and (equal prefix "C-x 4 ") (eq keymap ctl-x-4-map)) t) ((and (equal prefix "C-x 5 ") (eq keymap ctl-x-5-map)) t) ((and (equal prefix "M- ") (eq keymap esc-map)) t) (t (string-match (substring prefix 0 -1) key-descr)))) pkb-protected-prefices) (apply fn keymap key def args) (cond ((eq pkb-protect-action 'signal-error) (error "Key '%s' already bound" key-descr)) (rebind-all (message "Rebinding key '%s'" key-descr) (apply fn keymap key def args)) (cancel-all (message "Prevent rebinding of key '%s'" key-descr)) (t (setq input (pkb--read-input key-descr keymap)) (pcase input ("y" (apply fn keymap key def args)) ((or "Y" "!") (message "Accepting all rebindings") (setq pkb--rebind-all t) (apply fn keymap key def args)) ("N" (setq pkb--cancel-all-rebindings t) (message "OK, cancel '%s' rebinding and others" key-descr)) ("n" (message "OK, cancel '%s' rebinding" key-descr)))))))) (t (apply fn keymap key def args))))) (define-minor-mode pkb-protect-key-bindings "Toggle pkb mode. With a prefix argument ARG, enable the mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. Prevents from inadvertently changes on key bindings during the load of an elisp library. When the mode is enabled and a library is loaded, ask what to do if a call to `define-key' rebinds a protected key. Possible actions are: y: Rebind it. n: Skip it. Y or !: Rebind all and not prompt me more. N: Skip all and not prompt me more. The latter two actions are permanent. After them, you must toggle OFF/ON the mode if you want to be prompted again when loading a new library. By default, the protected keys are those reserved for users. You can add more protected keys by customizing `pkb-protected-prefices'." :init-value nil :global t :lighter (:eval (if pkb-protect-key-bindings " Pkb" "")) :keymap nil (if pkb-protect-key-bindings (advice-add 'define-key :around 'pkb-define-key--check-rebindings) (advice-remove 'define-key 'pkb-define-key--check-rebindings) (setq pkb--rebind-all nil pkb--cancel-all-rebindings nil))) (provide 'pkb) ;;; pkb.el ends here --8<-----------------------------cut here---------------end--------------->8--- =============================================================================== II) Tests for pkb.el: =============================================================================== --8<-----------------------------cut here---------------start------------->8--- ;;; pkb-tests.el --- Test suite for pkb. -*- lexical-binding: t -*- ;; Copyright (C) 2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Code: (require 'ert) (require 'pkb) (ert-deftest pkb-test () "Test for pkb mode." (let* ((dir (make-temp-file "pkb" 'dir)) (default-directory dir) (foo (expand-file-name "foo.el" dir)) (bar (expand-file-name "bar.el" dir)) (qux (expand-file-name "qux.el" dir)) ;; Restore these bindings on exit. (binding-cca (global-key-binding (kbd "C-c a"))) (binding-cxf (global-key-binding (kbd "C-x f")))) (pkb-protect-key-bindings 1) (with-temp-buffer (insert "(global-set-key (kbd \"C-c a\") (lambda () (interactive) 'foo))\n") (insert "(global-set-key (kbd \"C-x f\") (lambda () (interactive) 'foo))") (write-region nil nil foo) (erase-buffer) (insert "(global-set-key (kbd \"C-c a\") (lambda () (interactive) 'bar))") (write-region nil nil bar) (erase-buffer) (insert "(global-set-key (kbd \"C-x f\") (lambda () (interactive) 'qux))") (write-region nil nil qux)) (unwind-protect (progn (let ((pkb-protect-action 'signal-error)) (global-unset-key (kbd "C-c a")) (should (load foo)) (should (load foo)) ; Again. (should-error (load bar)) ; 'C-c a' bound to a different lambda. (should (load qux)) ; Ignore "C-x". (let ((pkb-protected-prefices (append pkb-protected-prefices (list "C-x")))) (should-error (load foo)))) (let ((pkb--cancel-all-rebindings t)) (should (eq 'foo (funcall (global-key-binding (kbd "C-c a"))))) (should (load bar)) (should (eq 'foo (funcall (global-key-binding (kbd "C-c a")))))) (let ((pkb--rebind-all t)) (should (eq 'foo (funcall (global-key-binding (kbd "C-c a"))))) (should (load bar)) (should (eq 'bar (funcall (global-key-binding (kbd "C-c a"))))))) (delete-directory dir 'recursive) (when binding-cca (global-set-key (kbd "C-c a") binding-cca)) (when binding-cxf (global-set-key (kbd "C-c a") binding-cxf))))) (provide 'pkb-tests) ;; pkb-tests.el ends here --8<-----------------------------cut here---------------end--------------->8---