Changeset 19503

Timestamp:

09/18/08 18:34:06 (4 months ago)

Author:

imakado

Message:

initialinput収得部分変更。初回起動時の補完候補収得の際にもPERL5LIBを自動で追加するように。他のバッファから補完候補を収得する部分の実装。smart-completeのアルゴリズム変更

Files:

• lang/elisp/perl-completion/branch/1.0/perl-completion.el (modified) (34 diffs)

lang/elisp/perl-completion/branch/1.0/perl-completion.el

@@ -29 +29 @@
 
 
-
-;;builtin variables: 
-;; (search . ((lambda (re arg1 arg2)
-;;                  (re-search-forward (regexp-quote re) nil t))))
-
-
 ;; TODO:
 ;; set-perl5lib
 ;; open doc -> occur
+;; when remote(tramp) set-perl5lib
+;; plcmp-cmd-show-environment
 
 ;;;code:
@@ -141 +137 @@
 (make-variable-buffer-local 'plcmp-additional-lib-directories)
 
-(defun plcmp-cmd-set-additional-lib-directory ()
-  "ask directory, then set directory to `plcmp-additional-lib-directories'"
-  (interactive)
-  (let* ((dir (read-directory-name "set to PERL5LIB(this buffer only): " nil nil t))
-         (dir (directory-file-name dir)))
-    (when (and (stringp dir)
-               (file-exists-p dir))
-      (add-to-list 'plcmp-additional-lib-directories dir)
-      (message "added %s to PERL5LIB" dir))))
+
 
 (defun plcmp--get-lib-path ()
@@ -179 +167 @@
                       (not (equal "" current-perl5lib)))
              (setenv "PERL5LIB" current-perl5lib)
-             (plcmp-log "plcmp-with-set-perl5-lib PERL5LIB: %s" current-perl5lib))
-           (progn
-             ,@body))))))
+             (plcmp-log "plcmp-with-set-perl5-lib PERL5LIB: %s" current-perl5lib)))))
+     (progn
+       ,@body)))
 
 
@@ -249 +237 @@
             regexps))))
 
-(defun plcmp-re-sort-sources (regexps sources)
+(defun plcmp-re-sort-sources (regexps sources &optional reverse)
   (condition-case e
-      (let ((regexps (if (stringp regexps) (list regexps) regexps))
-            (match-sources)
-            (unmatch-sources))
-        (loop for source in sources
+      (let* ((regexps (if (stringp regexps) (list regexps) regexps))
+             (match-sources)
+             (unmatch-sources)
+             (sorted-sources (loop for source in sources
               if (plcmp--re-match-sources1 regexps source)
               collect source into match-sources
               else
               collect source into unmatch-sources
-              finally (return (nconc match-sources unmatch-sources))))
+              finally return (if reverse
+                                 (nconc unmatch-sources match-sources)
+                               (nconc match-sources unmatch-sources)))))
+        (prog1 sorted-sources
+          (plcmp-log "plcmp-re-sort-sources: %s" sorted-sources)))
     (error (plcmp-log "Error: plcmp-re-sort-sources\nregexps: %s\nsources: %s"
                       regexps
                       sources)
-            sources)))
+           sources)))
 
 (defsubst* plcmp-collect-matches
@@ -290 +282 @@
       (require 'pp)
       (let* ((str (or (ignore-errors (apply 'format messages))
-                      (pp-to-string messages)))
+                      (pp-to-string (car messages))))
              (strn (concat str "\n")))
         (with-current-buffer (plcmp-log-buf)
@@ -304 +296 @@
 (defvar plcmp-initial-input "")
 (defvar plcmp-real-initial-input "real initial-input if required `anything-match-plugin' initial-input is not real initial-input")
+
+(defun plcmp--fullname ()
+  (save-excursion
+    (let ((start (point)))
+      (skip-chars-backward "a-zA-Z0-9_")
+      (let ((str (plcmp-preceding-string 2)))
+        (when (string-equal str "::")
+          (buffer-substring-no-properties start (point)))))))
+          
+
 (defun plcmp-get-initial-real-input-list ()
   "return list (initial-input real-initial-input)"
   (save-excursion
-    (let ((start (point)))
-      (skip-syntax-backward "w_")
-      (let* ((preceding-string (char-to-string (preceding-char)))
-             (end (condition-case e
-                      (cond
-                       ((some (lambda (s) (string-equal s preceding-string)) '("$" "@" "%" "&"))
-                        (backward-char)
-                        (point))
-                       (t
-                        (point)))
-                    (error (point))))
-             (real-initial-input
-              (buffer-substring-no-properties start end))
-             (initial-input
-              (regexp-quote
-               (concat real-initial-input
-                       (if (featurep 'anything-match-plugin)
-                           " "
-                         "")))))
-        (prog1 (values initial-input real-initial-input)
-          (plcmp-log "plcmp-get-initial-real-input-list:\ninitial-input: %s\nreal-initial-input: %s"
-                     initial-input
-                     real-initial-input))))))
+    (let* ((start (point))
+           (real-initial-input
+            (cond
+             ((plcmp--fullname))
+             (t
+              (skip-syntax-backward "w_")
+              (let* ((preceding-string (char-to-string (preceding-char)))
+                     (end (condition-case e
+                              (cond
+                               ((some (lambda (s) (string-equal s preceding-string)) '("$" "@" "%" "&"))
+                                (backward-char)
+                                (point))
+                               (t
+                                (point)))
+                            (error (point)))))
+                (buffer-substring-no-properties start end)))))
+           (initial-input
+            (regexp-quote
+             (concat real-initial-input
+                     (if (and (featurep 'anything-match-plugin)
+                              (not (string-equal real-initial-input "")))
+                         " "
+                       "")))))
+      (prog1 (values initial-input real-initial-input)
+        (plcmp-log "plcmp-get-initial-real-input-list:\ninitial-input: %s\nreal-initial-input: %s"
+                   initial-input
+                   real-initial-input)))))
+
 
 ;;; installed modules
@@ -338 +345 @@
   (unless (plcmp-tramp-p)
     (or plcmp-installed-modules
-        (prog1 (plcmp--installed-modules-synchronously)
-          (plcmp--installed-modules-asynchronously)))))
+        (setq plcmp-installed-modules
+              (plcmp--installed-modules-synchronously)))))
 
 (defun plcmp--installed-modules-synchronously ()
@@ -350 +357 @@
                         "| perl -nle 's/package\s+(.+);/$1/; print' "
                         "| sort "
-                        "| uniq ")))
+                        "| uniq "
+                        )))
          (modules (split-string modules-str "\n")))
     (message "done")
@@ -370 +378 @@
   (message "fetching installed modules...")
   (let* ((command "find")
-         (args (concat "find `perl -e 'pop @INC; print join(q{ }, @INC);'`"
+         (args (concat "`perl -e 'pop @INC; print join(q{ }, @INC);'`"
                        " -name '*.pm' -type f "
                        "| xargs grep -E -h -o 'package [a-zA-Z0-9:]+;' "
@@ -458 +466 @@
   (let* ((path (shell-command-to-string (concat "perldoc -l " (shell-quote-argument module-name))))
          (path (plcmp-trim path)))
-    (and (file-exists-p path)
+    (and (stringp path)
+         (file-exists-p path)
          path)))
 
@@ -493 +502 @@
   (anything-aif (assoc-default module-name plcmp-module-methods-alist)
       `((name . ,(concat module-name plcmp--mk-module-source-name))
-        (type . plcmp-completion-method)
+        (action . (("Insert" . plcmp-insert)
+                   ("Show doc" .
+                    (lambda (candidate)
+                      (let* ((module (plcmp-get-current-module-name))
+                             (buf (plcmp-get-man-buffer module 'module)))
+                        (save-selected-window
+                          (pop-to-buffer buf)))))
+                   ("Show doc and go" .
+                    (lambda (candidate)
+                      (let* ((module (plcmp-get-current-module-name))
+                             (buf (plcmp-get-man-buffer module 'module)))
+                        (pop-to-buffer buf))))
+                   ("Open module file" .
+                    (lambda (method)
+                      (let ((module (plcmp-get-current-module-name)))
+                        (plcmp-open-module-file module))))
+                   ("Open module file other window" .
+                    (lambda (method)
+                      (let ((module-name (plcmp-get-current-module-name)))
+                        (plcmp-open-module-file module-name 'pop-to-buffer))))
+                   ("Open module file other frame" .
+                  (lambda (candidate)
+                    (let ((module-name (plcmp-get-current-module-name)))
+                      (plcmp-open-module-file module-name
+                                              'switch-to-buffer-other-frame))))
+                   ("Add to kill-ring" . kill-new)
+                   ("Insert source name" .
+                    (lambda (candidate)
+                      (let ((name (plcmp-anything-get-current-source-name)))
+                        (and (stringp name)
+                             (insert name)))))
+                   ))
         (init . (lambda ()
                   (with-current-buffer (anything-candidate-buffer 'global)
@@ -619 +659 @@
 ;;; other buffer words
 (defvar plcmp-perl-buffer-re "\\.p[lm]$")
+(defvar plcmp-other-perl-buffer-limit-number 30)
 (defvar plcmp-other-perl-buffers-words-faces
   '(font-lock-function-name-face
@@ -629 +670 @@
 
 (defun plcmp-get-other-perl-buffers-words ()
-  (let ((perl-buffers (remove-if-not (lambda (buf)
+  (let* ((perl-buffers (remove-if-not (lambda (buf)
                                        (string-match plcmp-perl-buffer-re (buffer-name buf)))
-                                     (buffer-list))))
+                                     (buffer-list)))
+         (perl-buffers (subseq perl-buffers 0 plcmp-other-perl-buffer-limit-number)))
     (prog1 (loop for buffer in perl-buffers
+                 when (bufferp buffer)
                  nconc (with-current-buffer buffer
                          (plcmp-get-face-words plcmp-other-perl-buffers-words-faces)))
       (plcmp-log "length of other perl-buffers: %s" (length perl-buffers)))))
 
+
+(defun plcmp--mk-other-perl-buffer-source (source-name faces buffer-name)
+  `((name . ,(concat source-name " *" buffer-name "*"))
+    (action . (("Insert" . plcmp-insert)))
+    (init . (lambda ()
+              (let ((words (with-current-buffer (get-buffer ,buffer-name)
+                             (plcmp-get-face-words ',faces))))
+                (with-current-buffer (anything-candidate-buffer 'global)
+                  (plcmp-insert-each-line words)))))
+    (candidates-in-buffer)))
+
+(defun plcmp--sources-other-perl-buffers (source-name faces)
+  (let* ((perl-buffers (remove-if-not (lambda (buf)
+                                        (string-match plcmp-perl-buffer-re (buffer-name buf)))
+                                      (buffer-list)))
+         (perl-buffers (subseq perl-buffers 0 plcmp-other-perl-buffer-limit-number))
+         (sources (loop for buffer in perl-buffers
+                        when (bufferp buffer)
+                        collect (with-current-buffer buffer
+                                  (plcmp--mk-other-perl-buffer-source
+                                   source-name
+                                   faces
+                                   (buffer-name buffer))))))
+    (prog1 sources
+      (plcmp-log "plcmp--sources-other-perl-buffers:")
+      (plcmp-log sources))))
+    
+(defun plcmp-get-sources-other-perl-buffers-variable ()
+  (plcmp--sources-other-perl-buffers "variables" '(font-lock-variable-name-face)))
+
+(defun plcmp-get-sources-other-perl-buffers-hashes ()
+  (plcmp--sources-other-perl-buffers "hashes" '(cperl-hash-face)))
+
+(defun plcmp-get-sources-other-perl-buffers-arrays ()
+  (plcmp--sources-other-perl-buffers "arrays" '(cperl-array-face)))
+
+(defun plcmp-get-sources-other-perl-buffers-functions ()
+  (plcmp--sources-other-perl-buffers "functions" '(font-lock-function-name-face)))
 
 ;;; man
@@ -731 +812 @@
       (match-string 1 module))))
 
+;;;TODO
+(defun plcmp-completion-get-man-buffer (candidate)
+  "return manpage buffer ,called in completion source action"
+  (let* ((name (plcmp--anything-get-current-source-name))
+         (ret (cond
+               ((string-equal name "builtin functions")
+                (plcmp-get-man-buffer candidate 'function))
+               ((or (string-equal name "using modules")
+                    (string-equal name "installed modules"))
+                (plcmp-get-man-buffer candidate))
+               ((string-equal name "builtin variables")
+                (plcmp-get-man-buffer "" 'variables))
+               ((string-match (concat plcmp--mk-module-source-name "$")
+                              name)
+                (plcmp-get-current-module-name)))))
+    (prog1 ret
+      (plcmp-log "plcmp-completion-get-man-buffer candidate: %s return: %s"
+                 candidate
+                 ret))))
+
+
 (defvar plcmp-type-completion
     '(plcmp-completion
       (action . (("Insert" . plcmp-insert)
+                 ("Show man" .
+                  (lambda (candidate)
+                    (anything-aif (plcmp-completion-get-man-buffer candidate)
+                        (switch-to-buffer it))))
 ;;                  ("Open module file" . plcmp-open-module-file)
 ;;                  ("Open module file other window" .
@@ -795 +901 @@
                 (lambda (candidate)
                   (when (plcmp-open-doc candidate 'man)
-                    (call-interactively (plcmp-get-occur-fn) candidate))))
+                    (call-interactively (plcmp-get-occur-fn)
+                                        (regexp-quote candidate)))))
                ("Insert man name" . insert)
                ("Add man name to kill-ring" . kill-new)))))
@@ -818 +925 @@
                            (function "perldoc -f")
                            (variable "perldoc perlvar")))
-         (man-args topic)
-         (bufname (concat "*Man " man-args "*"))
-         (buffer  (get-buffer bufname)))
-    (if buffer
-        buffer
-      (require 'env)
-      (message "Invoking %s %s in the background" manual-program man-args)
-      (setq buffer (generate-new-buffer bufname))
-      (with-current-buffer buffer
-        (setq buffer-undo-list t)
-        (setq Man-original-frame (selected-frame))
-        (setq Man-arguments man-args))
-      (let ((process-environment (copy-sequence process-environment))
+         (command (if (eq type 'variable)
+                      manual-program
+                    (concat manual-program " " topic)))
+         (bufname (concat "*perldoc " topic "*"))
+         (buffer  (get-buffer-create bufname)))
+    (require 'env)
+    (let ((process-environment (copy-sequence process-environment))
             ;; The following is so Awk script gets \n intact
             ;; But don't prevent decoding of the outside.
@@ -848 +949 @@
         ;; Prevent any attempt to use display terminal fanciness.
         (setenv "TERM" "dumb")
-        ;; In Debian Woody, at least, we get overlong lines under X
-        ;; unless COLUMNS or MANWIDTH is set.  This isn't a problem on
-        ;; a tty.  man(1) says:
-        ;;        MANWIDTH
-        ;;               If $MANWIDTH is set, its value is used as the  line
-        ;;               length  for which manual pages should be formatted.
-        ;;               If it is not set, manual pages  will  be  formatted
-        ;;               with  a line length appropriate to the current ter-
-        ;;               minal (using an ioctl(2) if available, the value of
-        ;;               $COLUMNS,  or falling back to 80 characters if nei-
-        ;;               ther is available).
-        (if window-system
-            (unless (or (getenv "MANWIDTH") (getenv "COLUMNS"))
-              ;; This isn't strictly correct, since we don't know how
-              ;; the page will actually be displayed, but it seems
-              ;; reasonable.
-              (setenv "COLUMNS" (number-to-string
-                                 (cond
-                                  ((and (integerp Man-width) (> Man-width 0))
-                                   Man-width)
-                                  (Man-width (frame-width))
-                                  ((window-width)))))))
-        (setenv "GROFF_NO_SGR" "1")
-        (let ((exit-status
-               (call-process shell-file-name nil (list buffer nil) nil
-                             shell-command-switch
-                             (format (Man-build-man-command) man-args)))
-              (msg ""))
-          (when (and (numberp exit-status)
-                     (= exit-status 0))
-            (get-buffer bufname)))))))
+        (save-window-excursion (shell-command command bufname))
+        (get-buffer bufname))))
 
 (defun* plcmp-open-doc (topic &optional (type 'module) (show-fn 'switch-to-buffer))
@@ -906 +978 @@
 (defvar plcmp-anything-source-completion-using-modules
   `((name . "using modules")
-    (type . plcmp-completion)
+    (action . (("Insert" . plcmp-insert)
+               ("Show doc" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'module)))
+                    (save-selected-window
+                      (pop-to-buffer buf)))))
+               ("Show doc and go" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'module)))
+                    (pop-to-buffer buf))))
+               ("occur" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'module)))
+                    (switch-to-buffer buf)
+                    (call-interactively (plcmp-get-occur-fn)))))
+               ("Add to kill-ring" . kill-new)))
     (init . (lambda ()
               (with-current-buffer (anything-candidate-buffer 'global)
@@ -914 +1001 @@
 (defvar plcmp-anything-source-completion-builtin-functions
   `((name . "builtin functions")
-    (type . plcmp-completion)
+    (action . (("Insert" . plcmp-insert)
+               ("Show doc" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'function)))
+                    (save-selected-window
+                      (pop-to-buffer buf)))))
+               ("Show doc and go" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'function)))
+                    (switch-to-buffer-other-window buf))))
+               ("occur" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'function)))
+                    (switch-to-buffer buf)
+                    (funcall (plcmp-get-occur-fn)
+                             (regexp-quote candidate)
+                             nil))))
+               ("Add to kill-ring" . kill-new)))
     (init . (lambda ()
               (with-current-buffer (anything-candidate-buffer 'global)
@@ -922 +1026 @@
 (defvar plcmp-anything-source-completion-builtin-variables
   `((name . "builtin variables")
-    (type . plcmp-completion)
+    (action . (("Insert" . plcmp-insert)
+               ("Show doc" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'variable))
+                        (re (rx-to-string `(and bol (= 4 space)
+                                                (group (eval ,candidate))
+                                                (syntax whitespace)))))
+                    (with-current-buffer buf
+                      (re-search-forward re nil t))
+                    (save-selected-window
+                      (pop-to-buffer buf)))))
+               ("Show doc and go" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'variable))
+                        (re (rx-to-string `(and bol (= 4 space)
+                                                (group (eval ,candidate))
+                                                (syntax whitespace)))))
+                    (switch-to-buffer-other-window buf)
+                    (re-search-forward re nil t))))
+               ("occur" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'variable)))
+                    (switch-to-buffer buf)
+                    (funcall (plcmp-get-occur-fn)
+                             (regexp-quote candidate)
+                             nil))))
+               ("Add to kill-ring" . kill-new)))
     (init . (lambda ()
               (with-current-buffer (anything-candidate-buffer 'global)
@@ -932 +1062 @@
 (defvar plcmp-anything-source-completion-installed-modules
   `((name . "installed modules")
-    (type . plcmp-completion)
+    (action . (("Insert" . plcmp-insert)
+               ("Show doc" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'module)))
+                    (save-selected-window
+                      (pop-to-buffer buf)))))
+               ("Show doc and go" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'module)))
+                    (pop-to-buffer buf))))
+               ("occur" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'module)))
+                    (switch-to-buffer buf)
+                    (call-interactively (plcmp-get-occur-fn)))))
+               ("Add to kill-ring" . kill-new)))
     (init . (lambda ()
               (with-current-buffer (anything-candidate-buffer 'global)
@@ -941 +1086 @@
 (defvar plcmp-anything-source-completion-buffer-dabbrevs
   `((name . "buffer dabbrevs")
-    (type . plcmp-completion)
+    (action . (("Insert" . plcmp-insert)
+               ("occur" .
+                (lambda (candidate)
+                  (funcall (plcmp-get-occur-fn)
+                           (regexp-quote candidate)
+                           nil)))
+               ("Add to kill-ring" . kill-new)))
     (init . (lambda ()
               (let* ((words (plcmp-get-buffer-dabbrevs))
@@ -952 +1103 @@
 (defvar plcmp-anything-source-completion-other-perl-buffers-words
   `((name . "other buffer keywords")
-    (type . plcmp-completion)
+    (action . (("Insert" . plcmp-insert)))
     (init . (lambda ()
               (with-current-buffer (anything-candidate-buffer 'global)
@@ -963 +1114 @@
 (defvar plcmp-anything-source-doc-man-pages
   '((name . "perl man pages")
-    (type . plcmp-doc)
+    (action . (("Show man" . woman)))
     (init . (lambda ()
               (with-current-buffer (anything-candidate-buffer 'global)
@@ -969 +1120 @@
     (candidates-in-buffer)))
 
+(defvar plcmp-anything-source-doc-using-modules
+  '((name . "using modules")
+    (action . (("Show doc" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'module)))
+                    (save-selected-window
+                      (pop-to-buffer buf)))))
+               ("Show doc and go" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'module)))
+                    (switch-to-buffer buf))))
+               ("occur doc buffer" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'module)))
+                    (switch-to-buffer buf)
+                    (call-interactively (plcmp-get-occur-fn)
+                                        (regexp-quote candidate)))))
+               ("Add to kill-ring" . kill-new)))
+    (init . (lambda ()
+              (with-current-buffer (anything-candidate-buffer 'global)
+                (plcmp-insert-each-line plcmp-using-modules))))
+    (candidates-in-buffer)))
+
+(defvar plcmp-anything-source-doc-installed-modules
+  '((name . "installed modules")
+    (action . (("Show doc" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'module)))
+                    (save-selected-window
+                      (pop-to-buffer buf)))))
+               ("Show doc and go" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'module)))
+                    (switch-to-buffer buf))))
+               ("occur doc buffer" .
+                (lambda (candidate)
+                  (let ((buf (plcmp-get-man-buffer candidate 'module)))
+                    (switch-to-buffer buf)
+                    (call-interactively (plcmp-get-occur-fn)))))
+               ("Add to kill-ring" . kill-new)))
+    (init . (lambda ()
+              (with-current-buffer (anything-candidate-buffer 'global)
+                (plcmp-insert-each-line plcmp-installed-modules))))
+    (candidates-in-buffer)))
+
+
 ;; menu
 (defvar plcmp-anything-source-menu
-  '((name . "perl-completion menu")
+  `((name . "perl-completion menu")
     (type . command)
-    (init . (lambda ()
-              (with-current-buffer (anything-candidate-buffer 'global)
-                (let ((commands (loop for sym being the symbols
-                                      for s = (symbol-name sym)
-