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.2
   8 ;; Package-Requires: ((emacs "24.2"))
   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 `_' key inserts the package
  39 ;;   namespace if 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-type-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 1)
  63                     (match-end 1)
  64                     (concat display nameless-prefix))
  65     '(face nameless-face)))
  66
  67 (defvar-local nameless--font-lock-keywords nil)
  68
  69 (defun nameless--ensure ()
  70   (save-excursion
  71     (font-lock-fontify-region (point-min) (point-max))))
  72
  73 (defun nameless--remove-keywords ()
  74   "Remove font-lock keywords set by `nameless--add-keywords'."
  75   (font-lock-remove-keywords nil nameless--font-lock-keywords)
  76   (setq nameless--font-lock-keywords nil)
  77   (nameless--ensure))
  78
  79 (defun nameless--add-keywords (&rest r)
  80   "Add font-lock keywords displaying REGEXP as DISPLAY.
  81
  82 \(fn regexp display [regexp display ...])"
  83   (setq-local font-lock-extra-managed-props
  84               (cons 'composition font-lock-extra-managed-props))
  85   (let ((kws nil))
  86     (while r
  87       (push `(,(pop r) 1 (nameless--compose-as ,(pop r)) prepend) kws))
  88     (setq nameless--font-lock-keywords kws)
  89     (font-lock-add-keywords nil kws t))
  90   (nameless--ensure))
  91
  92 \f
  93 ;;; Name and regexp
  94 (defvar-local nameless-current-name-regexp nil)
  95 (defvar-local nameless-current-name nil)
  96
  97 (defun nameless--in-arglist-p ()
  98   "Is point inside an arglist?"
  99   (save-excursion
 100     (ignore-errors
 101       (backward-up-list)
 102       (or (progn (forward-sexp -1)
 103                  (looking-at-p "[a-z-]lambda\\_>"))
 104           (progn (forward-sexp -1)
 105                  (looking-at-p "\\(cl-\\)?def\\(un\\|macro\\|inline\\)\\*?\\_>"))))))
 106
 107 (defun nameless-insert-name (&optional self-insert)
 108   "Insert the name of current package, with a hyphen."
 109   (interactive "P")
 110   (if (or self-insert
 111           (not nameless-current-name)
 112           (eq (char-before) ?\\)
 113           (nameless--in-arglist-p)
 114           (string-match (rx (or (syntax symbol)
 115                                 (syntax word)))
 116                         (string (char-before))))
 117       (call-interactively #'self-insert-command)
 118     (insert nameless-current-name "-")))
 119
 120 (defun nameless--name-regexp (name)
 121   "Return a regexp of the current name."
 122   (concat "\\_<\\(" (regexp-quote name) "-\\)\\(\\s_\\|\\sw\\)"))
 123
 124 \f
 125 ;;; Minor mode
 126 ;;;###autoload
 127 (define-minor-mode nameless-mode
 128   nil nil " :" '(("_" . nameless-insert-name))
 129   (if nameless-mode
 130       (if (or nameless-current-name-regexp
 131               nameless-current-name
 132               (ignore-errors (string-match "\\.el\\'" (lm-get-package-name))))
 133           (progn
 134             (unless nameless-current-name-regexp
 135               (unless nameless-current-name
 136                 (setq nameless-current-name (replace-regexp-in-string "\\.[^.]*\\'" "" (lm-get-package-name))))
 137               (setq nameless-current-name-regexp (nameless--name-regexp nameless-current-name)))
 138             (nameless--add-keywords nameless-current-name-regexp))
 139         (nameless-mode -1))
 140     (setq nameless-current-name nil)
 141     (setq nameless-current-name-regexp nil)
 142     (nameless--remove-keywords)))
 143 ;; (font-lock-remove-keywords)
 144
 145 (provide 'nameless)
 146 ;;; nameless.el ends here