Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Fixed issue 46

Fixed issue 40
Better control over autopair-newline and autopair-autowrap
Better testing framework
Add workaround of issue 25


git-svn-id: https://autopair.googlecode.com/svn/trunk@40 56c4f94e-c24a-11de-a250-c7f789e21d83
  • Loading branch information...
commit f61bdc0b6782f0a58b51167418c73f5aaa23b834 1 parent 8c7a554
authored February 27, 2011
148  autopair-tests.el
@@ -23,12 +23,7 @@
23 23
 ;; Mini test framework for autopair.el
24 24
 
25 25
 ;;; Code:
26  
-
27  
-
28  
-
29  
-(provide 'autopair-tests)
30  
-;;; autopair-tests.el ends here
31  
-
  26
+(require 'autopair)
32 27
 (setq autopair-extra-tests (list (list "       "
33 28
                                        "-----`-"
34 29
                                        #'autopair-extra-pair-p
@@ -114,18 +109,64 @@
114 109
                                  #'autopair-skip-p
115 110
                                  "-----y---")))
116 111
 
117  
-(defun autopair-test (buffer-contents
  112
+(defvar autopair-autowrap-tests)
  113
+(setq autopair-autowrap-tests (list
  114
+                               (list #'(lambda ()
  115
+                                         (insert "hello") (set-mark (point)) (beginning-of-buffer))
  116
+                                     "("
  117
+                                     #'(lambda ()
  118
+                                         (cons (buffer-substring-no-properties (point-min) (point-max))
  119
+                                               (point)))
  120
+                                     '("(hello)" . 2))
  121
+                               (list #'(lambda ()
  122
+                                         (insert "hello") (set-mark (point)) (beginning-of-buffer))
  123
+                                     ")"
  124
+                                     #'(lambda ()
  125
+                                         (cons (buffer-substring-no-properties (point-min) (point-max))
  126
+                                               (point)))
  127
+                                     '("(hello)" . 8))
  128
+                               (list #'(lambda ()
  129
+                                         (insert "hello") (set-mark (point)) (beginning-of-buffer)
  130
+                                         (exchange-point-and-mark))
  131
+                                     ")"
  132
+                                     #'(lambda ()
  133
+                                         (cons (buffer-substring-no-properties (point-min) (point-max))
  134
+                                               (point)))
  135
+                                     '("(hello)" . 8))
  136
+                               (list #'(lambda ()
  137
+                                         (insert "hello") (set-mark (point)) (beginning-of-buffer)
  138
+                                         (exchange-point-and-mark))
  139
+                                     "("
  140
+                                     #'(lambda ()
  141
+                                         (cons (buffer-substring-no-properties (point-min) (point-max))
  142
+                                               (point)))
  143
+                                     '("(hello)" . 2))))
  144
+
  145
+(dolist (p '(autopair-pair-p autopair-skip-p autopair-extra-skip-p autopair-extra-pair-p))
  146
+  (put p 'autopair-test-charwise-predicate t))
  147
+
  148
+(defun autopair-test (before
118 149
                       input
119  
-                      predicate)
120  
-    (insert buffer-contents)
121  
-    (let* ((size (1- (point-max)))
122  
-           (result (make-string size ?-)))
123  
-      (dotimes (i size)
124  
-        (goto-char (1+ i))
125  
-        (let ((autopair-inserted (aref input i)))
126  
-          (when (and (not (eq autopair-inserted ?-))
127  
-                     (funcall predicate) (aset result i ?y)))))
128  
-      result))
  150
+                      extractor-or-predicate)
  151
+    (if (stringp before) (insert before))
  152
+    (cond ((and (symbolp extractor-or-predicate)
  153
+                (get extractor-or-predicate 'autopair-test-charwise-predicate))
  154
+           (let* ((size (1- (point-max)))
  155
+                  (result (make-string size ?-)))
  156
+             (dotimes (i size)
  157
+               (goto-char (1+ i))
  158
+               (let ((autopair-inserted (aref input i)))
  159
+                 (when (and (not (eq autopair-inserted ?-))
  160
+                            (funcall extractor-or-predicate) (aset result i ?y)))))
  161
+             result))
  162
+          (t
  163
+           (funcall before)
  164
+           (if (functionp input)
  165
+               (funcall input)
  166
+             (let ((last-command-event (aref input 0)))
  167
+               (call-interactively (key-binding input) nil)
  168
+               (autopair-post-command-handler)))
  169
+           (funcall extractor-or-predicate))))
129 170
 
130 171
 (defun autopair-run-tests (&optional suite)
131 172
   (interactive)
@@ -133,34 +174,49 @@
133 174
         (failed 0))
134 175
     (with-output-to-temp-buffer "*autopair-tests*"
135 176
       (dolist (spec (or suite (append autopair-tests
136  
-                                      autopair-extra-tests)))
137  
-        (condition-case err
138  
-            (progn (assert (equal
139  
-                            (condition-case nil
140  
-                                (with-temp-buffer
141  
-                                  (autopair-mode t)
142  
-                                  (emacs-lisp-mode)
143  
-                                  (setq autopair-extra-pairs nil
144  
-                                        autopair-dont-pair nil
145  
-                                        autopair-handle-action-fns nil
146  
-                                        autopair-handle-wrap-action-fns nil)
147  
-                                  (eval `(let ,(fifth spec)
148  
-                                           (autopair-test (first spec)
149  
-                                                          (second spec)
150  
-                                                          (third spec)))))
151  
-                                (error "error"))
152  
-                            (fourth spec))
153  
-                           'show-args
154  
-                           (format "test \"%s\" for input %s returned %%s instead of %s\n"
155  
-                                   (first spec)
156  
-                                   (second spec)
157  
-                                   (fourth spec)))
158  
-                   (incf passed))
159  
-          (error (progn
160  
-                   (princ (cadr err))
161  
-                   (incf failed))))
162  
-        )
163  
-      (princ (format "\n\n%s tests total, %s pass, %s failures"
  177
+                                      autopair-extra-tests
  178
+                                      autopair-autowrap-tests)))
  179
+        (let* ((fspec (fourth spec))
  180
+               (expected (or (and (functionp fspec) (funcall fspec))
  181
+                             fspec
  182
+                             t))
  183
+               (actual (condition-case e
  184
+                           (with-current-buffer (generate-new-buffer "*autopair-test*")
  185
+                             (emacs-lisp-mode)
  186
+                             (autopair-mode 1)
  187
+                             (transient-mark-mode 1)
  188
+                             (setq autopair-extra-pairs nil
  189
+                                   autopair-dont-pair nil
  190
+                                   autopair-handle-action-fns nil
  191
+                                   autopair-handle-wrap-action-fns nil)
  192
+                             (eval `(let ,(fifth spec)
  193
+                                      (autopair-test (first spec)
  194
+                                                     (second spec)
  195
+                                                     (third spec)))))
  196
+                         (error (error e)))))
  197
+          (condition-case err
  198
+              (progn (assert (equal actual expected)
  199
+                             'show-args
  200
+                             (format "test \"%s\" for input %s returned %s instead of %s\n"
  201
+                                     (first spec)
  202
+                                     (second spec)
  203
+                                     actual
  204
+                                     expected))
  205
+                     (incf passed))
  206
+            (error (progn
  207
+                     (princ (cadr err))
  208
+                     (incf failed))))))
  209
+      (princ (format "%s%s tests total, %s pass, %s failures"
  210
+                     (or (and (zerop failed) "") "\n\n")
164 211
                      (+ passed failed)
165 212
                      passed
166  
-                     failed)))))
  213
+                     failed)))
  214
+    (when noninteractive
  215
+      (with-current-buffer "*autopair-tests*"
  216
+        (princ (buffer-substring-no-properties (point-min) (point-max))))
  217
+      (kill-emacs failed))))
  218
+
  219
+
  220
+(provide 'autopair-tests)
  221
+;;; autopair-tests.el ends here
  222
+
88  autopair.el
@@ -101,7 +101,7 @@
101 101
 ;; For lisp-programming you might also like `autopair-skip-whitespace'.
102 102
 ;;
103 103
 ;; For further customization have a look at `autopair-dont-pair',
104  
-;; `autopair-handle-action-fns' and `autopair-extra-pair'.
  104
+;; `autopair-handle-action-fns' and `autopair-extra-pairs'.
105 105
 ;;
106 106
 ;; `autopair-dont-pair' lets you define special cases of characters
107 107
 ;; you don't want paired.  Its default value skips pairing
@@ -335,6 +335,7 @@ For now, simply returns `last-command-event'"
335 335
            (define-key map (kbd "<backspace>") 'autopair-backspace)
336 336
            (define-key map [backspace] 'autopair-backspace)
337 337
            (define-key map (kbd "DEL") 'autopair-backspace)
  338
+           (define-key map [return] 'autopair-newline)
338 339
            (define-key map (kbd "RET") 'autopair-newline)
339 340
            (dotimes (char 256) ;; only searches the first 256 chars,
340 341
              ;; TODO: is this enough/toomuch/stupid?
@@ -382,7 +383,7 @@ For now, simply returns `last-command-event'"
382 383
          (setq autopair-action nil)
383 384
          (setq autopair-wrap-action nil)
384 385
          (add-hook 'emulation-mode-map-alists 'autopair-emulation-alist 'append)
385  
-         (add-hook 'post-command-hook 'autopair-post-command-handler 'append 'local))
  386
+         (add-hook 'post-command-hook 'autopair-post-command-handler nil 'local))
386 387
         (t
387 388
          (setq autopair-emulation-alist nil)
388 389
          (remove-hook 'emulation-mode-map-alists 'autopair-emulation-alist)
@@ -444,16 +445,24 @@ A list of four elements is returned:
444 445
                              pair-list))
445 446
                    (remove-if-not #'listp autopair-extra-pairs)))))))
446 447
 
  448
+(unless (fboundp 'region-active-p)
  449
+  (defun region-active-p ()
  450
+    "Predicate missing in emacs 22" 
  451
+    (and transient-mark-mode mark-active)))
  452
+
447 453
 (defun autopair-calculate-wrap-action ()
448 454
   (when (region-active-p)
  455
+    (when (> (point) (mark))
  456
+      (exchange-point-and-mark))
449 457
     (save-excursion
450 458
       (let* ((region-before (cons (region-beginning)
451 459
                                   (region-end)))
452 460
              (point-before (point))
453 461
              (start-syntax (syntax-ppss (car region-before)))
454 462
              (end-syntax   (syntax-ppss (cdr region-before))))
455  
-        (when (and (eq (nth 0 start-syntax) (nth 0 end-syntax))
456  
-                   (eq (nth 3 start-syntax) (nth 3 end-syntax)))
  463
+        (when (or (not (eq autopair-autowrap 'help-balance))
  464
+                  (and (eq (nth 0 start-syntax) (nth 0 end-syntax))
  465
+                       (eq (nth 3 start-syntax) (nth 3 end-syntax))))
457 466
           (list 'wrap (or (second autopair-action)
458 467
                           (autopair-find-pair autopair-inserted))
459 468
                 point-before
@@ -481,10 +490,11 @@ A list of four elements is returned:
481 490
           (blink-matching-paren (not autopair-action)))
482 491
       (call-interactively beyond-autopair))))
483 492
 
484  
-(defvar autopair-autowrap nil
  493
+(defvar autopair-autowrap 'help-balance
485 494
   "If non-nil autopair attempts to wrap the selected region.
486 495
 
487  
-This is also done in an optimistic \"try-to-balance\" fashion.")
  496
+This is also done in an optimistic \"try-to-balance\" fashion.
  497
+Set this to to 'help-balance to be more criterious when wrapping.")
488 498
 
489 499
 (defvar autopair-skip-whitespace nil
490 500
   "If non-nil also skip over whitespace when skipping closing delimiters.
@@ -663,11 +673,15 @@ returned) and uplisting stops there."
663 673
   (interactive)
664 674
   (setq autopair-inserted (autopair-calculate-inserted))
665 675
   (let ((pair (autopair-find-pair (char-before))))
666  
-    (when (eq (char-after) pair)
  676
+    (when (and pair
  677
+               (eq (char-syntax pair) ?\))
  678
+               (eq (char-after) pair))
667 679
       (setq autopair-action (list 'newline pair (point))))
668 680
     (autopair-fallback (kbd "RET"))))
669 681
 (put 'autopair-newline 'function-documentation
670  
-     '(concat "Possibly insert two newlines and place point after the first, indented.\n\n"
  682
+     '(concat "Do a smart newline when right between parenthesis.\n
  683
+In other words, insert an extra newline along with the one inserted normally
  684
+by this command. Then place point after the first, indented.\n\n"
671 685
               (autopair-document-bindings (kbd "RET"))))
672 686
 
673 687
 (defun autopair-skip-p ()
@@ -867,49 +881,28 @@ returned) and uplisting stops there."
867 881
   "Default handler for the wrapping action in `autopair-wrap'"
868 882
   (condition-case err
869 883
       (when (eq 'wrap action)
870  
-        (let ((reverse-selected (= (car region-before) pos-before)))
  884
+        (let ((delete-active-region nil))
871 885
           (cond
872 886
            ((eq 'opening (first autopair-action))
873  
-            ;; (message "wrap-opening!")
874  
-            (cond (reverse-selected
875  
-                   (goto-char (1+ (cdr region-before)))
876  
-                   (insert pair)
877  
-                   (autopair-blink)
878  
-                   (goto-char (1+ (car region-before))))
879  
-                  (t
880  
-                   (delete-backward-char 1)
881  
-                   (insert pair)
882  
-                   (goto-char (car region-before))
883  
-                   (insert autopair-inserted)))
884  
-            (setq autopair-action nil) )
  887
+            (goto-char (1+ (cdr region-before)))
  888
+            (insert pair)
  889
+            (autopair-blink)
  890
+            (goto-char (1+ (car region-before))))
885 891
            (;; wraps
886 892
             (eq 'closing (first autopair-action))
887  
-            ;; (message "wrap-closing!")
888  
-            (cond (reverse-selected
889  
-                   (delete-backward-char 1)
890  
-                   (insert pair)
891  
-                   (goto-char (1+ (cdr region-before)))
892  
-                   (insert autopair-inserted))
893  
-                  (t
894  
-                   (goto-char (car region-before))
895  
-                   (insert pair)
896  
-                   (autopair-blink)
897  
-                   (goto-char (+ 2 (cdr region-before)))))
898  
-            (setq autopair-action nil))
  893
+            (delete-backward-char 1)
  894
+            (insert pair)
  895
+            (goto-char (1+ (cdr region-before)))
  896
+            (insert autopair-inserted))
899 897
            ((eq 'insert-quote (first autopair-action))
900  
-            (cond (reverse-selected
901  
-                   (goto-char (1+ (cdr region-before)))
902  
-                   (insert pair)
903  
-                   (autopair-blink))
904  
-                  (t
905  
-                   (goto-char (car region-before))
906  
-                   (insert autopair-inserted)
907  
-                   (autopair-blink)))
908  
-            (setq autopair-action nil))
909  
-           (reverse-selected
  898
+            (goto-char (1+ (cdr region-before)))
  899
+            (insert pair)
  900
+            (autopair-blink))
  901
+           (t
910 902
             (delete-backward-char 1)
911 903
             (goto-char (cdr region-before))
912  
-            (insert autopair-inserted)))))
  904
+            (insert autopair-inserted)))
  905
+          (setq autopair-action nil)))
913 906
     (error
914 907
      (message "[autopair] Ignored error in `autopair-default-handle-wrap-action'"))))
915 908
 
@@ -943,10 +936,13 @@ returned) and uplisting stops there."
943 936
 ;; example latex paired-delimiter helper 
944 937
 ;;
945 938
 (defun autopair-latex-mode-paired-delimiter-action (action pair pos-before)
946  
-  "Pair or skip latex's \"paired delimiter\" syntax in math mode."
  939
+  "Pair or skip latex's \"paired delimiter\" syntax in math mode. Added AucText support, thanks Massimo Lauria"
947 940
   (when (eq action 'paired-delimiter)
948 941
     (when (eq (char-before) pair)
949  
-      (if (and (eq (get-text-property pos-before 'face) 'tex-math)
  942
+      (if (and (or
  943
+                (eq (get-text-property pos-before 'face) 'tex-math)
  944
+                (eq (get-text-property (- pos-before 1) 'face) 'font-latex-math-face)
  945
+                (member 'font-latex-math-face (get-text-property (- pos-before 1) 'face)))
950 946
                (eq (char-after) pair))
951 947
           (cond ((and (eq (char-after) pair)
952 948
                       (eq (char-after (1+ (point))) pair))

0 notes on commit f61bdc0

Please sign in to comment.
Something went wrong with that request. Please try again.