code.delx.au - gnu-emacs-elpa/blob - nameless.el

   1 ;;; nameless.el --- Hide package namespace in your emacs-lisp code  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
   6 ;; Keywords: convenience, lisp
   7 ;; Version: 0.1
   8 ;; Package-Requires: ((emacs "24.3"))
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Usage
  26 ;; ─────
  27 ;;
  28 ;;   To use this package add the following configuration to your Emacs init
  29 ;;   file.
  30 ;;
  31 ;;   ┌────
  32 ;;   │ (add-hook 'emacs-lisp-mode-hook #'nameless-mode)
  33 ;;   └────
  34 ;;
  35 ;;   You can configure a string to use instead of `:' by setting the
  36 ;;   `nameless-prefix', and the name of the face used is `nameless-face'.
  37 ;;
  38 ;;   While the mode is active, the `:' and `_' keys will insert the package
  39 ;;   namespace when appropriate.
  40
  41 ;;; Code:
  42 (require 'lisp-mnt)
  43
  44 (defgroup nameless nil
  45   "Customization group for nameless."
  46   :group 'emacs)
  47
  48 (defcustom nameless-prefix ":"
  49   "Prefix displayed instead of package namespace."
  50   :type 'string)
  51
  52 (defface nameless-face
  53   '((t :inherit font-lock-keyword-face))
  54   "Face used on `nameless-prefix'")
  55
  56 \f
  57 ;;; Font-locking
  58 (defvar nameless-mode)
  59 (defun nameless--compose-as (display)
  60   "Compose the matched region and return a face spec."
  61   (when nameless-mode
  62     (compose-region (match-beginning 0)
  63                     (match-end 0)
  64                     (or display nameless-prefix))
  65     '(face nameless-face)))
  66
  67 (defun nameless--add-keywords (&rest r)
  68   "Add font-lock keywords displaying REGEXP as DISPLAY.
  69
  70 \(fn regexp display [regexp display ...])"
  71   (setq-local font-lock-extra-managed-props
  72               (cons 'composition font-lock-extra-managed-props))
  73   (while r
  74     (font-lock-add-keywords
  75      nil `((,(pop r) 0 (nameless--compose-as ,(pop r)) prepend)) t))
  76   (with-no-warnings
  77     (if (fboundp 'font-lock-ensure)
  78         (font-lock-ensure)
  79       (font-lock-fontify-buffer))))
  80
  81 \f
  82 ;;; Name and regexp
  83 (defvar-local nameless-current-name-regexp nil)
  84 (defvar-local nameless-current-name nil)
  85
  86 (defun nameless--in-arglist-p ()
  87   "Is point inside an arglist?"
  88   (save-excursion
  89     (ignore-errors
  90       (backward-up-list)
  91       (forward-sexp -2)
  92       (looking-at-p "def\\(un\\|macro\\)\\_>"))))
  93
  94 (defun nameless-insert-name (&optional self-insert)
  95   "Insert the name of current package, with a hyphen."
  96   (interactive "P")
  97   (if (or self-insert
  98           (not nameless-current-name)
  99           (nameless--in-arglist-p)
 100           (string-match (rx (or (syntax symbol)
 101                                 (syntax word)))
 102                         (string (char-before))))
 103       (call-interactively #'self-insert-command)
 104     (insert nameless-current-name "-")))
 105
 106 (defun nameless--name-regexp (name)
 107   "Return a regexp of the current name."
 108   (concat "\\<" (regexp-quote name) "-"))
 109
 110 \f
 111 ;;; Minor mode
 112 (define-minor-mode nameless-mode
 113   nil nil " :" '(("_" . nameless-insert-name))
 114   (if (and nameless-mode)
 115       (if (or nameless-current-name-regexp
 116               nameless-current-name
 117               (ignore-errors (string-match "\\.el\\'" (lm-get-package-name))))
 118           (progn
 119             (unless nameless-current-name-regexp
 120               (unless nameless-current-name
 121                 (setq nameless-current-name (replace-regexp-in-string "\\.[^.]*\\'" "" (lm-get-package-name))))
 122               (setq nameless-current-name-regexp (nameless--name-regexp nameless-current-name)))
 123             (nameless--add-keywords nameless-current-name-regexp))
 124         (nameless-mode -1))))
 125 ;; (font-lock-remove-keywords)
 126
 127 (provide 'nameless)
 128 ;;; nameless.el ends here