1 ;;; nameless.el --- Hide package namespace in your emacs-lisp code -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
5 ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
6 ;; Keywords: convenience, lisp
8 ;; Package-Requires: ((emacs "24.4"))
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.
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.
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/>.
28 ;; To use this package add the following configuration to your Emacs init
32 ;; │ (add-hook 'emacs-lisp-mode-hook #'nameless-mode)
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'.
38 ;; While the mode is active, the `_' key inserts the package
39 ;; namespace if appropriate.
44 (defgroup nameless nil
45 "Customization group for nameless."
48 (defcustom nameless-prefix ":"
49 "Prefix displayed instead of package namespace."
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'.
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.
64 Furthermore typing `fl' followed by `\\[nameless-insert-name]' will
65 automatically insert `font-lock-'."
66 :type '(alist string string))
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
75 (put 'nameless-aliases 'safe-local-variable
76 (lambda (x) (ignore-errors
79 (unless (and (stringp (car cell))
85 (defface nameless-face
86 '((t :inherit font-lock-type-face))
87 "Face used on `nameless-prefix'")
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.
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)))
103 (defun nameless--make-composition (s)
104 "Return a list that composes S if passed to `compose-region'."
105 (cdr (apply #'append (mapcar (lambda (x) (list '(Br . Bl) x)) s))))
107 (defvar nameless-mode)
108 (defun nameless--compose-as (display)
109 "Compose the matched region and return a face spec."
110 (when (and nameless-mode
111 (not (get-text-property (match-beginning 1) 'composition))
112 (not (get-text-property (match-beginning 1) 'display)))
113 (let ((compose (save-match-data
114 (and nameless-affect-indentation-and-filling
115 (or (not (eq nameless-affect-indentation-and-filling 'outside-strings))
116 (not (nth 3 (syntax-ppss)))))))
117 (dis (concat display nameless-prefix)))
119 (compose-region (match-beginning 1)
121 (nameless--make-composition dis)))
122 `(face nameless-face ,@(unless compose (list 'display dis))))))
124 (defvar-local nameless--font-lock-keywords nil)
126 (defun nameless--ensure ()
128 (font-lock-fontify-region (point-min) (point-max))))
130 (defun nameless--remove-keywords ()
131 "Remove font-lock keywords set by `nameless--add-keywords'."
132 (font-lock-remove-keywords nil nameless--font-lock-keywords)
133 (setq nameless--font-lock-keywords nil)
136 (defun nameless--add-keywords (&rest r)
137 "Add font-lock keywords displaying REGEXP as DISPLAY.
139 \(fn (regexp . display) [(regexp . display) ...])"
140 (setq-local font-lock-extra-managed-props
141 `(composition display ,@font-lock-extra-managed-props))
142 (let ((kws (mapcar (lambda (x) `(,(nameless--name-regexp (cdr x)) 1 (nameless--compose-as ,(car x)))) r)))
143 (setq nameless--font-lock-keywords kws)
144 (font-lock-add-keywords nil kws t))
149 (defvar-local nameless-current-name nil)
150 (put 'nameless-current-name 'safe-local-variable #'stringp)
152 (defun nameless--in-arglist-p ()
153 "Is point inside an arglist?"
157 (or (progn (forward-sexp -1)
158 (looking-at-p "[a-z-]lambda\\_>"))
159 (progn (forward-sexp -1)
160 (looking-at-p "\\(cl-\\)?def\\(un\\|macro\\|inline\\)\\*?\\_>"))))))
162 (defun nameless-insert-name (&optional noerror)
163 "Insert `nameless-current-name' or the alias at point.
164 If point is immediately after an alias configured in
165 `nameless-aliases' or `nameless-global-aliases', replace it with
166 the full name for that alias.
167 Otherwise, insert `nameless-current-name'.
169 If NOERROR is nil, signal an error if the alias at point is not
170 configured, or if `nameless-current-name' is nil."
172 (if (string-match (rx (or (syntax symbol)
174 (string (char-before)))
178 (skip-chars-forward "^[:alnum:]")
180 (alias (buffer-substring l r))
181 (full-name (when alias
182 (cdr (or (assoc alias nameless-aliases)
183 (assoc alias nameless-global-aliases))))))
185 (progn (delete-region l r)
186 (insert full-name "-")
189 (user-error "No name for alias `%s', see `nameless-aliases'" alias))))
190 (if nameless-current-name
191 (progn (insert nameless-current-name "-")
194 (user-error "No name for current buffer, see `nameless-current-name'")))))
196 (defun nameless-insert-name-or-self-insert (&optional self-insert)
197 "Insert the name of current package, with a hyphen."
200 (not nameless-current-name)
201 (eq (char-before) ?\\)
202 (nameless--in-arglist-p))
203 (call-interactively #'self-insert-command)
204 (or (nameless-insert-name 'noerror)
205 (call-interactively #'self-insert-command))))
207 (put 'nameless-insert-name-or-self-insert 'delete-selection t)
209 (defun nameless--name-regexp (name)
210 "Return a regexp of the current name."
211 (concat "\\_<@?\\(" (regexp-quote name) "-\\)\\(\\s_\\|\\sw\\)"))
213 (defun nameless--filter-string (s)
214 "Remove from string S any disply or composition properties.
216 (let ((length (length s)))
217 (remove-text-properties 0 length '(composition nil display nil) s)
223 (define-minor-mode nameless-mode
224 nil nil " :" `((,(kbd "C-c C--") . nameless-insert-name))
226 (if (or nameless-current-name
227 (ignore-errors (string-match "\\.el\\'" (lm-get-package-name))))
229 (unless nameless-current-name
230 (setq nameless-current-name (replace-regexp-in-string "\\.[^.]*\\'" "" (lm-get-package-name))))
231 (add-function :filter-return (local 'filter-buffer-substring-function)
232 #'nameless--filter-string)
233 (apply #'nameless--add-keywords
234 `((nil . ,nameless-current-name)
235 ,@nameless-global-aliases
236 ,@nameless-aliases)))
238 (remove-function (local 'filter-buffer-substring-function)
239 #'nameless--filter-string)
240 (setq nameless-current-name nil)
241 (nameless--remove-keywords)))
244 (defun nameless-mode-from-hook ()
245 "Turn on `nameless-mode'.
246 Designed to be added to `emacs-lisp-mode-hook'.
247 Interactively, just invoke `nameless-mode' directly."
248 (add-hook 'find-file-hook #'nameless-mode nil 'local))
251 ;;; nameless.el ends here