Re: `completion-in-region'

[Leo <sdl.web@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 4227 bytes --]

On 2010-04-09 04:05 +0100, Stefan Monnier wrote:
>> completion-in-region allows a complete customise of its behaviour
>> through completion-in-region-functions.  But minibuffer-message blocks
>> execution for minibuffer-message-timeout seconds (default to 2) unless
>> there's input from user.
>
> Yes, that's a known problem in minibuffer-message, indeed.

Thanks.

> Patches welcome.
>> For example if I define my own:
>> (defun my-completion-in-region (next-fun start end collection predicate)
>>   (when (funcall next-fun start end collection predicate)
>>   BODY))
>
>> BODY will only be executed after 2 seconds that gives a false slow user
>> experience. I can work around this problem by let-binding
>> minibuffer-message-timeout to 0. But I think some improvement can be done
>> here.
>
> completion-in-region-functions is indeed meant for situations where you
> want to either completely replace the completion UI with some other one
> (à la completion-ui.el), or where you want to let-bind some completion
> variables.  But indeed, it hasn't been used much yet, so maybe a better
> interface would make sense.

BTW, some modern text editors (such as textmate) have started offering
fuzzy completion as default.

>> The above comments are based on my experience to write two
>> completions: one for TeX: I want the completion to automatically
>> include a 'close' string (i.e.  {} for LaTeX macros etc.), I can write
>> a function for completion-at-point-functions which returns '(beg end
>> completion-function) and do the adding in completion-function but it
>> is difficult to control the position of point so that it locates
>> between {}.
>
> Could you expand on what problems you've encountered when trying to add
> it in completion-function?  You may want to check how I used
> completion-table-with-terminator in pcomplete.el for that same kind
> of situation.

I was trying to return a list of (beg end collections) and let
completion-in-region do the job. But in the end I did something like
this:

(defun TeX-completion-at-point ()
  (let ((list TeX-complete-list) entry)
    (while list
      (setq entry (car list)
          list (cdr list))
      (if (TeX-looking-at-backward (car entry) 250)
        (setq list nil)))
    ;; ignore the useless ispell completion
    (when (numberp (nth 1 entry))
      (when (looking-at "\\w")
        (forward-word 1))
      (TeX-complete-symbol)
      ;; try leaving point in between parenthesis
      (when (looking-back "\\s)" (line-beginning-position))
        (skip-syntax-backward ")"))
      ;; this is discouraged
      ;; return a function that does nothing
      'ignore)))

I haven't used pcomplete before so I will look at it later on.

>> Another solution is to customise completion-in-region through
>> completion-in-region-functions but I need to isolate the interference
>> between functions in completion-in-region-functions.
>
> That doesn't seem like a good approach to add a terminating }
>
>> Another for snippet (similar to abbrev), complete the snippet (abbrev) and
>> then expand if completion succeeds.
>
> Hmm... I do not understand the above two lines.  They seem to lack
> context or something.

I am re-designing snippet.el
(http://www.emacswiki.org/emacs/SnippetMode) to tightly integrate with
abbrev. Emacs has abbreviation feature for a very long time but it
hasn't advanced much. 'snippet' is a substantial step forward. It was
original introduced in textmate and becomes so popular that almost all
text editors have it now.

For example, with the attached package, one can define an abbrev 'li' to
expand to <li>$.</li> and when expanded it will be '<li>|</li>'. |
indicates where the point is. See `global-snippet-abbrev-mode'. When
this mode is on abbrev expansion will be processed by snippet-region.

I have added nesting snippets, better undo support and removed all known
bugs in the original snippet.el. The package is still compact and clean
with around 500 lines of code.

The completion I was talking about was for function
`snippet-completion-at-point' which completes abbrevs and do the
expansion if the completed string is an abbrev name; the abbrev
expansion is then processed by snippet-region.

>         Stefan

Leo


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: snippet.el --]
[-- Type: text/x-emacs-lisp, Size: 20771 bytes --]

;;; snippet.el -- insert snippets of text into a buffer

;; Copyright (c) 2005 Pete Kazmier
;; Copyright (c) 2009, 2010 Leo

;; Version: 0.27
;; Author: Pete Kazmier, Leo

;; The maximum version number is 0.618 and is used when snippet
;; reaches perfectness.

;; This file is not part of GNU Emacs, but it is distributed under
;; the same terms as GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 3, or (at your
;; option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;; Code:

(eval-when-compile (require 'cl))

(defgroup snippet nil
  "Insert a template with fields that con contain optional defaults."
  :prefix "snippet-"
  :group 'abbrev
  :group 'convenience)

(defface snippet-bound-face
  '((t (:inherit bold)))
  "Face used for the body of the current snippet."
  :group 'snippet)

(defface snippet-field-face
  '((t (:inherit highlight)))
  "Face used for the fields of the current snippet."
  :group 'snippet)

(defface snippet-bound-face-inactive
  '((t (:inherit shadow)))
  "Face used for inactive snippets."
  :group 'snippet)

(defface snippet-field-face-inactive
  '((t (:inherit shadow)))
  "Face used for the fields of inactive snippet."
  :group 'snippet)

(defcustom snippet-field-identifier "$$"
  "String used to identify field placeholders."
  :type 'string
  :group 'snippet)

(defcustom snippet-exit-identifier "$."
  "String used to identify the exit point of the snippet."
  :type 'string
  :group 'snippet)

(defcustom snippet-field-default-beg-char ?{
  "Character used to identify the start of a field's default value."
  :type 'character
  :group 'snippet)

(defcustom snippet-field-default-end-char ?}
  "Character used to identify the stop of a field's default value."
  :type 'character
  :group 'snippet)

(defcustom snippet-indent "$>"
  "String used to indicate that a line is to be indented."
  :type 'string
  :group 'snippet)

(defstruct snippet
  "Structure containing the overlays used to display a snippet.

The BOUND slot contains an overlay to bound the entire text of the
template. This overlay is used to provide a different face
configurable via `snippet-bound-face' as well as the keymap that
enables tabbing between fields.

The FIELDS slot contains a list of overlays used to indicate the
position of each field. In addition, if a field has a default, the
field overlay is used to provide a different face configurable via
`snippet-field-face'.

The EXIT-MARKER slot contains a marker where point should be placed
after the user has cycled through all available fields."
  bound fields exit-marker)

(defvar snippet-stack nil
  "A stack holds existing snippets in the current buffer.")

(defvar snippet-current nil
  "Current active snippet i.e. the head of `snippet-stack'.")

(make-variable-buffer-local 'snippet-stack)
(make-variable-buffer-local 'snippet-current)

(defvar snippet-map (make-sparse-keymap)
  "Keymap used while the point is located within a snippet.")

;; Default key bindings
(define-key snippet-map (kbd "RET")             'snippet-exit-snippet)
(define-key snippet-map (kbd "TAB")             'snippet-next-field)
(define-key snippet-map (kbd "<backtab>")       'snippet-prev-field)
(define-key snippet-map (kbd "<S-tab>")         'snippet-prev-field)
(define-key snippet-map (kbd "<S-iso-lefttab>") 'snippet-prev-field)
(define-key snippet-map [remap self-insert-command] 'snippet-field-insert)
;; when snippet is not hooked into abbrev we need a key to trigger
;; nesting snippets
(define-key snippet-map (kbd "M-TAB")           'snippet-completion-at-point)

(defun snippet-field-insert (&optional arg)
  "A replacement for `self-insert-command' in `snippet-map'.
Find the field that belongs to current snippet at point. If point
is located at the start of the field, delete the region between
the field."
  (interactive "p")
  (let ((field (loop for o in (overlays-at (point))
                     when (memq o (snippet-fields snippet-current))
                     return o)))
    (when (and (overlayp field)
               (= (point) (overlay-start field)))
      (delete-region (point) (overlay-end field))))
  (self-insert-command arg))

(defun snippet-make-bound-overlay ()
  "Create an overlay to bound a snippet.
Add the appropriate properties for the overlay to provide: a face used
to display the snippet, the keymap to use while within the snippet,
and the modification hooks to clean up the overlay in the event it is
deleted."
  (let ((bound (make-overlay (point) (point) (current-buffer) nil t)))
    (overlay-put bound 'priority (1+ (length snippet-stack)))
    (overlay-put bound 'keymap snippet-map)
    (overlay-put bound 'face 'snippet-bound-face)
    (overlay-put bound 'modification-hooks '(snippet-bound-modified))
    bound))

(defun snippet-make-field-overlay (&optional name)
  "Create an overlay for a field in a snippet.
Add the appropriate properties for the overlay to provide: a face used
to display a field's default value, and modification hooks to remove
the default text if the user starts typing."
  (let ((field (make-overlay (point) (point) (current-buffer) nil t)))
    (overlay-put field 'priority (length snippet-stack))
    (overlay-put field 'face 'snippet-field-face)
    (overlay-put field 'insert-in-front-hooks '(snippet-field-update))
    (overlay-put field 'insert-behind-hooks '(snippet-field-update))
    (overlay-put field 'modification-hooks '(snippet-field-update))
    (overlay-put field 'name (when name (make-symbol name)))
    field))

(defun snippet-decorate (snippet how)
  "Decorate SNIPPET in a way specified by HOW."
  (let ((bound (snippet-bound snippet))
        (fields (snippet-fields snippet)))
    (overlay-put bound 'face
                 (if (memq how '(t active))
                     'snippet-bound-face
                   'snippet-bound-face-inactive))
    (dolist (field fields)
      (overlay-put field 'face (if (memq how '(t active))
                                   'snippet-field-face
                                 'snippet-field-face-inactive)))))

(defun snippet-fields-with-name (name)
  "Return a list of fields whose name property is equal to NAME."
  (loop for field in (snippet-fields snippet-current)
        when (string= name (symbol-name (overlay-get field 'name)))
        collect field))

(defun snippet-bound-modified (bound after beg end &optional change)
  "Ensure the overlay that bounds a snippet is cleaned up.
This modification hook is triggered when the overlay that bounds the
snippet is modified. It runs after the change has been made and
ensures that if the snippet has been deleted by the user, the
appropriate cleanup occurs."
  (when (and after (= (overlay-start bound) (overlay-end bound)))
    (snippet-cleanup)))

(defun snippet-field-update (field after beg end &optional change)
  "Update all fields that have the same name.
This modification hook is triggered when a user edits any field and is
responsible for updating all other fields that share a common name."
  (when (and after (= (overlay-get field 'priority) (length snippet-stack)))
    (let ((name (overlay-get field 'name))
          (value (buffer-substring (overlay-start field) (overlay-end field)))
          (inhibit-modification-hooks t))
      (when name
        (setq name (symbol-name name))
        (save-excursion
          (dolist (like-field (remq field (snippet-fields-with-name name)))
            (goto-char (overlay-start like-field))
            (delete-region (overlay-start like-field)
                           (overlay-end like-field))
            (insert value)))))))

(defun snippet-exit-snippet ()
  "Move point to `snippet-exit-identifier' or end of bound.
If the snippet has defined `snippet-exit-identifier' in the template,
move the point to that location. Otherwise, move it to the end of the
snippet."
  (interactive)
  (goto-char (snippet-exit-marker snippet-current))
  (snippet-cleanup))

(defun snippet-next-field ()
  "Move point forward to the next field in the `snippet'.
If there are no more fields in the snippet, point is moved to the end
of the snippet or the location specified by `snippet-exit-identifier',
and the snippet reverts to normal text."
  (interactive)
  (let* ((bound (snippet-bound snippet-current))
         (fields (snippet-fields snippet-current))
         (exit (snippet-exit-marker snippet-current))
         (next-pos (loop for field in fields
                         for start = (overlay-start field)
                         when (< (point) start) return start)))
    (if (not (null next-pos))
        (goto-char next-pos)
      (goto-char exit)
      (snippet-cleanup))))

(defun snippet-prev-field ()
  "Move point backward to the previous field in the `snippet'.
If there are no more fields in the snippet, point is moved to the end
of the snippet or the location specified by `snippet-exit-identifier',
and the snippet reverts to normal text."
  (interactive)
  (let* ((bound (snippet-bound snippet-current))
         (fields (snippet-fields snippet-current))
         (exit (snippet-exit-marker snippet-current))
         (prev-pos (loop for field in (reverse fields)
                         for start = (overlay-start field)
                         when (> (point) start) return start)))
    (if (not (null prev-pos))
        (goto-char prev-pos)
      (goto-char exit)
      (snippet-cleanup))))

(defun snippet-cleanup ()
  "Delete all overlays associated with `snippet'.
This effectively reverts the snippet to normal text in the buffer."
  (when (snippet-p snippet-current)
    (delete-overlay (snippet-bound snippet-current))
    (dolist (field (snippet-fields snippet-current))
      (delete-overlay field))
    ;; make marker point nowhere (info "(elisp)Overview of Markers")
    (set-marker (snippet-exit-marker snippet-current) nil)
    (pop snippet-stack)
    (setq snippet-current (car snippet-stack))
    (when (snippet-p snippet-current)
      (message "Snippet %d" (length snippet-stack))
      (snippet-decorate snippet-current 'active))))

(defun snippet-field-regexp ()
  "Return a regexp that is used to search for fields within a template."
  (let ((beg (char-to-string snippet-field-default-beg-char))
        (end (char-to-string snippet-field-default-end-char)))
    (concat (regexp-quote snippet-field-identifier)
            "\\("
            (regexp-quote beg)
            "\\([^"
            (regexp-quote end)
            "]+\\)"
            (regexp-quote end)
            "\\)?")))

(defun snippet-region (beg end)
  (let ((inhibit-modification-hooks t))
    (when (snippet-p snippet-current)
      (snippet-decorate snippet-current 'inactive))
    (push (make-snippet :bound (snippet-make-bound-overlay)) snippet-stack)
    (setq snippet-current (car snippet-stack))
    (move-overlay (snippet-bound snippet-current) beg end)
    (save-restriction
      (narrow-to-region beg end)
      ;; process exit marker
      (goto-char (point-min))
      (while (re-search-forward (regexp-quote snippet-exit-identifier) nil t)
        (replace-match "")
        (unless (markerp (snippet-exit-marker snippet-current))
          (setf (snippet-exit-marker snippet-current) (point-marker))))

      (unless (markerp (snippet-exit-marker snippet-current))
        (setf (snippet-exit-marker snippet-current) (copy-marker (point-max))))

      (set-marker-insertion-type (snippet-exit-marker snippet-current) t)

      ;; process fields
      (goto-char (point-min))
      (while (re-search-forward (snippet-field-regexp) nil t)
        (let ((field (snippet-make-field-overlay (match-string 2)))
              (start (match-beginning 0)))
          (push field (snippet-fields snippet-current))
          (replace-match (if (match-beginning 2) "\\2" ""))
          (move-overlay field start (point))))

      ;; These are reversed so they are in the order appeared in the
      ;; template as we index into this list when cycling field to
      ;; field.
      (setf (snippet-fields snippet-current) (reverse (snippet-fields snippet-current)))

      ;; done at the final step of the processing since snippet
      ;; identifiers may confuse the major mode about indentation.
      (goto-char (point-min))
      (while (re-search-forward (regexp-quote snippet-indent) nil t)
        (replace-match "")
        (indent-according-to-mode)))

    ;; positioning
    (let ((first (car (snippet-fields snippet-current))))
      (if first
          (goto-char (overlay-start first))
        (snippet-exit-snippet)))
    ;; support undo: exit snippet processing when undo
    (push '(apply (lambda ()
                    (when (snippet-p snippet-current)
                      (snippet-exit-snippet)))) buffer-undo-list)
    (when (snippet-p snippet-current)
      (message "Snippet %d" (length snippet-stack)))))

;;;###autoload
(defun snippet-insert (template)
  "Insert a snippet into the current buffer at point.
TEMPLATE is a string that may optionally contain fields which are
specified by `snippet-field-identifier'. Fields may optionally also
include default values delimited by `snippet-field-default-beg-char'
and `snippet-field-default-end-char'.

For example, the following template specifies two fields which have
the default values of \"element\" and \"sequence\":

  \"for $${element} in $${sequence}:\"

In the next example, only one field is specified and no default has
been provided:

  \"import $$\"

This function may be called interactively, in which case, the TEMPLATE
is prompted for. However, users do not typically invoke this function
interactively, rather it is most often called as part of an expansion."
  (interactive "sSnippet template: ")
  (let ((beg (point)))
    (insert template)
    (snippet-region beg (point))))

;;;###autoload
(defun snippet-insert-file (file &optional no-guess)
  "Insert FILE in current buffer and process it as a snippet.
NO-GUESS means do not guess major mode for FILE."
  (interactive "fInsert file: ")
  (insert-file-contents file)
  (unless no-guess
    (let ((buffer-file-name file))
      (set-auto-mode t)))
  (snippet-region (point-min) (point-max))
  (hack-local-variables))

;;;; -------- abbrev integration --------
;; c.f. http://permalink.gmane.org/gmane.emacs.help/62887
(put 'snippet-expand-abbrev 'no-self-insert t)
(defun snippet-expand-abbrev (expander)
  "Call EXPANDER and process the expansion as snippet.
A function intended to be used in `abbrev-expand-functions'."
  (when (funcall expander)
    (let ((posn (point))
          (result last-abbrev))
      (snippet-region last-abbrev-location (point))
      (when (/= posn (point))           ; point has moved
        ;; use uninterned symbol to avoid modifying the abbrev
        (setq result (make-symbol "snippet-expand"))
        ;; return a symbol whose symbol-function has a non-nil
        ;; `no-self-insert' property
        (fset result 'snippet-expand-abbrev))
      result)))

;;;###autoload
(define-minor-mode snippet-abbrev-mode
  "Toggle Snippet-Abbrev mode in current buffer.
With optional argument ARG, turn Snippet-Abbrev mode on if ARG is
positive, otherwise turn it off. In Snippet-Abbrev mode, abbrev
expansion will be treated as a snippet insertion."
  :lighter ""
  (if snippet-abbrev-mode
      (add-hook 'abbrev-expand-functions 'snippet-expand-abbrev nil 'local)
    (remove-hook 'abbrev-expand-functions 'snippet-expand-abbrev 'local)))

;;;###autoload
(define-globalized-minor-mode global-snippet-abbrev-mode snippet-abbrev-mode
  (lambda () (snippet-abbrev-mode t)))
;;;; -------- abbrev integration end --------

(defcustom snippet-default-regexp "\\(\\s_\\|\\sw\\)+"
  "Default regexp used to find the snippet at point. If it is
nil, word at point is used."
  :type 'regexp
  :group 'snippet)

;;;###autoload
(defun define-snippets (snippets &optional enable-function snippet-regexp)
  "Define snippets.
Each entry in SNIPPETS has the form:
   (NAME EXPANSION &optional HOOK &rest PROPS)
See `define-abbrev' for explanation on each item.

ENABLE-FUNCTION is a function with no arguments that will be the
default value of the abbrev property :enable-function.
SNIPPET-REGEXP defaults to the value of `snippet-default-regexp'
and is used to find snippet at point."
  (let (abbrevs-changed)
    (abbrev-table-put local-abbrev-table
                      :snippet-regexp (or snippet-regexp snippet-default-regexp))
    (mapc
     (lambda (snippet)
       (let* ((name (apply 'define-abbrev local-abbrev-table snippet))
              (symbol (abbrev-symbol name local-abbrev-table)))
         (when symbol
           (abbrev-put symbol :system t)
           (and enable-function
                (unless (abbrev-get symbol :enable-function)
                  (abbrev-put symbol :enable-function enable-function))))))
     snippets)))

(defun snippet-completion-at-point ()
  ;; check `abbrev--before-point' also
  (interactive)
  (let ((tables (abbrev--active-tables))
        (abbrevs (make-vector 59 0))
        start end res regexp comp all)
    (if abbrev-start-location           ; for `abbrev-prefix-mark'
        (setq start (1+ abbrev-start-location)
              end (point))
      (setq regexp (abbrev-table-get local-abbrev-table :snippet-regexp))
      (if (null regexp)
          (progn (backward-word 1)
                 (setq start (point))
                 (forward-word 1)
                 (setq end (point)))
        (while (looking-at regexp)
          (forward-char 1))
        (when (looking-back regexp (line-beginning-position) t)
          (setq start (match-beginning 0)
                end (match-end 0)))))
    (when (and start end)
      ;; the parent tables are appended which is in different order as
      ;; that of `abbrev--before-point'. This should not be a problem
      ;; since we only need the symbols for completion.
      (loop for table in tables
            for parents = (abbrev-table-get table :parents)
            when parents
            collect parents into parent-tables
            finally (setq tables (append parent-tables tables)))
      (loop for table in tables
            for enable-function = (abbrev-table-get table :enable-function)
            do (when (or (null enable-function) (funcall enable-function))
                 (mapatoms (lambda (abbrev)
                             (let ((enable-fun (abbrev-get abbrev :enable-function)))
                               (when (or (null enable-fun) (funcall enable-fun))
                                 (intern (symbol-name abbrev) abbrevs))))
                           table)))
      (let (completion-in-region-functions (minibuffer-message-timeout 0))
        (setq res (completion-in-region start end abbrevs)
              comp (buffer-substring start (point))))
      ;; returning a function is discouraged; see doc string of
      ;; `completion-at-point-functions'; we use this to avoid using
      ;; `completion-in-region-functions'.
      (when res (setq res 'ignore))
      (when (and res (intern-soft comp abbrevs))
        ;; if not unique show other snippets
        (setq all (all-completions comp abbrevs))
        (unless (eq (length all) 1)
          (message "Other snippet(s): %s" (mapconcat 'identity (delete comp all) " ")))
        (push (cons comp (- start)) buffer-undo-list)
        (let ((buffer-undo-list t))
          ;; make sure expand-abbrev finds the same symbol as the completion
          (save-excursion (goto-char start) (abbrev-prefix-mark t))
          (let (abbrev-expand-functions) (expand-abbrev)))
        (push (cons start (point)) buffer-undo-list)
        (snippet-region start (point))))
    res))

;;;###autoload
(define-minor-mode snippet-mode
  "A minor mode for snippet.
When this mode is on, completion is done through
`completion-at-point' which is normally bound to M-TAB. TAB
completion can be conveniently enabled through variable
`tab-always-indent'.

When you are processing a snippet, the following key bindings are
available:

\\{snippet-map}"
  :lighter " Snip"
  (if snippet-mode
      (add-hook 'completion-at-point-functions 'snippet-completion-at-point nil 'local)
    (remove-hook 'completion-at-point-functions 'snippet-completion-at-point 'local)))

(provide 'snippet)