auto upstream

8 files changed, 104 insertions, 32 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index eb3f4f833f5..5a752fe0c3a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,37 @@
+2013-02-14  Michael Albinus  <michael.albinus@gmx.de>
+
+        * net/tramp.el (tramp-debug-message): Add
+        `tramp-condition-case-unless-debug'.
+        (tramp-debug-on-error): New defvar.
+        (tramp-condition-case-unless-debug): New defun.
+        (tramp-file-name-handler): Use it.
+
+2013-02-14  Juri Linkov  <juri@jurta.org>
+
+        * info.el (Info-isearch-filter): Treat non-nil values of
+        `search-invisible' including its default value `open'
+        like the value `t' to match hidden text.  (Bug#13402)
+
+2013-02-14  Glenn Morris  <rgm@gnu.org>
+
+        * help-fns.el (find-lisp-object-file-name): Give special treatment
+        to all ~/.foo.elc files, not just ~/.emacs.  (Bug#9007)
+
+2013-02-14  David Biesack  <sasdjb@d72933.na.sas.com>  (tiny change)
+
+        * net/quickurl.el (quickurl-save-urls):
+        Ensure quickurl-urls is not truncated on printing.  (Bug#9276)
+
+2013-02-14  Dmitry Gutov  <dgutov@yandex.ru>
+
+        * progmodes/ruby-mode.el (ruby-parse-partial): Don't increase
+        depth for unfinished percent literal.  Not using it in the caller.
+        (ruby-move-to-block): Jump over multiline literals of all types,
+        ignoring code-looking contents inside them.
+        (ruby-add-log-current-method): Improve performance at the expense
+        of accuracy.  `ruby-block-contains-point' is relatively slow, so
+        only use it for method and singleton class blocks.
+
 2013-02-13  Michael Albinus  <michael.albinus@gmx.de>
 
         Use ControlMaster where applicable.  (Bug#13677)
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 14499a8fafc..b6e8fd976d3 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,8 @@
+2013-02-14  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+        * gnus-util.el (gnus-define-keys): Convert [?\S-\ ] to [(shift space)]
+        for XEmacs.
+
 2013-02-13  Juri Linkov  <juri@jurta.org>
 
         * gnus-art.el (gnus-article-mode-map):
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index df805c6fb26..331f9556710 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -333,6 +333,13 @@ TIME defaults to the current time."
 
 (defmacro gnus-define-keys (keymap &rest plist)
   "Define all keys in PLIST in KEYMAP."
+  ;; Convert the key [?\S-\ ] to [(shift space)] for XEmacs.
+  (when (featurep 'xemacs)
+    (let ((bindings plist))
+      (while bindings
+        (when (equal (car bindings) [?\S-\ ])
+          (setcar bindings [(shift space)]))
+        (setq bindings (cddr bindings)))))
   `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
 
 (defmacro gnus-define-keys-safe (keymap &rest plist)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 178096d1024..bdf86016844 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -336,11 +336,15 @@ suitable file is found, return nil."
       ;; If we don't have a file-name string by now, we lost.
       nil)
      ;; Now, `file-name' should have become an absolute file name.
-     ;; For files loaded from ~/.emacs.elc, try ~/.emacs.
+     ;; For files loaded from ~/.foo.elc, try ~/.foo.
+     ;; This applies to config files like ~/.emacs,
+     ;; which people sometimes compile.
      ((let (fn)
-        (and (string-equal file-name
-                           (expand-file-name ".emacs.elc" "~"))
-             (file-readable-p (setq fn (expand-file-name ".emacs" "~")))
+        (and (string-match "\\`\\..*\\.elc\\'"
+                           (file-name-nondirectory file-name))
+             (string-equal (file-name-directory file-name)
+                           (file-name-as-directory (expand-file-name "~")))
+             (file-readable-p (setq fn (file-name-sans-extension file-name)))
              fn)))
      ;; When the Elisp source file can be found in the install
      ;; directory, return the name of that file.
diff --git a/lisp/info.el b/lisp/info.el
index a6db9f3f4dc..24a7181ff52 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -2151,7 +2151,7 @@ and is not in the header line or a tag table."
     (let ((backward (< found beg-found)))
       (not
        (or
-        (and (not (eq search-invisible t))
+        (and (not search-invisible)
              (if backward
                  (or (text-property-not-all found beg-found 'invisible nil)
                      (text-property-not-all found beg-found 'display nil))
diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el
index ce9ef55f499..1de9feb1341 100644
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -272,7 +272,8 @@ It also restores point after the `read'."
 (defun quickurl-save-urls ()
   "Save the contents of `quickurl-urls' to `quickurl-url-file'."
   (with-temp-buffer
-    (let ((standard-output (current-buffer)))
+    (let ((standard-output (current-buffer))
+          (print-length nil))
       (princ quickurl-prefix)
       (pp quickurl-urls)
       (princ quickurl-postfix)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index a4250f94988..89648b0e9a9 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1399,6 +1399,7 @@ ARGS to actually emit the message (if applicable)."
                          "tramp-compat-condition-case-unless-debug"
                          "tramp-compat-funcall"
                          "tramp-compat-with-temp-message"
+                         "tramp-condition-case-unless-debug"
                          "tramp-debug-message"
                          "tramp-error"
                          "tramp-error-with-buffer"
@@ -2011,6 +2012,15 @@ ARGS are the arguments OPERATION has been called with."
                   res (cdr elt))))
         res))))
 
+(defvar tramp-debug-on-error nil
+  "Like `debug-on-error' but used Tramp internal.")
+
+(defmacro tramp-condition-case-unless-debug
+  (var bodyform &rest handlers)
+  "Like `condition-case-unless-debug' but `tramp-debug-on-error'."
+  `(let ((debug-on-error tramp-debug-on-error))
+     (tramp-compat-condition-case-unless-debug ,var ,bodyform ,@handlers)))
+
 ;; Main function.
 ;;;###autoload
 (defun tramp-file-name-handler (operation &rest args)
@@ -2026,7 +2036,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
           (with-parsed-tramp-file-name filename nil
             ;; Call the backend function.
             (if foreign
-                (tramp-compat-condition-case-unless-debug err
+                (tramp-condition-case-unless-debug err
                     (let ((sf (symbol-function foreign))
                           result)
                       ;; Some packages set the default directory to a
@@ -2079,7 +2089,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
                   ;; in order to give the user a chance to correct the
                   ;; file name in the minibuffer.
                   ;; In order to get a full backtrace, one could apply
-                  ;;   (setq debug-on-error t debug-on-signal t)
+                  ;;   (setq tramp-debug-on-error t)
                   (error
                    (cond
                     ((and completion (zerop (length localname))
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index b1017bb6302..9b007c0063a 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -519,12 +519,6 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
                               (concat "[^\\]\\(\\\\\\\\\\)*" w))
                             end t)))
             (setq in-string (point))
-            (when (eq (char-syntax (string-to-char w)) ?\()
-              ;; The rest of the literal, when parsed separately, will
-              ;; have the depth of -1. So in the rare case when this
-              ;; number is used despite the in-string status, the
-              ;; depths will balance.
-              (setq depth (1+ depth)))
             (goto-char end)))
          (t
           (goto-char pnt))))
@@ -913,10 +907,16 @@ current block, a sibling block, or an outer block.  Do that (abs N) times."
           (re-search-forward "^=end\\>"))
          ((and backward (looking-at "^=end\\>"))
           (re-search-backward "^=begin\\>"))
+         ;; Jump over a multiline literal.
+         ((ruby-in-ppss-context-p 'string)
+          (goto-char (nth 8 (syntax-ppss)))
+          (unless backward
+            (forward-sexp)
+            (when (bolp) (forward-char -1)))) ; After a heredoc.
          (t
-          (incf depth (or (nth 2 (ruby-parse-region (point)
-                                                    (line-end-position)))
-                          0))
+          (let ((state (ruby-parse-region (point) (line-end-position))))
+            (unless (car state) ; Line ends with unfinished string.
+              (setq depth (+ (nth 2 state) depth))))
           (cond
            ;; Deeper indentation, we found a block.
            ;; FIXME: We can't recognize empty blocks this way.
@@ -1073,29 +1073,33 @@ For example:
 See `add-log-current-defun-function'."
   (condition-case nil
       (save-excursion
-        (let ((indent 0) mname mlist
-              (start (point))
-              (definition-re
-                (concat "^[ \t]*" ruby-defun-beg-re "[ \t]+"
-                        "\\("
-                        ;; \\. and :: for class methods
-                        "\\([A-Za-z_]" ruby-symbol-re "*\\|\\.\\|::" "\\)"
-                        "+\\)")))
+        (let* ((indent 0) mname mlist
+               (start (point))
+               (make-definition-re
+                (lambda (re)
+                  (concat "^[ \t]*" re "[ \t]+"
+                          "\\("
+                          ;; \\. and :: for class methods
+                          "\\([A-Za-z_]" ruby-symbol-re "*\\|\\.\\|::" "\\)"
+                          "+\\)")))
+               (definition-re (funcall make-definition-re ruby-defun-beg-re))
+               (module-re (funcall make-definition-re "\\(class\\|module\\)")))
           ;; Get the current method definition (or class/module).
           (when (re-search-backward definition-re nil t)
             (goto-char (match-beginning 1))
-            (when (ruby-block-contains-point start)
-              ;; We're inside the method, class or module.
-              (setq mname (match-string 2))
-              (unless (string-equal "def" (match-string 1))
-                (setq mlist (list mname) mname nil)))
+            (if (not (string-equal "def" (match-string 1)))
+                (setq mlist (list (match-string 2)))
+              ;; We're inside the method. For classes and modules,
+              ;; this check is skipped for performance.
+              (when (ruby-block-contains-point start)
+                (setq mname (match-string 2))))
             (setq indent (current-column))
             (beginning-of-line))
           ;; Walk up the class/module nesting.
           (while (and (> indent 0)
-                      (re-search-backward definition-re nil t))
+                      (re-search-backward module-re nil t))
             (goto-char (match-beginning 1))
-            (when (ruby-block-contains-point start)
+            (when (< (current-column) indent)
               (setq mlist (cons (match-string 2) mlist))
               (setq indent (current-column))
               (beginning-of-line)))
@@ -1121,6 +1125,13 @@ See `add-log-current-defun-function'."
                 (let ((in-singleton-class
                        (when (re-search-forward ruby-singleton-class-re start t)
                          (goto-char (match-beginning 0))
+                         ;; FIXME: Optimize it out, too?
+                         ;; This can be slow in a large file, but
+                         ;; unlike class/module declaration
+                         ;; indentations, method definitions can be
+                         ;; intermixed with these, and may or may not
+                         ;; be additionally indented after visibility
+                         ;; keywords.
                          (ruby-block-contains-point start))))
                   (setq mname (concat
                                (if in-singleton-class "." "#")