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 ;; URL: https://github.com/Malabarba/nameless
7 ;; Keywords: convenience, lisp
9 ;; Package-Requires: ((emacs "24.4"))
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
29 ;; To use this package add the following configuration to your Emacs init
33 ;; │ (add-hook 'emacs-lisp-mode-hook #'nameless-mode)
36 ;; You can configure a string to use instead of `:' by setting the
37 ;; `nameless-prefix', and the name of the face used is `nameless-face'.
39 ;; While the mode is active, the `_' key inserts the package
40 ;; namespace if appropriate.
45 (defgroup nameless nil
46 "Customization group for nameless."
49 (defcustom nameless-prefix ":"
50 "Prefix displayed instead of package namespace."
53 (defcustom nameless-global-aliases '(("fl" . "font-lock"))
54 "Alist from aliases to namespaces.
55 This alist is used everywhere. It is designed for namespaces you
56 use commonly. To apply aliases specific to a file, set the
57 `nameless-aliases' variable with `add-file-local-variable'.
59 Each element of this list should have the form (ALIAS . NAMESPACE),
60 both strings. For example, if you set this variable to
61 ((\"fl\" . \"font-lock\"))
62 then expressions like `(font-lock-add-keywords nil kwds)' will
63 displayed as `(fl/add-keywords nil kwds)' instead.
65 Furthermore typing `fl' followed by `\\[nameless-insert-name]' will
66 automatically insert `font-lock-'."
67 :type '(alist string string))
69 (defvar nameless-aliases nil
70 "Alist from aliases to namespaces.
71 This variable takes the same syntax and has the same effect as
72 `nameless-global-aliases'. Aliases set here take priority over
73 those in `nameless-global-aliases'.
74 This variable is designed to be used as a file-local or dir-local
76 (put 'nameless-aliases 'safe-local-variable
77 (lambda (x) (ignore-errors
80 (unless (and (stringp (car cell))
86 (defcustom nameless-discover-current-name t
87 "If non-nil, discover package name automatically.
88 If nil, `nameless-current-name' must be set explicitly, or left as nil,
89 in which case only namespaces from `nameless-global-aliases' and
90 `nameless-aliases' are used."
93 (defface nameless-face
94 '((t :inherit font-lock-type-face))
95 "Face used on `nameless-prefix'")
97 (defcustom nameless-affect-indentation-and-filling 'outside-strings
98 "If non-nil, code is indented and filled according to what you see.
99 If nil, code is indented and filled according to its actual content.
100 If the value is `outside-strings', behave like nil inside strings
101 and behave like t otherwise.
103 After changing this variable, you must reenable `nameless-mode'
104 for it to take effect."
105 :type '(choice (const :tag "Always affect indentation" t)
106 (const :tag "Don't affect indentation" nil)
107 (const :tag "Only outside strings" outside-strings)))
108 (put 'nameless-current-name 'safe-local-variable #'symbolp)
110 (defcustom nameless-private-prefix nil
111 "If non-nil, private symbols are displayed with a double prefix.
112 For instance, the function `foobar--internal-impl' will be
113 displayed as `::internal-impl', instead of `:-internal-impl'."
116 (defcustom nameless-separator "-"
117 "Separator used between package prefix and rest of symbol.
118 The separator is hidden along with the package name. For
119 instance, setting it to \"/\" means that `init/bio' will be
120 displayed as `:bio' (assuming `nameless-current-name' is
121 \"init\"). The default is \"-\", since this is the
122 separator recommended by the Elisp manual.
124 Value can also be nil, in which case the separator is never hidden."
125 :type '(choice string (constant nil)))
129 (defun nameless--make-composition (s)
130 "Return a list that composes S if passed to `compose-region'."
131 (cdr (apply #'append (mapcar (lambda (x) (list '(Br . Bl) x)) s))))
133 (defvar nameless-mode)
134 (defun nameless--compose-as (display)
135 "Compose the matched region and return a face spec."
136 (when (and nameless-mode
137 (not (get-text-property (match-beginning 1) 'composition))
138 (not (get-text-property (match-beginning 1) 'display)))
139 (let ((compose (save-match-data
140 (and nameless-affect-indentation-and-filling
141 (or (not (eq nameless-affect-indentation-and-filling 'outside-strings))
142 (not (nth 3 (syntax-ppss)))))))
143 (dis (concat display nameless-prefix))
144 (beg (match-beginning 1))
146 (private-prefix (and nameless-private-prefix
147 (equal nameless-separator (substring (match-string 0) -1)))))
149 (setq beg (match-beginning 0))
150 (setq end (match-end 0))
151 (setq dis (concat dis nameless-prefix)))
153 (compose-region beg end (nameless--make-composition dis))
154 (add-text-properties beg end (list 'display dis)))
155 '(face nameless-face))))
157 (defvar-local nameless--font-lock-keywords nil)
159 (defun nameless--ensure ()
161 (font-lock-fontify-region (point-min) (point-max))))
163 (defun nameless--remove-keywords ()
164 "Remove font-lock keywords set by `nameless--add-keywords'."
165 (font-lock-remove-keywords nil nameless--font-lock-keywords)
166 (setq nameless--font-lock-keywords nil)
169 (defun nameless--add-keywords (&rest r)
170 "Add font-lock keywords displaying ALIAS as DISPLAY.
171 ALIAS may be nil, in which case it refers to `nameless-current-name'.
173 \(fn (alias . display) [(alias . display) ...])"
174 (setq-local font-lock-extra-managed-props
175 `(composition display ,@font-lock-extra-managed-props))
176 (let ((kws (mapcar (lambda (x) `(,(nameless--name-regexp (cdr x)) 1 (nameless--compose-as ,(car x)) prepend)) r)))
177 (setq nameless--font-lock-keywords kws)
178 (font-lock-add-keywords nil kws t))
183 (defvar-local nameless-current-name nil)
184 (put 'nameless-current-name 'safe-local-variable #'stringp)
186 (defun nameless--in-arglist-p (l)
187 "Is point L inside an arglist?"
192 (or (progn (forward-sexp -1)
193 (looking-at-p "[a-z-]lambda\\_>"))
194 (progn (forward-sexp -1)
195 (looking-at-p "\\(cl-\\)?def"))))))
197 (defun nameless-insert-name (&optional noerror)
198 "Insert `nameless-current-name' or the alias at point.
199 If point is immediately after an alias configured in
200 `nameless-aliases' or `nameless-global-aliases', replace it with
201 the full name for that alias.
202 Otherwise, insert `nameless-current-name'.
204 If NOERROR is nil, signal an error if the alias at point is not
205 configured, or if `nameless-current-name' is nil."
207 (if (string-match (rx (or (syntax symbol)
209 (string (char-before)))
213 (skip-chars-forward "^[:alnum:]")
215 (alias (buffer-substring l r))
216 (full-name (when alias
217 (cdr (or (assoc alias nameless-aliases)
218 (assoc alias nameless-global-aliases))))))
220 (progn (delete-region l r)
221 (insert full-name "-")
224 (user-error "No name for alias `%s', see `nameless-aliases'" alias))))
225 (if nameless-current-name
226 (progn (insert nameless-current-name nameless-separator)
229 (user-error "No name for current buffer, see `nameless-current-name'")))))
231 (defun nameless-insert-name-or-self-insert (&optional self-insert)
232 "Insert the name of current package, with a hyphen."
235 (call-interactively #'self-insert-command)
236 (unless (or self-insert
237 (not nameless-current-name)
238 (eq (char-before l) ?\\)
239 (nameless--in-arglist-p l))
241 (delete-region l (point))
242 (unless (nameless-insert-name 'noerror)
243 (call-interactively #'self-insert-command)))))
245 (put 'nameless-insert-name-or-self-insert 'delete-selection t)
247 (defun nameless--name-regexp (name)
248 "Return a regexp of the current name."
249 (concat "\\_<@?\\(" (regexp-quote name)
250 nameless-separator "\\)\\(\\s_\\|\\sw\\)"))
252 (defun nameless--filter-string (s)
253 "Remove from string S any disply or composition properties.
255 (let ((length (length s)))
256 (remove-text-properties 0 length '(composition nil display nil) s)
259 (defun nameless--after-hack-local-variables ()
260 "Set font-lock-keywords after `hack-local-variables-hook'."
261 (nameless--remove-keywords)
262 (apply #'nameless--add-keywords
263 `(,@(when nameless-current-name
264 `((nil . ,nameless-current-name)))
265 ,@nameless-global-aliases
266 ,@nameless-aliases)))
271 (define-minor-mode nameless-mode
272 nil nil " :" `((,(kbd "C-c C--") . nameless-insert-name))
275 (when (and (not nameless-current-name)
276 nameless-discover-current-name
277 (ignore-errors (string-match "\\.el\\'" (lm-get-package-name))))
278 (setq nameless-current-name
279 (replace-regexp-in-string "\\(-mode\\)?\\(-tests?\\)?\\.[^.]*\\'" "" (lm-get-package-name))))
280 (add-function :filter-return (local 'filter-buffer-substring-function)
281 #'nameless--filter-string)
282 (nameless--after-hack-local-variables)
283 (add-hook 'hack-local-variables-hook
284 #'nameless--after-hack-local-variables
286 (remove-function (local 'filter-buffer-substring-function)
287 #'nameless--filter-string)
288 (remove-hook 'hack-local-variables-hook
289 #'nameless--after-hack-local-variables
291 (nameless--remove-keywords)))
294 (define-obsolete-function-alias 'nameless-mode-from-hook 'nameless-mode "1.0.0")
297 ;;; nameless.el ends here