Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 102 lines (87 sloc) 3.683 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
;;; emacs-setup-keys.el --- Functions for handling key bindings in the emacs-setup package.

;;; Commentary:
;; This file contains the functions that allow the emacs-setup package to handle
;; managing keybindings.

;;; Code:

(require 'cl)

;;; **************
;;; CUSTOMIZATIONS
;;; **************

(defgroup emacs-setup-keys nil
  "Emacs setup layout customizations."
  :group 'emacs-setup)

(defcustom emacs-setup-keybindings nil
  "Alist where car is the function and cdr is the keybinding."
  :group 'emacs-setup-keys
  :type '(alist :key-type (string :tag "Function: ")
                :value-type (string :tag "Keybinding: ")))

;;; *********
;;; FUNCTIONS
;;; *********

(defun emacs-setup-bind-keys ()
  "Bind all keys set in `emacs-setup-keybindings'."
  (dolist (binding emacs-setup-keybindings)
    (emacs-setup-bind-key
     (intern (car binding))
     (read-kbd-macro (cdr binding))
     t)))

(defun emacs-setup-bind-key (function binding &optional allow-override-p)
  "Interactively bind a key to a function.
The binding is saved in `emacs-setup-keybindings'."
  (interactive "aFunction: \nkKey binding: \nP")
  (when (or (equal binding "")
            (equal function "keyboard-escape-quit"))
    (keyboard-quit))
  (while (and (not allow-override-p) (key-binding binding))
    (when (or (equal binding "")
              (equal function "keyboard-escape-quit"))
      (keyboard-quit))
    (setq binding (read-key-sequence (concat
                                      (key-description binding)
                                      " is already bound to "
                                      (symbol-name (key-binding binding))
                                      ". Choose another key binding: "))))
  (when (fboundp function)
    (global-set-key binding function)
    (when (called-interactively-p 'interactive)
      (set-variable
       'emacs-setup-keybindings
       (remove (rassoc (key-description binding) emacs-setup-keybindings)
               emacs-setup-keybindings))
      (emacs-setup-custom-save
       'emacs-setup-keybindings
       (add-to-list 'emacs-setup-keybindings
                    (cons (symbol-name function) (key-description binding))
                    t))
      (message "%s bound to %s" function (key-description binding)))))

(defun emacs-setup-unbind-key-by-key ()
  "Interactively unbind a key from `emacs-setup-keybindings'."
  (interactive)
  (let ((binding (read-key-sequence "Key binding: ")))
    (unless (equal binding "")
      (emacs-setup-unbind-key :binding binding))))

(defun emacs-setup-unbind-key-by-function ()
  "Interactively unbind a function from `emacs-setup-keybindings'."
  (interactive)
  (let ((function (completing-read "Function: "
                                   (mapcar 'car emacs-setup-keybindings)
                                   nil t)))
    (unless (equal function "keyboard-escape-quit")
      (emacs-setup-unbind-key :function function))))

(defun* emacs-setup-unbind-key (&key binding function)
  "Unbind a key and remove from `emacs-setup-keybindings'.
Argument BINDING Key binding to unbind.
Argument FUNCTION Funciton to unbind."
  (let ((bind-cons
         (if binding
             (rassoc (key-description binding) emacs-setup-keybindings)
           (when function
             (assoc function emacs-setup-keybindings)))))
    (when bind-cons
      (global-unset-key (read-kbd-macro (cdr bind-cons)))
      (emacs-setup-custom-save
       'emacs-setup-keybindings
       (remove bind-cons emacs-setup-keybindings))
      (message "Unbound %s from %s" (car bind-cons) (cdr bind-cons)))))
                       
(provide 'emacs-setup-keys)

;;; emacs-setup-keys.el ends here
Something went wrong with that request. Please try again.