anything-show-completion+.el

;;; Basic anything-show-completion+ machinery.
(defvar anything-show-completion+-display-function
  'anything-show-completion-display-function)
(defun anything-show-completion+-display-function (buf)
  (funcall anything-show-completion+-display-function buf))
(defun use-anything-show-completion+-display-function (function)
  (eval
   `(defadvice ,function (around anything-show-completion+ activate)
      ;; Hijack `asc-display-function' to replace it with
      ;; `anything-show-completion+-display-function',
      ;; and backup it as `anything-show-completion-display-function'.
      (letf*
          (((symbol-function 'anything-show-completion-display-function)
            (symbol-function 'asc-display-function))
           ((symbol-function 'asc-display-function)
            (symbol-function 'anything-show-completion+-display-function)))
        ad-do-it))))

;;; The `scroll' stuff.
(defvar anything-show-completion+-scroll-height-percent 50
  "A percentage of the anything-buffer's display height that will be
preserved when this `anything-display-function' splits the window.")
(defvar anything-show-completion+-scroll-back-to-percent
  anything-show-completion+-scroll-height-percent
  "A percentage of the anything-current-buffer's display height that will be
scrolled up back when this `anything-display-function' splits the window.")

(defvar asc+-scroll 0
  "Hold the state of the scrolled-upped value.")
(defun asc+-scroll-display-function (buf)
  (save-excursion
    (setq asc+-scroll 0)
    (asc+-scroll-up-maybe)
    (let ((split-window-keep-point))
      (split-window-vertically (max window-min-height
                                    (1+ (count-screen-lines (window-start)
                                                            (point)))))
      (other-window 1)
      (switch-to-buffer buf))))
(defun asc+-scroll-up-maybe ()
  (let* ((lc (count-screen-lines (window-start) (point)))
         (v (truncate (/ (* 100 lc) (window-height)))))
    (when (< anything-show-completion+-scroll-height-percent v)
      (let ((up
             (- lc
                (truncate
                 (* (window-height)
                    (/ anything-show-completion+-scroll-back-to-percent
                       100.0))))))
        (setq asc+-scroll up)
        (scroll-up up)))))

(defun asc+-scroll (any-buffer)
  (let ((ncandidates (or (anything-aif any-buffer
                             (let ((anything-buffer it))
                               (anything-approximate-candidate-number)))
                         -1)))
    (unless (or (zerop asc+-scroll)
                (= 1 ncandidates))
      (asc+-scroll-up asc+-scroll))))
(defun asc+-scroll-up (up)
  (cond ((eq major-mode 'term-mode)
         (asc+-term-scroll-up up))
        (t (scroll-up up))))
(defun* asc+-term-scroll-up (count &optional (buffer anything-current-buffer))
  "Specialized scroll-up function for the `ansi-term'"
  (with-current-buffer buffer
    (with-selected-window (get-buffer-window (current-buffer))
      (save-excursion
        (scroll-up count)
        (goto-char term-home-marker)
        (forward-line count)
        (set-marker term-home-marker (point))
        (setq term-current-row (- term-current-row count))))))

;; Entry point for an experiment.
(defun use-anything-show-completion+-scroll (function any-buffer-name)
  (use-anything-show-completion+-display-function function)
  (eval
   `(defadvice ,function (around anything-show-completion+-scroll activate)
      (let ((anything-show-completion+-display-function
             'asc+-scroll-display-function))
        (prog1 ad-do-it
          (asc+-scroll ,any-buffer-name))))))

(defvar anything-show-completion+-scroll-alist
  '(;;
    (anything-zsh-screen-complete . "*anything zsh screen*")
    ;; (install-elisp-from-emacswiki "anything-dabbrev-expand.el")
    (anything-dabbrev-expand-main . "*anything dabbrev*")
    ;; (install-elisp-from-emacswiki "anything-complete.el")
    (anything-lisp-complete-symbol . "*anything complete*")
    (anything-lisp-complete-symbol-partial-match . "*anything complete*")
    (anything-complete . "*anything complete*")))

(defun* use-anything-show-completion+-scroll*
    (&optional (anything-show-completion+-scroll-alist
                anything-show-completion+-scroll-alist))
  (loop for (f . b) in anything-show-completion+-scroll-alist
        do (use-anything-show-completion+-scroll f b)))

;;; Fallback stuff.
(defun asc+-fallbacksource (&rest fallbacks)
  `((name . "Anything complete fallback")
    (candidates "dummy")
    (match identity)
    (requires-pattern . 1)
    (filtered-candidate-transformer
     . (lambda (_candidates _source)
         (list (overlay-get asc-overlay 'display)
               anything-pattern
               ,@fallbacks)))))

(defvar anything-show-completion+-fallback-alist
  '(;; (install-elisp-from-emacswiki "anything-dabbrev-expand.el")
    (anything-dabbrev-sources
     anything-dabbrev-last-target
     (action . anything-dabbrev-insert-candidate))
    ;; (install-elisp-from-emacswiki "anything-complete.el")
    (anything-lisp-complete-symbol-sources
     anything-complete-target
     (action . ac-insert))))

(defun* anything-show-completion+-add-fallbacks-to-sources
    (ssym target action)
  (add-to-list ssym
               (append (asc+-fallbacksource target)
                       (list action))
               t))

(defun* anything-show-completion+-add-fallbacks*
    (&optional (anything-show-completion+-fallback-alist
                anything-show-completion+-fallback-alist))
  (loop for (ssym target action) in
        anything-show-completion+-fallback-alist
        do (anything-show-completion+-add-fallbacks-to-sources ssym
                                                               target
                                                               action)))

(provide 'anything-show-completion+)