upstream + xwidget-webkit-show-named-element

11 files changed, 135 insertions, 68 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index abae693d0c8..471b1219c19 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,35 @@
+2011-10-17  Ryan Barrett <emacs@ryanb.org>  (tiny change)
+
+        * dirtrack.el (dirtrack): Support shell buffers with path
+        prefixes, e.g. tramp-based remote shells.  (Bug#9647)
+
+2011-10-17  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        * json.el: Bump version to 1.3 and note change in History.
+        (json-alist-p, json-plist-p): Rewrite to avoid recursion.
+
+2011-10-17  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * comint.el (comint-insert-input, comint-send-input)
+        (comint-get-old-input-default, comint-backward-matching-input)
+        (comint-next-prompt): Use nil instead of `input' for field property of
+        past user input (bug#114).
+
+        * minibuffer.el (completion--replace): Inherit surrounding properties
+        (bug#114).
+        (minibuffer-complete-and-exit): Use it.
+
+        * comint.el (comint--table-subvert): Quote the all-completions output
+        (bug#9160).
+
+2011-10-17  Martin Rudalics  <rudalics@gmx.at>
+
+        * ido.el (ido-default-buffer-method): Remove redundant :type entry.
+
+        * menu-bar.el (menu-bar-file-menu): Add entry for making new
+        window on right of selected.  (Bug#9350) Reword other window
+        entries and separate them from frame entries.
+
 2011-10-15  Glenn Morris  <rgm@gnu.org>
 
         * emacs-lisp/ert.el (ert--explain-equal-rec, ert-select-tests):
@@ -5,8 +37,8 @@
 
 2011-10-15  Chong Yidong  <cyd@stupidchicken.com>
 
-        * net/network-stream.el (network-stream-open-starttls): Improve
-        detection of failure due to lack of TLS support.
+        * net/network-stream.el (network-stream-open-starttls):
+        Improve detection of failure due to lack of TLS support.
 
         * mail/sendmail.el (sendmail-query-once): Tweak prompt message,
         putting the input text in front and in bold.
diff --git a/lisp/comint.el b/lisp/comint.el
index 52580db6186..591be5e2d9d 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -847,10 +847,10 @@ by the global keymap (usually `mouse-yank-at-click')."
       ;; If pos is at the very end of a field, the mouse-click was
       ;; probably outside (to the right) of the field.
       (and (< pos (field-end pos))
-           (setq field (field-at-pos pos))
-           (setq input (field-string-no-properties pos))))
-    (if (or (null comint-accum-marker)
-            (not (eq field 'input)))
+           (< (field-end pos) (point-max))
+           (progn (setq field (field-at-pos pos))
+                  (setq input (field-string-no-properties pos)))))
+    (if (or (null input) (null comint-accum-marker) field)
         ;; Fall back to the global definition if (i) the selected
         ;; buffer is not a comint buffer (which can happen if a
         ;; non-comint window was selected and we clicked in a comint
@@ -1803,8 +1803,7 @@ Similarly for Soar, Scheme, etc."
               (add-text-properties
                beg end
                '(mouse-face highlight
-                 help-echo "mouse-2: insert after prompt as new input"
-                 field input))))
+                 help-echo "mouse-2: insert after prompt as new input"))))
           (unless (or no-newline comint-use-prompt-regexp)
             ;; Cover the terminating newline
             (add-text-properties end (1+ end)
@@ -2153,7 +2152,7 @@ If `comint-use-prompt-regexp' is non-nil, then return
 the current line with any initial string matching the regexp
 `comint-prompt-regexp' removed."
   (let ((bof (field-beginning)))
-    (if (eq (get-char-property bof 'field) 'input)
+    (if (null (get-char-property bof 'field)) ;Not `output'.
         (field-string-no-properties bof)
       (comint-bol)
       (buffer-substring-no-properties (point) (line-end-position)))))
@@ -2473,7 +2472,7 @@ If N is negative, find the next or Nth next match."
               (while (/= n 0)
                 (unless (re-search-backward regexp nil t dir)
                   (error "Not found"))
-                (when (eq (get-char-property (point) 'field) 'input)
+                (unless (get-char-property (point) 'field)
                   (setq n (- n dir))))
               (field-beginning))))
       (goto-char pos))))
@@ -2520,7 +2519,7 @@ text matching `comint-prompt-regexp'."
                  (setq input-pos (point-max)))
                ;; stop iterating
                (setq n 0))
-              ((eq (get-char-property pos 'field) 'input)
+              ((null (get-char-property pos 'field))
                (setq n (if (< n 0) (1+ n) (1- n)))
                (setq input-pos pos))))
       (when input-pos
@@ -3079,9 +3078,9 @@ SS1 = (unquote SS2)."
 
 (defun comint--table-subvert (table s1 s2 &optional quote-fun unquote-fun)
   "Completion table that replaces the prefix S1 with S2 in STRING.
-When TABLE, S1 and S2 are provided by `apply-partially', the result
-is a completion table which completes strings of the form (concat S1 S)
-in the same way as TABLE completes strings of the form (concat S2 S)."
+The result is a completion table which completes strings of the
+form (concat S1 S) in the same way as TABLE completes strings of
+the form (concat S2 S)."
   (lambda (string pred action)
     (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
                                            completion-ignore-case))
@@ -3106,13 +3105,15 @@ in the same way as TABLE completes strings of the form (concat S2 S)."
          ((eq action t)
           (let ((bounds (completion-boundaries str table pred "")))
             (if (>= (car bounds) (length s2))
-                res
+                (if quote-fun (mapcar quote-fun res) res)
               (let ((re (concat "\\`"
                                 (regexp-quote (substring s2 (car bounds))))))
                 (delq nil
                       (mapcar (lambda (c)
                                 (if (string-match re c)
-                                    (substring c (match-end 0))))
+                                    (let ((str (substring c (match-end 0))))
+                                      (if quote-fun
+                                          (funcall quote-fun str) str))))
                               res))))))
          ;; E.g. action=nil and it's the only completion.
          (res))))))
diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el
index c3dfc747772..23a05816a2d 100644
--- a/lisp/dirtrack.el
+++ b/lisp/dirtrack.el
@@ -227,7 +227,7 @@ If directory tracking does not seem to be working, you can use the
 function `dirtrack-debug-mode' to turn on debugging output."
   (unless (or (null dirtrack-mode)
               (eq (point) (point-min)))     ; no output?
-    (let (prompt-path
+    (let (prompt-path orig-prompt-path
           (current-dir default-directory)
           (dirtrack-regexp    (nth 0 dirtrack-list))
           (match-num          (nth 1 dirtrack-list)))
@@ -243,8 +243,9 @@ function `dirtrack-debug-mode' to turn on debugging output."
           (if (not (> (length prompt-path) 0))
               (dirtrack-debug-message "Match is empty string")
             ;; Transform prompts into canonical forms
-            (setq prompt-path (funcall dirtrack-directory-function
-                                       prompt-path)
+            (setq orig-prompt-path (funcall dirtrack-directory-function
+                                            prompt-path)
+                  prompt-path (shell-prefixed-directory-name orig-prompt-path)
                   current-dir (funcall dirtrack-canonicalize-function
                                        current-dir))
             (dirtrack-debug-message
@@ -257,8 +258,9 @@ function `dirtrack-debug-mode' to turn on debugging output."
               ;; It's possible that Emacs will think the directory
               ;; won't exist (eg, rlogin buffers)
               (if (file-accessible-directory-p prompt-path)
-                  ;; Change directory
-                  (and (shell-process-cd prompt-path)
+                  ;; Change directory. shell-process-cd adds the prefix, so we
+                  ;; need to give it the original (un-prefixed) path.
+                  (and (shell-process-cd orig-prompt-path)
                        (run-hooks 'dirtrack-directory-change-hook)
                        (dirtrack-debug-message
                         (format "Changing directory to %s" prompt-path)))
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 2fd624e819b..cc2568a3647 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,10 @@
+2011-10-17  Daiki Ueno  <ueno@unixuser.org>
+
+        * mml2015.el (mml2015-epg-find-usable-key): Skip the whole key if the
+        primary key is marked as disabled.
+        * mml1991.el (mml1991-epg-find-usable-key): Ditto.
+        Thanks to Christian von Roques <roques@mti.ag>.
+
 2011-10-11  Andreas Schwab  <schwab@linux-m68k.org>
 
         * html2text.el (html2text-clean-anchor): Check for quotes around
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index ad9f95796fe..1777a660319 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -282,13 +282,16 @@ Whether the passphrase is cached at all is controlled by
   (catch 'found
     (while keys
       (let ((pointer (epg-key-sub-key-list (car keys))))
-        (while pointer
-          (if (and (memq usage (epg-sub-key-capability (car pointer)))
-                   (not (memq 'disabled (epg-sub-key-capability (car pointer))))
-                   (not (memq (epg-sub-key-validity (car pointer))
-                              '(revoked expired))))
-              (throw 'found (car keys)))
-          (setq pointer (cdr pointer))))
+        ;; The primary key will be marked as disabled, when the entire
+        ;; key is disabled (see 12 Field, Format of colon listings, in
+        ;; gnupg/doc/DETAILS)
+        (unless (memq 'disabled (epg-sub-key-capability (car pointer)))
+          (while pointer
+            (if (and (memq usage (epg-sub-key-capability (car pointer)))
+                     (not (memq (epg-sub-key-validity (car pointer))
+                                '(revoked expired))))
+                (throw 'found (car keys)))
+            (setq pointer (cdr pointer)))))
       (setq keys (cdr keys)))))
 
 ;; XXX: since gpg --list-secret-keys does not return validity of each
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index b9310beed58..028955a8c33 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -788,13 +788,16 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
   (catch 'found
     (while keys
       (let ((pointer (epg-key-sub-key-list (car keys))))
-        (while pointer
-          (if (and (memq usage (epg-sub-key-capability (car pointer)))
-                   (not (memq 'disabled (epg-sub-key-capability (car pointer))))
-                   (not (memq (epg-sub-key-validity (car pointer))
-                              '(revoked expired))))
-              (throw 'found (car keys)))
-          (setq pointer (cdr pointer))))
+        ;; The primary key will be marked as disabled, when the entire
+        ;; key is disabled (see 12 Field, Format of colon listings, in
+        ;; gnupg/doc/DETAILS)
+        (unless (memq 'disabled (epg-sub-key-capability (car pointer)))
+          (while pointer
+            (if (and (memq usage (epg-sub-key-capability (car pointer)))
+                     (not (memq (epg-sub-key-validity (car pointer))
+                                '(revoked expired))))
+                (throw 'found (car keys)))
+            (setq pointer (cdr pointer)))))
       (setq keys (cdr keys)))))
 
 ;; XXX: since gpg --list-secret-keys does not return validity of each
diff --git a/lisp/ido.el b/lisp/ido.el
index 46ac5784d0e..0844c2c50c6 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -461,12 +461,6 @@ See `ido-default-file-method' for details."
                    (const :tag "Show in other frame" other-frame)
                    (const :tag "Ask to show in other frame" maybe-frame)
                    (const :tag "Raise frame if already shown" raise-frame))
-    :type '(choice (const selected-window)
-                   (const other-window)
-                   (const display)
-                   (const other-frame)
-                   (const maybe-frame)
-                   (const raise-frame))
     :group 'ido)
 
 (defcustom ido-enable-flex-matching nil
diff --git a/lisp/json.el b/lisp/json.el
index 47448f4702a..33e985abbee 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
 
 ;; Author: Edward O'Connor <ted@oconnor.cx>
-;; Version: 1.2
+;; Version: 1.3
 ;; Keywords: convenience
 
 ;; This file is part of GNU Emacs.
@@ -47,6 +47,7 @@
 ;;              other cleanups, bugfixes, and improvements.
 ;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>.
 ;; 2008-02-21 - Installed in GNU Emacs.
+;; 2011-10-17 - Patch `json-alist-p' and `json-plist-p' to avoid recursion -tzz
 
 ;;; Code:
 
@@ -108,16 +109,20 @@ this around your call to `json-read' instead of `setq'ing it.")
 
 (defun json-alist-p (list)
   "Non-null if and only if LIST is an alist."
-  (or (null list)
-      (and (consp (car list))
-           (json-alist-p (cdr list)))))
+  (while (consp list)
+    (setq list (if (consp (car list))
+                   (cdr list)
+                 'not-alist)))
+  (null list))
 
 (defun json-plist-p (list)
   "Non-null if and only if LIST is a plist."
-  (or (null list)
-      (and (keywordp (car list))
-           (consp (cdr list))
-           (json-plist-p (cddr list)))))
+  (while (consp list)
+    (setq list (if (and (keywordp (car list))
+                        (consp (cdr list)))
+                   (cddr list)
+                 'not-plist)))
+  (null list))
 
 ;; Reader utilities
 
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index eceb3afc147..d75a768e2d4 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -92,17 +92,25 @@
                   :visible (fboundp 'make-frame-command)
                   :help ,(purecopy "Open a new frame")))
 
+    (define-key menu [separator-frame]
+      menu-bar-separator)
+
     (define-key menu [one-window]
-      `(menu-item ,(purecopy "Remove Splits") delete-other-windows
+      `(menu-item ,(purecopy "Remove Other Windows") delete-other-windows
                   :enable (not (one-window-p t nil))
-                  :help ,(purecopy
-                          "Selected window grows to fill the whole frame")))
+                  :help ,(purecopy "Make selected window fill whole frame")))
+
+    (define-key menu [new-window-on-right]
+      `(menu-item ,(purecopy "New Window on Right") split-window-side-by-side
+                  :enable (and (menu-bar-menu-frame-live-and-visible-p)
+                               (menu-bar-non-minibuffer-window-p))
+                  :help ,(purecopy "Make new window on right of selected one")))
 
-    (define-key menu [split-window]
-      `(menu-item ,(purecopy "Split Window") split-window-vertically
+    (define-key menu [new-window-below]
+      `(menu-item ,(purecopy "New Window Below") split-window-above-each-other
                   :enable (and (menu-bar-menu-frame-live-and-visible-p)
                                (menu-bar-non-minibuffer-window-p))
-                  :help ,(purecopy "Split selected window in two windows")))
+                  :help ,(purecopy "Make new window below selected one")))
 
     (define-key menu [separator-window]
       menu-bar-separator)
@@ -433,7 +441,7 @@
 
 (defvar menu-bar-edit-menu
   (let ((menu (make-sparse-keymap "Edit")))
-    
+
     (define-key menu [props]
       `(menu-item ,(purecopy "Text Properties") facemenu-menu))
 
@@ -1645,7 +1653,7 @@ key, a click, or a menu-item")))
 
 (defvar menu-bar-search-documentation-menu
   (let ((menu (make-sparse-keymap "Search Documentation")))
-    
+
     (define-key menu [search-documentation-strings]
       `(menu-item ,(purecopy "Search Documentation Strings...") apropos-documentation
                   :help
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index acb71d115d1..38785fc48e8 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -596,7 +596,7 @@ Moves point to the end of the new text."
       (setq end (- end suffix-len))
       (setq newtext (substring newtext 0 (- suffix-len))))
     (goto-char beg)
-    (insert newtext)
+    (insert-and-inherit newtext)
     (delete-region (point) (+ (point) (- end beg)))
     (forward-char suffix-len)))
 
@@ -927,9 +927,7 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
                      ;; file, so `try-completion' actually completes to
                      ;; that file.
                      (= (length string) (length compl)))
-            (goto-char end)
-            (insert compl)
-            (delete-region beg end))))
+            (completion--replace beg end compl))))
       (exit-minibuffer))
 
      ((memq minibuffer-completion-confirm '(confirm confirm-after-completion))
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index ed6739cf98e..33ed66334ff 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -217,7 +217,7 @@ if(document.activeElement.value != undefined)
 ;; - there is aparently no way to find the active frame other than recursion
 ;; - the js "for each" construct missbehaved on the "frames" collection
 ;; - a window with no frameset still has frames.length == 1, but frames[0].document.activeElement != document.activeElement
-
+;;TODO the activeelement type needs to be examined, for iframe, etc. sucks.
 )
 
 (defun xwidget-webkit-insert-string (xw str)
@@ -230,14 +230,23 @@ Argument STR string."
           (field-value
            (progn
              (xwidget-webkit-execute-script xww xwidget-webkit-activeelement-js)
-             (xwidget-webkit-execute-script xww "document.title=findactiveelement(frames).value")
-             (xwidget-webkit-get-title xww))))
+             (xwidget-webkit-execute-script-rv xww "findactiveelement(frames).value" ""))))
      (list xww
            (read-string "string:" field-value))))
   (xwidget-webkit-execute-script xw (format "findactiveelement(frames).value='%s'" str)))
 
 
-
+(defun xwidget-webkit-show-named-element (xw element-name)
+  "make named-element show. for instance an anchor."
+  ;;TODO
+  ;;this part figures out the Y coordinate of the element
+  (let ((y 
+         (string-to-number (xwidget-webkit-execute-script-rv xw (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-name) 0))))
+    ;;now we need to tell emacs to scroll it into view. 
+    ;;hmm. the "y" seems not to be in screen coords?
+    (message "scroll: %d" y)
+    (set-window-vscroll (selected-window) y t))
+  )
 
 (defun xwidget-webkit-adjust-size-to-content ()
   "Adjust webkit to content size."
@@ -286,12 +295,17 @@ Argument H height."
 (defun xwidget-webkit-current-url ()
   "Get the webkit url. place it on kill ring."
   (interactive)
+  (message "url: %s" (kill-new   (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session) "document.URL"))))
+
+(defun xwidget-webkit-execute-script-rv (xw script &optional default)
+  "same as xwidget-webkit-execute-script but also wraps an ugly hack to return a value"
   ;;notice the fugly "title" hack. it is needed because the webkit api doesnt support returning values.
-  ;;TODO make a wrapper for the title hack so its easy to remove should webkit someday support JS return values
+  ;;this is a wrapper for the title hack so its easy to remove should webkit someday support JS return values
   ;;or we find some other way to access the DOM
-  (xwidget-webkit-execute-script (xwidget-webkit-current-session) "document.title=document.URL;")
-  (message "url: %s" (kill-new (xwidget-webkit-get-title (xwidget-webkit-current-session)))))
 
+  (xwidget-webkit-execute-script xw (format "document.title='%s';" (if default default "")))
+  (xwidget-webkit-execute-script xw (format "document.title=%s;" script))
+  (xwidget-webkit-get-title xw))
 
 
 ;; use declare here?