code.delx.au - gnu-emacs-elpa/blob - packages/nameless/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.5
   8 ;; Package-Requires: ((emacs "24.4"))
   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 (defcustom nameless-global-aliases '(("fl" . "font-lock"))
  53   "Alist from aliases to namespaces.
  54 This alist is used everywhere.  It is designed for namespaces you
  55 use commonly.  To apply aliases specific to a file, set the
  56 `nameless-aliases' variable with `add-file-local-variable'.
  57
  58 Each element of this list should have the form (ALIAS . NAMESPACE),
  59 both strings.  For example, if you set this variable to
  60           ((\"fl\" . \"font-lock\"))
  61 then expressions like `(font-lock-add-keywords nil kwds)' will
  62 displayed as `(fl/add-keywords nil kwds)' instead.
  63
  64 Furthermore typing `fl' followed by `\\[nameless-insert-name]' will
  65 automatically insert `font-lock-'."
  66   :type '(alist string string))
  67
  68 (defvar nameless-aliases nil
  69   "Alist from aliases to namespaces.
  70 This variable takes the same syntax and has the same effect as
  71 `nameless-global-aliases'.  Aliases set here take priority over
  72 those in `nameless-global-aliases'.
  73 This variable is designed to be used as a file-local or dir-local
  74 variable.")
  75 (put 'nameless-aliases 'safe-local-variable
  76      (lambda (x) (ignore-errors
  77               (let ((safe t))
  78                 (mapc (lambda (cell)
  79                         (unless (and (stringp (car cell))
  80                                      (stringp (cdr cell)))
  81                           (setq safe nil)))
  82                       x)
  83                 safe))))
  84
  85 (defface nameless-face
  86   '((t :inherit font-lock-type-face))
  87   "Face used on `nameless-prefix'")
  88
  89 (defcustom nameless-affect-indentation-and-filling 'outside-strings
  90   "If non-nil, code is indented and filled according to what you see.
  91 If nil, code is indented and filled according to its actual content.
  92 If the value is `outside-strings', behave like nil inside strings
  93 and behave like t otherwise.
  94
  95 After changing this variable, you must reenable `nameless-mode'
  96 for it to take effect."
  97   :type '(choice (const :tag "Always affect indentation" t)
  98                  (const :tag "Don't affect indentation" nil)
  99                  (const :tag "Only outside strings" 'outside-strings)))
 100
 101 (defcustom nameless-private-prefix nil
 102   "If non-nil, private symbols are displayed with a double prefix.
 103 For instance, the function `foobar--internal-impl' will be
 104 displayed as `::internal-impl', instead of `:-internal-impl'."
 105   :type 'boolean)
 106
 107 \f
 108 ;;; Font-locking
 109 (defun nameless--make-composition (s)
 110   "Return a list that composes S if passed to `compose-region'."
 111   (cdr (apply #'append (mapcar (lambda (x) (list '(Br . Bl) x)) s))))
 112
 113 (defvar nameless-mode)
 114 (defun nameless--compose-as (display)
 115   "Compose the matched region and return a face spec."
 116   (when (and nameless-mode
 117              (not (get-text-property (match-beginning 1) 'composition))
 118              (not (get-text-property (match-beginning 1) 'display)))
 119     (let ((compose (save-match-data
 120                      (and nameless-affect-indentation-and-filling
 121                           (or (not (eq nameless-affect-indentation-and-filling 'outside-strings))
 122                               (not (nth 3 (syntax-ppss)))))))
 123           (dis (concat display nameless-prefix)))
 124       (when compose
 125         (if (and nameless-private-prefix
 126                  (equal "-" (substring (match-string 0) -1)))
 127             (progn
 128               (setq dis (concat dis nameless-prefix))
 129               (compose-region (match-beginning 0)
 130                               (match-end 0)
 131                               (nameless--make-composition dis)))
 132           (compose-region (match-beginning 1)
 133                           (match-end 1)
 134                           (nameless--make-composition dis))))
 135       `(face nameless-face ,@(unless compose (list 'display dis))))))
 136
 137 (defvar-local nameless--font-lock-keywords nil)
 138
 139 (defun nameless--ensure ()
 140   (save-excursion
 141     (font-lock-fontify-region (point-min) (point-max))))
 142
 143 (defun nameless--remove-keywords ()
 144   "Remove font-lock keywords set by `nameless--add-keywords'."
 145   (font-lock-remove-keywords nil nameless--font-lock-keywords)
 146   (setq nameless--font-lock-keywords nil)
 147   (nameless--ensure))
 148
 149 (defun nameless--add-keywords (&rest r)
 150   "Add font-lock keywords displaying ALIAS as DISPLAY.
 151 ALIAS may be nil, in which case it refers to `nameless-current-name'.
 152
 153 \(fn (alias . display) [(alias . display) ...])"
 154   (setq-local font-lock-extra-managed-props
 155               `(composition display ,@font-lock-extra-managed-props))
 156   (let ((kws (mapcar (lambda (x) `(,(nameless--name-regexp (cdr x)) 1 (nameless--compose-as ,(car x)))) r)))
 157     (setq nameless--font-lock-keywords kws)
 158     (font-lock-add-keywords nil kws t))
 159   (nameless--ensure))
 160
 161 \f
 162 ;;; Name and regexp
 163 (defvar-local nameless-current-name nil)
 164 (put 'nameless-current-name 'safe-local-variable #'stringp)
 165
 166 (defun nameless--in-arglist-p (l)
 167   "Is point L inside an arglist?"
 168   (save-excursion
 169     (goto-char l)
 170     (ignore-errors
 171       (backward-up-list)
 172       (or (progn (forward-sexp -1)
 173                  (looking-at-p "[a-z-]lambda\\_>"))
 174           (progn (forward-sexp -1)
 175                  (looking-at-p "\\(cl-\\)?def"))))))
 176
 177 (defun nameless-insert-name (&optional noerror)
 178   "Insert `nameless-current-name' or the alias at point.
 179 If point is immediately after an alias configured in
 180 `nameless-aliases' or `nameless-global-aliases', replace it with
 181 the full name for that alias.
 182 Otherwise, insert `nameless-current-name'.
 183
 184 If NOERROR is nil, signal an error if the alias at point is not
 185 configured, or if `nameless-current-name' is nil."
 186   (interactive)
 187   (if (string-match (rx (or (syntax symbol)
 188                             (syntax word)))
 189                     (string (char-before)))
 190       (let* ((r (point))
 191              (l (save-excursion
 192                   (forward-sexp -1)
 193                   (skip-chars-forward "^[:alnum:]")
 194                   (point)))
 195              (alias (buffer-substring l r))
 196              (full-name (when alias
 197                           (cdr (or (assoc alias nameless-aliases)
 198                                    (assoc alias nameless-global-aliases))))))
 199         (if full-name
 200             (progn (delete-region l r)
 201                    (insert full-name "-")
 202                    t)
 203           (unless noerror
 204             (user-error "No name for alias `%s', see `nameless-aliases'" alias))))
 205     (if nameless-current-name
 206         (progn (insert nameless-current-name "-")
 207                t)
 208       (unless noerror
 209         (user-error "No name for current buffer, see `nameless-current-name'")))))
 210
 211 (defun nameless-insert-name-or-self-insert (&optional self-insert)
 212   "Insert the name of current package, with a hyphen."
 213   (interactive "P")
 214   (let ((l (point)))
 215     (call-interactively #'self-insert-command)
 216     (unless (or self-insert
 217                 (not nameless-current-name)
 218                 (eq (char-before l) ?\\)
 219                 (nameless--in-arglist-p l))
 220       (undo-boundary)
 221       (delete-region l (point))
 222       (unless (nameless-insert-name 'noerror)
 223         (call-interactively #'self-insert-command)))))
 224
 225 (put 'nameless-insert-name-or-self-insert 'delete-selection t)
 226
 227 (defun nameless--name-regexp (name)
 228   "Return a regexp of the current name."
 229   (concat "\\_<@?\\(" (regexp-quote name) "-\\)\\(\\s_\\|\\sw\\)"))
 230
 231 (defun nameless--filter-string (s)
 232   "Remove from string S any disply or composition properties.
 233 Return S."
 234   (let ((length (length s)))
 235     (remove-text-properties 0 length '(composition nil display nil) s)
 236     s))
 237
 238 \f
 239 ;;; Minor mode
 240 ;;;###autoload
 241 (define-minor-mode nameless-mode
 242   nil nil " :" `((,(kbd "C-c C--") . nameless-insert-name))
 243   (if nameless-mode
 244       (if (or nameless-current-name
 245               (ignore-errors (string-match "\\.el\\'" (lm-get-package-name))))
 246           (progn
 247             (unless nameless-current-name
 248               (setq nameless-current-name (replace-regexp-in-string "\\(-mode\\)?\\.[^.]*\\'" "" (lm-get-package-name))))
 249             (add-function :filter-return (local 'filter-buffer-substring-function)
 250                           #'nameless--filter-string)
 251             (apply #'nameless--add-keywords
 252                    `((nil . ,nameless-current-name)
 253                      ,@nameless-global-aliases
 254                      ,@nameless-aliases)))
 255         (nameless-mode -1))
 256     (remove-function (local 'filter-buffer-substring-function)
 257                      #'nameless--filter-string)
 258     (setq nameless-current-name nil)
 259     (nameless--remove-keywords)))
 260
 261 ;;;###autoload
 262 (defun nameless-mode-from-hook ()
 263   "Turn on `nameless-mode'.
 264 Designed to be added to `emacs-lisp-mode-hook'.
 265 Interactively, just invoke `nameless-mode' directly."
 266   (add-hook 'find-file-hook #'nameless-mode nil 'local))
 267
 268 (provide 'nameless)
 269 ;;; nameless.el ends here