Last active
October 6, 2016 08:23
-
-
Save FrancisMurillo/628fcad0552f4b3396a60c7a0997bbe2 to your computer and use it in GitHub Desktop.
My custom helm completion for projectile
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(require 'dash) | |
(require 's) | |
(require 'f) | |
(defface fmc/completion-label-face '((t (:weight bold :height 1.1))) | |
"Label face") | |
(defface fmc/completion-delimiter-face '((t (:weight light :height 0.9))) | |
"Delimiter face") | |
(defface fmc/completion-description-face '((t (:weight extra-light :height 0.9))) | |
"Description face") | |
(defvar fmc/completion-label-face 'fmc/completion-label-face | |
"Label face var") | |
(defvar fmc/completion-delimiter-face 'fmc/completion-delimiter-face | |
"Delimiter face var") | |
(defvar fmc/completion-description-face 'fmc/completion-description-face | |
"Description face var") | |
(defconst fmc/reverse-notation-separator ".." | |
"My reversed separator") | |
(defconst fmc/completion-separator ">>" | |
"My completion separator") | |
(defun fmc/uniquify-project-paths (project-paths) | |
"Customize how projectile files and more are displayed by PROJECT-PATHS" | |
(lexical-let* | |
((fn-notation | |
(lambda (path) | |
(lexical-let ((fn-pieces (f-split path))) | |
(string-join (reverse fn-pieces) fmc/reverse-notation-separator)))) | |
(relative-parent-path | |
(lambda (path relative-path) | |
(lexical-let | |
((split-path (f-split path)) | |
(split-relative-path (f-split relative-path))) | |
(string-join | |
(-drop-last (length split-relative-path) split-path) | |
(f-path-separator))))) | |
(as-pair | |
(lambda (ish) | |
(if (listp ish) | |
ish (cons ish ish)))) | |
(map-car | |
(lambda (f pair) | |
(cons (funcall f (car pair)) | |
(cdr pair)))) | |
(pair-as-label | |
(lambda (pairs) | |
(lexical-let* | |
((display-formatter | |
(lambda (name description) | |
(format "%-s %s %-s" | |
(propertize name 'font-lock-face 'fmc/completion-label-face) | |
(propertize fmc/completion-separator 'font-lock-face 'fmc/completion-separator) | |
(propertize description 'font-lock-face 'fmc/completion-description-face))))) | |
(lambda (pair) | |
(lexical-let* | |
((unique-path (car pair)) | |
(full-path (cdr pair)) | |
(parent-path | |
(funcall relative-parent-path | |
full-path | |
unique-path)) | |
(display-name | |
(funcall fn-notation unique-path)) | |
(display-description | |
(funcall fn-notation parent-path)) | |
(display-label | |
(funcall display-formatter | |
display-name | |
display-description))) | |
(cons display-label (cdr pair))))))) | |
(uniquify-paths | |
(lambda (paths) | |
;; Ideally, this is just f-uniquify-alist but there is a minor contrivance | |
(lexical-let* | |
((is-dir | |
(lambda (path) | |
(string-equal (f-path-separator) | |
(s-right 1 path)))) | |
(swap-pair (lambda (pair) | |
(cons (cdr pair) (car pair)))) | |
(map-pair | |
(lambda (f pair) | |
(cons (funcall f (car pair)) (funcall f (cdr pair))))) | |
(remove-last-separator | |
(lambda (text) | |
(s-left (1- (length text)) text))) | |
(add-separator | |
(lambda (text) | |
(concat text (f-path-separator))))) | |
(mapcar (-compose | |
swap-pair) | |
(if (-any is-dir paths) | |
;; Remove separator, uniquify and add separator back | |
;; Weird performance shiznit | |
(funcall | |
(-compose | |
(-partial #'mapcar (-partial map-pair add-separator)) | |
#'f-uniquify-alist | |
(-partial #'mapcar remove-last-separator)) | |
paths) | |
(f-uniquify-alist paths)))))) | |
(refined-paths (funcall uniquify-paths project-paths))) | |
(mapcar (-compose | |
(funcall pair-as-label refined-paths) | |
as-pair) | |
refined-paths))) | |
(require 'helm) | |
(defun fmc/custom-helm-completion (prompt choices) | |
"This custom projectile completion with helm does two things: | |
first it reverses the file path to emphasize the file name, | |
secondly it uniquifies the paths via `f-uniquify-alist', | |
optionally some extra coloring. | |
I would like to use `completing-read' but it does not handle | |
propertized alist well. You can remove the `propertize' from `display-formatter' | |
but that is a deal breaker for me." | |
(helm-comp-read prompt | |
(fmc/uniquify-project-paths choices) | |
:must-match t)) | |
(setq projectile-completion-system #'fmc/custom-helm-completion) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Screenshot