michael/lean2
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fix(emacs/lean-company): repaint background in the candidate only when required

Browse source
This commit is contained in:
Soonho Kong 2014-09-11 13:38:29 -07:00
parent 389fe02597
commit 0b507777f9
1 changed files with 30 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
src/emacs/lean-company.el
View file

@ -143,28 +143,35 @@ rep. Then, add text-properties on the replaced region."
(replace-regex-return-position regex rep result m-end))))) (replace-regex-return-position regex rep result m-end)))))
result)) result))
(defadvice company-fill-propertize (eval-after-load 'company
(after lean-company-fill-propertize activate) '(defadvice company-fill-propertize
(when (eq major-mode 'lean-mode) (after lean-company-fill-propertize activate)
(let* ((selected (ad-get-arg 3)) (when (eq major-mode 'lean-mode)
(properties `(face (:foreground ,(face-foreground 'font-lock-keyword-face) (let* ((selected (ad-get-arg 3))
:background ,(face-background (if selected 'company-tooltip-selection (foreground-color (face-foreground 'font-lock-keyword-face))
'company-tooltip))) (background-color (if selected (face-background 'company-tooltip-selection)
mouse-face company-tooltip)) (face-background 'company-tooltip)))
(old-return ad-return-value) (face-attrs
(old-len (length old-return)) (cond (background-color `(:foreground ,foreground-color
new-return new-len) :background ,background-color))
(setq new-return (t `(:foreground ,foreground-color))))
(replace-regex-add-properties-all (properties `(face ,face-attrs
(rx "?" word-start (group (+ (not white))) word-end) mouse-face company-tooltip))
"\\1" (old-return ad-return-value)
ad-return-value (old-len (length old-return))
properties)) new-return new-len)
(setq new-len (length new-return)) (setq new-return
(while (< (length new-return) old-len) (replace-regex-add-properties-all
(setq new-return (rx "?" word-start (group (+ (not white))) word-end)
(concat new-return " "))) "\\1"
(add-text-properties new-len old-len properties new-return) ad-return-value
(setq ad-return-value new-return)))) properties))
(setq new-len (length new-return))
(while (< (length new-return) old-len)
(setq new-return
(concat new-return " ")))
(when background-color
(add-text-properties new-len old-len properties new-return))
(setq ad-return-value new-return)))))
(provide 'lean-company) (provide 'lean-company)