From 94d2fc1815a919734353c942f224db1de4b4fcb8 Mon Sep 17 00:00:00 2001
From: Tom Willemsen
Date: Mon, 7 Mar 2011 09:04:49 +0100
Subject: Django, org

  * Added nxhtml, mostly for django support.

  * Changed some org settings.
---
 emacs.d/nxhtml/util/popcmp.el | 472 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 472 insertions(+)
 create mode 100644 emacs.d/nxhtml/util/popcmp.el

(limited to 'emacs.d/nxhtml/util/popcmp.el')

diff --git a/emacs.d/nxhtml/util/popcmp.el b/emacs.d/nxhtml/util/popcmp.el
new file mode 100644
index 0000000..319145d
--- /dev/null
+++ b/emacs.d/nxhtml/util/popcmp.el
@@ -0,0 +1,472 @@
+;;; popcmp.el --- Completion enhancements, popup etc
+;;
+;; Author: Lennart Borgman
+;; Created: Tue Jan 09 12:00:29 2007
+;; Version: 1.00
+;; Last-Updated: 2008-03-08T03:30:15+0100 Sat
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;;   `ourcomments-util'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program 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 2, or (at your option)
+;; any later version.
+;;
+;; This program 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 this program; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'ourcomments-util nil t))
+
+;;;###autoload
+(defgroup popcmp nil
+  "Customization group for popup completion."
+  :tag "Completion Style \(popup etc)"
+  :group 'nxhtml
+  :group 'convenience)
+
+;; (define-toggle popcmp-popup-completion t
+;;   "Use a popup menu for some completions if non-nil.
+
+;; ***** Obsolete: Use `popcmp-completion-style' instead.
+
+;; When completion is used for alternatives tighed to text at the
+;; point in buffer it may make sense to use a popup menu for
+;; completion.  This variable let you decide whether normal style
+;; completion or popup style completion should be used then.
+
+;; This style of completion is not implemented for all completions.
+;; It is implemented for specific cases but the choice of completion
+;; style is managed generally by this variable for all these cases.
+
+;; See also the options `popcmp-short-help-beside-alts' and
+;; `popcmp-group-alternatives' which are also availabe when popup
+;; completion is available."
+;;   :tag "Popup style completion"
+;;   :group 'popcmp)
+
+(defun popcmp-cant-use-style (style)
+  (save-match-data ;; runs in timer
+    (describe-variable 'popcmp-completion-style)
+    (message (propertize "popcmp-completion-style: style `%s' is not available"
+                         'face 'secondary-selection)
+             style)))
+
+
+
+(defun popcmp-set-completion-style (val)
+  "Internal use, set `popcmp-completion-style' to VAL."
+  (assert (memq val '(popcmp-popup emacs-default company-mode anything)) t)
+  (case val
+    ('company-mode (unless (fboundp 'company-mode)
+                     (require 'company-mode nil t))
+                   (unless (fboundp 'company-mode)
+                     (run-with-idle-timer 1 nil 'popcmp-cant-use-style val)
+                     (setq val 'popcmp-popup)))
+    ('anything     (unless (fboundp 'anything)
+                     (require 'anything nil t))
+                   (unless (fboundp 'anything)
+                     (run-with-idle-timer 1 nil 'popcmp-cant-use-style val)
+                     (setq val 'popcmp-popup))))
+  (set-default 'popcmp-completion-style val)
+  (unless (eq val 'company-mode)
+    (when (and (boundp 'global-company-mode)
+               global-company-mode)
+      (global-company-mode -1))
+    (remove-hook 'after-change-major-mode-hook 'company-set-major-mode-backend)
+    (remove-hook 'mumamo-after-change-major-mode-hook 'mumamo-turn-on-company-mode))
+  (when (eq val 'company-mode)
+    (unless (and (boundp 'global-company-mode)
+                 global-company-mode)
+      (global-company-mode 1))
+    (add-hook 'after-change-major-mode-hook 'company-set-major-mode-backend)
+    (add-hook 'mumamo-after-change-major-mode-hook 'mumamo-turn-on-company-mode)))
+
+;; fix-me: move to mumamo.el
+(defun mumamo-turn-on-company-mode ()
+  (when (and (boundp 'company-mode)
+             company-mode)
+    (company-mode 1)
+    (company-set-major-mode-backend)))
+
+;;;###autoload
+(defcustom popcmp-completion-style (cond
+                                    ;;((and (fboundp 'global-company-mode) 'company-mode) 'company-mode)
+                                    (t 'popcmp-popup))
+  "Completion style.
+The currently available completion styles are:
+
+- popcmp-popup: Use OS popup menus (default).
+- emacs-default: Emacs default completion.
+- Company Mode completion.
+- anything: The Anything elisp lib completion style.
+
+The style of completion set here is not implemented for all
+completions.  The scope varies however with which completion
+style you have choosen.
+
+For information about Company Mode and how to use it see URL
+`http://www.emacswiki.org/emacs/CompanyMode'.
+
+For information about Anything and how to use it see URL
+`http://www.emacswiki.org/emacs/Anything'.
+
+See also the options `popcmp-short-help-beside-alts' and
+`popcmp-group-alternatives' which are also availabe when popup
+completion is available."
+  :type '(choice (const company-mode)
+                 (const popcmp-popup)
+                 (const emacs-default)
+                 (const anything))
+  :set (lambda (sym val)
+         (popcmp-set-completion-style val))
+  :group 'popcmp)
+
+;;(define-toggle popcmp-short-help-beside-alts t
+(define-minor-mode popcmp-short-help-beside-alts
+  "Show a short help text beside each alternative.
+If this is non-nil a short help text is shown beside each
+alternative for which such a help text is available.
+
+This works in the same circumstances as
+`popcmp-completion-style'."
+  :tag "Short help beside alternatives"
+  :global t
+  :init-value t
+  :group 'popcmp)
+
+(defun popcmp-short-help-beside-alts-toggle ()
+  "Toggle `popcmp-short-help-beside-alts'."
+  (popcmp-short-help-beside-alts (if popcmp-short-help-beside-alts -1 1)))
+
+;;(define-toggle popcmp-group-alternatives t
+(define-minor-mode popcmp-group-alternatives
+  "Do completion in two steps.
+For some completions the alternatives may have been grouped in
+sets. If this option is non-nil then you will first choose a set
+and then an alternative within this set.
+
+This works in the same circumstances as
+`popcmp-completion-style'."
+  :tag "Group alternatives"
+  :global t
+  :init-value t
+  :group 'popcmp)
+
+(defun popcmp-group-alternatives-toggle ()
+  "Toggle `popcmp-group-alternatives-toggle'."
+  (interactive)
+  (popcmp-group-alternatives (if popcmp-group-alternatives -1 1)))
+
+(defun popcmp-getsets (alts available-sets)
+  (let ((sets nil))
+    (dolist (tg alts)
+      (let (found)
+        (dolist (s available-sets)
+          (when (member tg (cdr s))
+            (setq found t)
+            (let ((sets-entry (assq (car s) sets)))
+              (unless sets-entry
+                (setq sets (cons (list (car s)) sets))
+                (setq sets-entry (assq (car s) sets)))
+                  (setcdr sets-entry (cons tg (cdr sets-entry))))))
+        (unless found
+          (let ((sets-entry (assq 'unsorted sets)))
+            (unless sets-entry
+              (setq sets (cons (list 'unsorted) sets))
+              (setq sets-entry (assq 'unsorted sets)))
+            (setcdr sets-entry (cons tg (cdr sets-entry)))))))
+    (setq sets (sort sets (lambda (a b)
+                            (string< (format "%s" b)
+                                     (format "%s" a)))))
+    ;;(dolist (s sets) (setcdr s (reverse (cdr s))))
+    sets))
+
+(defun popcmp-getset-alts (set-name sets)
+  ;; Allow both strings and symbols as keys:
+  (let ((set (or (assoc (downcase set-name) sets)
+                 (assoc (read (downcase set-name)) sets))))
+    (cdr set)))
+
+(defvar popcmp-completing-with-help nil)
+
+(defun popcmp-add-help (alt alt-help-hash)
+  (if alt-help-hash
+      (let ((h (if (hash-table-p alt-help-hash)
+                   (gethash alt alt-help-hash)
+                 (let ((hh (assoc alt alt-help-hash)))
+                   (cadr hh)))
+                 ))
+        (if h
+            (concat alt " -- " h)
+          alt))
+    alt))
+
+(defun popcmp-remove-help (alt-with-help)
+  (when alt-with-help
+    (replace-regexp-in-string " -- .*" "" alt-with-help)))
+
+(defun popcmp-anything (prompt collection
+                               predicate require-match
+                               initial-input hist def inherit-input-method
+                               alt-help alt-sets)
+  (let* ((table collection)
+         (alt-sets2 (apply 'append (mapcar 'cdr alt-sets)))
+         (cands (cond ((not (listp table)) alt-sets2)
+                     (t table)))
+         ret-val
+         (source `((name . "Completion candidates")
+                   (candidates . ,cands)
+                   (action . (("Select current alternative (press TAB to see it again)" . (lambda (candidate)
+                                            (setq ret-val candidate))))))))
+    (anything (list source) initial-input prompt)
+    ret-val))
+
+(defun popcmp-completing-read-1 (prompt collection
+                                        predicate require-match
+                                        initial-input hist2 def inherit-input-method alt-help alt-sets)
+  ;; Fix-me: must rename hist to hist2 in par list. Emacs bug?
+  (cond
+   ((eq popcmp-completion-style 'emacs-default)
+    (completing-read prompt collection predicate require-match initial-input hist2 def inherit-input-method))
+   ((eq popcmp-completion-style 'anything)
+    (popcmp-anything prompt collection predicate require-match initial-input hist2 def inherit-input-method
+                     alt-help alt-sets))
+   ((eq popcmp-completion-style 'company-mode)
+    ;; No way to read this from company-mode, use emacs-default
+    (completing-read prompt collection predicate require-match initial-input hist2 def inherit-input-method))
+   (t (error "Do not know popcmp-completion-style %S" popcmp-completion-style))))
+
+(defun popcmp-completing-read-other (prompt
+                                    table
+                                    &optional predicate require-match
+                                    initial-input pop-hist def inherit-input-method
+                                    alt-help
+                                    alt-sets)
+  (let ((alts
+         (if (and popcmp-group-alternatives alt-sets)
+             (all-completions initial-input table predicate)
+           (if popcmp-short-help-beside-alts
+               (all-completions "" table predicate)
+             table))))
+    (when (and popcmp-group-alternatives alt-sets)
+      (let* ((sets (popcmp-getsets alts alt-sets))
+             (set-names (mapcar (lambda (elt)
+                                  (capitalize (format "%s" (car elt))))
+                                sets))
+             set)
+        (setq set
+              (popcmp-completing-read-1 (concat
+                                         (substring prompt 0 (- (length prompt) 2))
+                                         ", select group: ")
+                                        set-names
+                                        nil t
+                                        nil nil nil inherit-input-method nil nil))
+        (if (or (not set) (= 0 (length set)))
+            (setq alts nil)
+          (setq set (downcase set))
+          (setq alts (popcmp-getset-alts set sets)))))
+    (if (not alts)
+        ""
+      (if (= 1 (length alts))
+          (car alts)
+        (when popcmp-short-help-beside-alts
+          (setq alts (mapcar (lambda (a)
+                               (popcmp-add-help a alt-help))
+                             alts)))
+        (popcmp-remove-help
+         ;;(completing-read prompt
+         (popcmp-completing-read-1 prompt
+                                   alts ;table
+                                   predicate require-match
+                                   initial-input pop-hist def inherit-input-method
+                                   ;;alt-help alt-sets
+                                   nil nil
+                                   ))))))
+
+(defun popcmp-completing-read-pop (prompt
+                                  table
+                                  &optional predicate require-match
+                                  initial-input hist def inherit-input-method
+                                  alt-help
+                                  alt-sets)
+  (unless initial-input
+    (setq initial-input ""))
+  (let ((matching-alts (all-completions initial-input table predicate))
+        completion)
+    (if (not matching-alts)
+        (progn
+          (message "No alternative found")
+          nil)
+      (let ((pop-map (make-sparse-keymap prompt))
+            (sets (when (and popcmp-group-alternatives alt-sets)
+                    (popcmp-getsets matching-alts alt-sets)))
+            (add-alt (lambda (k tg)
+                       (define-key k
+                         (read (format "[popcmp-%s]" (replace-regexp-in-string " " "-" tg)))
+                         (list 'menu-item
+                               (popcmp-add-help tg alt-help)
+                               `(lambda ()
+                                  (interactive)
+                                  (setq completion ,tg)))))))
+        (if sets
+            (dolist (s sets)
+              (let ((k (make-sparse-keymap)))
+                (dolist (tg (cdr s))
+                  (funcall add-alt k tg))
+                (define-key pop-map
+                  (read (format "[popcmps-%s]" (car s)))
+                  (list 'menu-item
+                        (capitalize (format "%s" (car s)))
+                        k))))
+          (dolist (tg matching-alts)
+            (funcall add-alt pop-map tg)))
+        (popup-menu-at-point pop-map)
+        completion))))
+
+(defvar popcmp-in-buffer-allowed nil)
+
+;;;###autoload
+(defun popcmp-completing-read (prompt
+                              table
+                              &optional predicate require-match
+                              initial-input pop-hist def inherit-input-method
+                              alt-help
+                              alt-sets)
+  "Read a string in the minubuffer with completion, or popup a menu.
+This function can be used instead `completing-read'. The main
+purpose is to provide a popup style menu for completion when
+completion is tighed to text at point in a buffer. If a popup
+menu is used it will be shown at window point. Whether a popup
+menu or minibuffer completion is used is governed by
+`popcmp-completion-style'.
+
+The variables PROMPT, TABLE, PREDICATE, REQUIRE-MATCH,
+INITIAL-INPUT, POP-HIST, DEF and INHERIT-INPUT-METHOD all have the
+same meaning is for `completing-read'.
+
+ALT-HELP should be nil or a hash variable or an association list
+with the completion alternative as key and a short help text as
+value.  You do not need to supply help text for all alternatives.
+The use of ALT-HELP is set by `popcmp-short-help-beside-alts'.
+
+ALT-SETS should be nil or an association list that has as keys
+groups and as second element an alternative that should go into
+this group.
+"
+  (if (and popcmp-in-buffer-allowed
+           (eq popcmp-completion-style 'company-mode)
+           (boundp 'company-mode)
+           company-mode)
+      (progn
+        (add-hook 'company-completion-finished-hook 'nxhtml-complete-tag-do-also-for-state-completion t)
+        ;;(remove-hook 'company-completion-finished-hook 'nxhtml-complete-tag-do-also-for-state-completion)
+        (call-interactively 'company-nxml)
+        initial-input)
+
+    (popcmp-mark-completing initial-input)
+    (let ((err-sym 'quit)
+          (err-val nil)
+          ret)
+      (unwind-protect
+          (if (eq popcmp-completion-style 'popcmp-popup)
+              (progn
+                (setq err-sym nil)
+                (popcmp-completing-read-pop
+                 prompt
+                 table
+                 predicate require-match
+                 initial-input pop-hist def inherit-input-method
+                 alt-help
+                 alt-sets))
+            ;;(condition-case err
+                (prog1
+                    (setq ret (popcmp-completing-read-other
+                               prompt
+                               table
+                               predicate require-match
+                               initial-input pop-hist def inherit-input-method
+                               alt-help
+                               alt-sets))
+                  ;; Unless quit or error in Anything we come here:
+                  ;;(message "ret=(%S)" ret)
+                  (when (and ret (not (string= ret "")))
+                    (setq err-sym nil)))
+              ;; (error
+              ;;  ;;(message "err=%S" err)
+              ;;  (setq err-sym (car err))
+              ;;  (setq err-val (cdr err))))
+                )
+        (popcmp-unmark-completing)
+        (when err-sym (signal err-sym err-val))))))
+
+(defvar popcmp-mark-completing-ovl nil)
+
+(defun popcmp-mark-completing (initial-input)
+  (let ((start (- (point) (length initial-input)))
+        (end (point)))
+    (if (overlayp popcmp-mark-completing-ovl)
+        (move-overlay popcmp-mark-completing-ovl start end)
+      (setq popcmp-mark-completing-ovl (make-overlay start end))
+      (overlay-put popcmp-mark-completing-ovl 'face 'match)))
+  (sit-for 0))
+
+(defun popcmp-unmark-completing ()
+  (when popcmp-mark-completing-ovl
+    (delete-overlay popcmp-mark-completing-ovl)))
+
+
+;; (defun popcmp-temp ()
+;;   (interactive)
+;;   (let* ((coord (point-to-coord (point)))
+;;          (x (nth 0 (car coord)))
+;;          (y (nth 1 (car coord)))
+;;          (emacsw32-max-frames nil)
+;;          (f (make-frame
+;;              (list '(minibuffer . only)
+;;                    '(title . "Input")
+;;                    '(name . "Input frame")
+;;                    (cons 'left x)
+;;                    (cons 'top y)
+;;                    '(height . 1)
+;;                    '(width . 40)
+;;                    '(border-width . 1)
+;;                    '(internal-border-width . 2)
+;;                    '(tool-bar-lines . nil)
+;;                    '(menu-bar-lines . nil)
+;;                    ))))
+;;     f))
+
+
+(provide 'popcmp)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; popcmp.el ends here
-- 
cgit v1.2.3-54-g00ecf