X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/a1c9e99bb40cec84026ee23e368458ae9a0852bd..f10533854f4c7bb54247a11981191bf37b70cb36:/packages/nameless/nameless.el diff --git a/packages/nameless/nameless.el b/packages/nameless/nameless.el index 6737aa0fc..3f2175676 100644 --- a/packages/nameless/nameless.el +++ b/packages/nameless/nameless.el @@ -3,8 +3,9 @@ ;; Copyright (C) 2015 Free Software Foundation, Inc. ;; Author: Artur Malabarba +;; URL: https://github.com/Malabarba/nameless ;; Keywords: convenience, lisp -;; Version: 0.3.1 +;; Version: 1.0.1 ;; Package-Requires: ((emacs "24.4")) ;; This program is free software; you can redistribute it and/or modify @@ -58,8 +59,8 @@ use commonly. To apply aliases specific to a file, set the Each element of this list should have the form (ALIAS . NAMESPACE), both strings. For example, if you set this variable to ((\"fl\" . \"font-lock\")) -then expressions like `(font-lock-add-keywords nil kwds)' will -displayed as `(fl/add-keywords nil kwds)' instead. +then expressions like (font-lock-add-keywords nil kwds) will be +displayed as (fl/add-keywords nil kwds) instead. Furthermore typing `fl' followed by `\\[nameless-insert-name]' will automatically insert `font-lock-'." @@ -72,6 +73,22 @@ This variable takes the same syntax and has the same effect as those in `nameless-global-aliases'. This variable is designed to be used as a file-local or dir-local variable.") +(put 'nameless-aliases 'safe-local-variable + (lambda (x) (ignore-errors + (let ((safe t)) + (mapc (lambda (cell) + (unless (and (stringp (car cell)) + (stringp (cdr cell))) + (setq safe nil))) + x) + safe)))) + +(defcustom nameless-discover-current-name t + "If non-nil, discover package name automatically. +If nil, `nameless-current-name' must be set explicitly, or left as nil, +in which case only namespaces from `nameless-global-aliases' and +`nameless-aliases' are used." + :type 'boolean) (defface nameless-face '((t :inherit font-lock-type-face)) @@ -87,7 +104,25 @@ After changing this variable, you must reenable `nameless-mode' for it to take effect." :type '(choice (const :tag "Always affect indentation" t) (const :tag "Don't affect indentation" nil) - (const :tag "Only outside strings" 'outside-strings))) + (const :tag "Only outside strings" outside-strings))) +(put 'nameless-current-name 'safe-local-variable #'symbolp) + +(defcustom nameless-private-prefix nil + "If non-nil, private symbols are displayed with a double prefix. +For instance, the function `foobar--internal-impl' will be +displayed as `::internal-impl', instead of `:-internal-impl'." + :type 'boolean) + +(defcustom nameless-separator "-" + "Separator used between package prefix and rest of symbol. +The separator is hidden along with the package name. For +instance, setting it to \"/\" means that `init/bio' will be +displayed as `:bio' (assuming `nameless-current-name' is +\"init\"). The default is \"-\", since this is the +separator recommended by the Elisp manual. + +Value can also be nil, in which case the separator is never hidden." + :type '(choice string (constant nil))) ;;; Font-locking @@ -98,17 +133,26 @@ for it to take effect." (defvar nameless-mode) (defun nameless--compose-as (display) "Compose the matched region and return a face spec." - (when nameless-mode + (when (and nameless-mode + (not (get-text-property (match-beginning 1) 'composition)) + (not (get-text-property (match-beginning 1) 'display))) (let ((compose (save-match-data (and nameless-affect-indentation-and-filling - (or (not (eq nameless-affect-indentation-and-filling 'outside-strings)) - (not (nth 3 (syntax-ppss))))))) - (dis (concat display nameless-prefix))) - (when compose - (compose-region (match-beginning 1) - (match-end 1) - (nameless--make-composition dis))) - `(face nameless-face ,@(unless compose (list 'display dis)))))) + (or (not (eq nameless-affect-indentation-and-filling 'outside-strings)) + (not (nth 3 (syntax-ppss))))))) + (dis (concat display nameless-prefix)) + (beg (match-beginning 1)) + (end (match-end 1)) + (private-prefix (and nameless-private-prefix + (equal nameless-separator (substring (match-string 0) -1))))) + (when private-prefix + (setq beg (match-beginning 0)) + (setq end (match-end 0)) + (setq dis (concat dis nameless-prefix))) + (if compose + (compose-region beg end (nameless--make-composition dis)) + (add-text-properties beg end (list 'display dis))) + '(face nameless-face)))) (defvar-local nameless--font-lock-keywords nil) @@ -123,9 +167,10 @@ for it to take effect." (nameless--ensure)) (defun nameless--add-keywords (&rest r) - "Add font-lock keywords displaying REGEXP as DISPLAY. + "Add font-lock keywords displaying ALIAS as DISPLAY. +ALIAS may be nil, in which case it refers to `nameless-current-name'. -\(fn (regexp . display) [(regexp . display) ...])" +\(fn (alias . display) [(alias . display) ...])" (setq-local font-lock-extra-managed-props `(composition display ,@font-lock-extra-managed-props)) (let ((kws (mapcar (lambda (x) `(,(nameless--name-regexp (cdr x)) 1 (nameless--compose-as ,(car x)) prepend)) r))) @@ -136,16 +181,18 @@ for it to take effect." ;;; Name and regexp (defvar-local nameless-current-name nil) +(put 'nameless-current-name 'safe-local-variable #'stringp) -(defun nameless--in-arglist-p () - "Is point inside an arglist?" +(defun nameless--in-arglist-p (l) + "Is point L inside an arglist?" (save-excursion + (goto-char l) (ignore-errors (backward-up-list) (or (progn (forward-sexp -1) (looking-at-p "[a-z-]lambda\\_>")) (progn (forward-sexp -1) - (looking-at-p "\\(cl-\\)?def\\(un\\|macro\\|inline\\)\\*?\\_>")))))) + (looking-at-p "\\(cl-\\)?def")))))) (defun nameless-insert-name (&optional noerror) "Insert `nameless-current-name' or the alias at point. @@ -171,11 +218,12 @@ configured, or if `nameless-current-name' is nil." (assoc alias nameless-global-aliases)))))) (if full-name (progn (delete-region l r) - (insert full-name "-")) + (insert full-name "-") + t) (unless noerror (user-error "No name for alias `%s', see `nameless-aliases'" alias)))) (if nameless-current-name - (progn (insert nameless-current-name "-") + (progn (insert nameless-current-name nameless-separator) t) (unless noerror (user-error "No name for current buffer, see `nameless-current-name'"))))) @@ -183,17 +231,23 @@ configured, or if `nameless-current-name' is nil." (defun nameless-insert-name-or-self-insert (&optional self-insert) "Insert the name of current package, with a hyphen." (interactive "P") - (if (or self-insert - (not nameless-current-name) - (eq (char-before) ?\\) - (nameless--in-arglist-p)) - (call-interactively #'self-insert-command) - (or (nameless-insert-name 'noerror) - (call-interactively #'self-insert-command)))) + (let ((l (point))) + (call-interactively #'self-insert-command) + (unless (or self-insert + (not nameless-current-name) + (eq (char-before l) ?\\) + (nameless--in-arglist-p l)) + (undo-boundary) + (delete-region l (point)) + (unless (nameless-insert-name 'noerror) + (call-interactively #'self-insert-command))))) + +(put 'nameless-insert-name-or-self-insert 'delete-selection t) (defun nameless--name-regexp (name) "Return a regexp of the current name." - (concat "\\_<@?\\(" (regexp-quote name) "-\\)\\(\\s_\\|\\sw\\)")) + (concat "\\_<@?\\(" (regexp-quote name) + nameless-separator "\\)\\(\\s_\\|\\sw\\)")) (defun nameless--filter-string (s) "Remove from string S any disply or composition properties. @@ -202,28 +256,42 @@ Return S." (remove-text-properties 0 length '(composition nil display nil) s) s)) +(defun nameless--after-hack-local-variables () + "Set font-lock-keywords after `hack-local-variables-hook'." + (nameless--remove-keywords) + (apply #'nameless--add-keywords + `(,@(when nameless-current-name + `((nil . ,nameless-current-name))) + ,@nameless-global-aliases + ,@nameless-aliases))) + ;;; Minor mode ;;;###autoload (define-minor-mode nameless-mode - nil nil " :" '(("_" . nameless-insert-name-or-self-insert)) + nil nil " :" `((,(kbd "C-c C--") . nameless-insert-name)) (if nameless-mode - (if (or nameless-current-name - (ignore-errors (string-match "\\.el\\'" (lm-get-package-name)))) - (progn - (unless nameless-current-name - (setq nameless-current-name (replace-regexp-in-string "\\.[^.]*\\'" "" (lm-get-package-name)))) - (add-function :filter-return (local 'filter-buffer-substring-function) - #'nameless--filter-string) - (apply #'nameless--add-keywords - `((nil . ,nameless-current-name) - ,@nameless-global-aliases - ,@nameless-aliases))) - (nameless-mode -1)) + (progn + (when (and (not nameless-current-name) + nameless-discover-current-name + (ignore-errors (string-match "\\.el\\'" (lm-get-package-name)))) + (setq nameless-current-name + (replace-regexp-in-string "\\(-mode\\)?\\(-tests?\\)?\\.[^.]*\\'" "" (lm-get-package-name)))) + (add-function :filter-return (local 'filter-buffer-substring-function) + #'nameless--filter-string) + (nameless--after-hack-local-variables) + (add-hook 'hack-local-variables-hook + #'nameless--after-hack-local-variables + nil 'local)) (remove-function (local 'filter-buffer-substring-function) #'nameless--filter-string) - (setq nameless-current-name nil) + (remove-hook 'hack-local-variables-hook + #'nameless--after-hack-local-variables + 'local) (nameless--remove-keywords))) +;;;###autoload +(define-obsolete-function-alias 'nameless-mode-from-hook 'nameless-mode "1.0.0") + (provide 'nameless) ;;; nameless.el ends here