X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4dc7c8d5795458e89d19b59f64760e155c2cd70b..8725b746408685833dec0ee09f1a4fc680786c9a:/lisp/term.el

diff --git a/lisp/term.el b/lisp/term.el
index 014adb610b..b37e71280d 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -1,7 +1,7 @@
 ;;; term.el --- general command interpreter in a window stuff
 
-;; Copyright (C) 1988, 1990, 1992, 1994-1995, 2001-2012
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1990, 1992, 1994-1995, 2001-2013 Free Software
+;; Foundation, Inc.
 
 ;; Author: Per Bothner <per@bothner.com>
 ;; Maintainer: Dan Nicolaescu <dann@ics.uci.edu>, Per Bothner <per@bothner.com>
@@ -397,6 +397,12 @@
 (require 'ring)
 (require 'ehelp)
 
+(declare-function ring-empty-p "ring" (ring))
+(declare-function ring-ref "ring" (ring index))
+(declare-function ring-insert-at-beginning "ring" (ring item))
+(declare-function ring-length "ring" (ring))
+(declare-function ring-insert "ring" (ring item))
+
 (defgroup term nil
   "General command interpreter in a window."
   :group 'processes)
@@ -452,7 +458,7 @@ state 4: term-terminal-parameter contains pending output.")
   "A queue of strings whose echo we want suppressed.")
 (defvar term-terminal-parameter)
 (defvar term-terminal-previous-parameter)
-(defvar term-current-face 'term-face)
+(defvar term-current-face 'term)
 (defvar term-scroll-start 0 "Top-most line (inclusive) of scrolling region.")
 (defvar term-scroll-end) ; Number of line (zero-based) after scrolling region.
 (defvar term-pager-count nil
@@ -615,28 +621,6 @@ executed once when the buffer is created."
   :type 'hook
   :group 'term)
 
-(defvar term-signals-menu
-  (let ((map (make-sparse-keymap "Signals")))
-    (define-key map [eof]
-      '(menu-item "EOF" term-send-eof
-        :help "Send an EOF to the current buffer's process"))
-    (define-key map [kill]
-      '(menu-item "KILL" term-kill-subjob
-        :help "Send kill signal to the current subjob"))
-    (define-key map [quit]
-      '(menu-item "QUIT" term-quit-subjob
-        :help "Send quit signal to the current subjob."))
-    (define-key map [cont]
-      '(menu-item "CONT" term-continue-subjob
-        :help "Send CONT signal to process buffer's process group"))
-    (define-key map [stop]
-      '(menu-item "STOP" term-stop-subjob
-        :help "Stop the current subjob"))
-    (define-key map [brk]
-      '(menu-item "BREAK" term-interrupt-subjob
-        :help "Interrupt the current subjob"))
-    (cons "Signals" map)))
-
 (defvar term-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map "\ep" 'term-previous-input)
@@ -667,69 +651,61 @@ executed once when the buffer is created."
     (define-key map "\C-c\C-k" 'term-char-mode)
     (define-key map "\C-c\C-j" 'term-line-mode)
     (define-key map "\C-c\C-q" 'term-pager-toggle)
-
-    ;; completion:  (line mode only)
-    (let ((completion-menu (make-sparse-keymap "Complete")))
-      (define-key map [menu-bar completion]
-        (cons "Complete" completion-menu))
-      (define-key completion-menu [complete-expand]
-        '("Expand File Name" . term-replace-by-expanded-filename))
-      (define-key completion-menu [complete-listing]
-        '("File Completion Listing" . term-dynamic-list-filename-completions))
-      (define-key completion-menu [complete-file]
-        '("Complete File Name" . term-dynamic-complete-filename))
-      (define-key completion-menu [complete]
-        '("Complete Before Point" . term-dynamic-complete)))
-
+    ;; completion: (line mode only)
+    (easy-menu-define nil map "Complete menu for Term mode."
+      '("Complete"
+        ["Complete Before Point" term-dynamic-complete t]
+        ["Complete File Name" term-dynamic-complete-filename t]
+        ["File Completion Listing" term-dynamic-list-filename-completions t]
+        ["Expand File Name" term-replace-by-expanded-filename t]))
     ;; Input history: (line mode only)
-    (let ((inout-menu (make-sparse-keymap "In/Out")))
-      (define-key map [menu-bar inout]
-        (cons "In/Out" inout-menu))
-      (define-key inout-menu [kill-output]
-        '("Kill Current Output Group" . term-kill-output))
-      (define-key inout-menu [next-prompt]
-        '("Forward Output Group" . term-next-prompt))
-      (define-key inout-menu [previous-prompt]
-        '("Backward Output Group" . term-previous-prompt))
-      (define-key inout-menu [show-maximum-output]
-        '("Show Maximum Output" . term-show-maximum-output))
-      (define-key inout-menu [show-output]
-        '("Show Current Output Group" . term-show-output))
-      (define-key inout-menu [kill-input]
-        '("Kill Current Input" . term-kill-input))
-      (define-key inout-menu [copy-input]
-        '("Copy Old Input" . term-copy-old-input))
-      (define-key inout-menu [forward-matching-history]
-        '("Forward Matching Input..." . term-forward-matching-input))
-      (define-key inout-menu [backward-matching-history]
-        '("Backward Matching Input..." . term-backward-matching-input))
-      (define-key inout-menu [next-matching-history]
-        '("Next Matching Input..." . term-next-matching-input))
-      (define-key inout-menu [previous-matching-history]
-        '("Previous Matching Input..." . term-previous-matching-input))
-      (define-key inout-menu [next-matching-history-from-input]
-        '("Next Matching Current Input" . term-next-matching-input-from-input))
-      (define-key inout-menu [previous-matching-history-from-input]
-        '("Previous Matching Current Input" .
-          term-previous-matching-input-from-input))
-      (define-key inout-menu [next-history]
-        '("Next Input" . term-next-input))
-      (define-key inout-menu [previous-history]
-        '("Previous Input" . term-previous-input))
-      (define-key inout-menu [list-history]
-        '("List Input History" . term-dynamic-list-input-ring))
-      (define-key inout-menu [expand-history]
-        '("Expand History Before Point" . term-replace-by-expanded-history)))
-
-    (define-key map [menu-bar signals] term-signals-menu)
-
-    map))
+    (easy-menu-define nil map "In/Out menu for Term mode."
+      '("In/Out"
+        ["Expand History Before Point" term-replace-by-expanded-history
+         term-input-autoexpand]
+        ["List Input History" term-dynamic-list-input-ring t]
+        ["Previous Input" term-previous-input t]
+        ["Next Input" term-next-input t]
+        ["Previous Matching Current Input"
+          term-previous-matching-input-from-input t]
+        ["Next Matching Current Input" term-next-matching-input-from-input t]
+        ["Previous Matching Input..." term-previous-matching-input t]
+        ["Next Matching Input..." term-next-matching-input t]
+        ["Backward Matching Input..." term-backward-matching-input t]
+        ["Forward Matching Input..." term-forward-matching-input t]
+        ["Copy Old Input" term-copy-old-input t]
+        ["Kill Current Input" term-kill-input t]
+        ["Show Current Output Group" term-show-output t]
+        ["Show Maximum Output" term-show-maximum-output t]
+        ["Backward Output Group" term-previous-prompt t]
+        ["Forward Output Group" term-next-prompt t]
+        ["Kill Current Output Group" term-kill-output t]))
+    map)
+  "Keymap for Term mode.")
 
 (defvar term-escape-char nil
   "Escape character for char sub-mode of term mode.
 Do not change it directly; use `term-set-escape-char' instead.")
 
-(defvar term-pager-break-map nil)
+(defvar term-pager-break-map
+  (let ((map (make-keymap)))
+    ;; (dotimes (i 128)
+    ;;   (define-key map (make-string 1 i) 'term-send-raw))
+    (define-key map "\e" (lookup-key (current-global-map) "\e"))
+    (define-key map "\C-x" (lookup-key (current-global-map) "\C-x"))
+    (define-key map "\C-u" (lookup-key (current-global-map) "\C-u"))
+    (define-key map " " 'term-pager-page)
+    (define-key map "\r" 'term-pager-line)
+    (define-key map "?" 'term-pager-help)
+    (define-key map "h" 'term-pager-help)
+    (define-key map "b" 'term-pager-back-page)
+    (define-key map "\177" 'term-pager-back-line)
+    (define-key map "q" 'term-pager-discard)
+    (define-key map "D" 'term-pager-disable)
+    (define-key map "<" 'term-pager-bob)
+    (define-key map ">" 'term-pager-eob)
+    map)
+  "Keymap used in Term pager mode.")
 
 (defvar term-ptyp t
   "True if communications via pty; false if by pipe.  Buffer local.
@@ -750,7 +726,6 @@ Buffer local variable.")
 ; assuming this is Emacs 19.20 or newer.
 (defvar term-pager-filter t)
 
-(put 'term-replace-by-expanded-history 'menu-enable 'term-input-autoexpand)
 (put 'term-input-ring 'permanent-local t)
 (put 'term-input-ring-index 'permanent-local t)
 (put 'term-input-autoexpand 'permanent-local t)
@@ -790,7 +765,7 @@ Buffer local variable.")
 
 ;;; Faces
 (defvar ansi-term-color-vector
-  [term-face
+  [term
    term-color-black
    term-color-red
    term-color-green
@@ -801,18 +776,20 @@ Buffer local variable.")
    term-color-white])
 
 (defcustom term-default-fg-color nil
-  "If non-nil, default color for foreground in Term mode.
-This is deprecated in favor of customizing the `term-face' face."
+  "If non-nil, default color for foreground in Term mode."
   :group 'term
-  :type 'string)
+  :type '(choice (const nil) (string :tag "color")))
+(make-obsolete-variable 'term-default-fg-color "use the face `term' instead."
+                        "24.3")
 
 (defcustom term-default-bg-color nil
-  "If non-nil, default color for foreground in Term mode.
-This is deprecated in favor of customizing the `term-face' face."
+  "If non-nil, default color for foreground in Term mode."
   :group 'term
-  :type 'string)
+  :type '(choice (const nil) (string :tag "color")))
+(make-obsolete-variable 'term-default-bg-color "use the face `term' instead."
+                        "24.3")
 
-(defface term-face
+(defface term
   `((t
      :foreground ,term-default-fg-color
      :background ,term-default-bg-color
@@ -879,28 +856,6 @@ is buffer-local."
   :group 'term
   :type 'integer)
 
-(defvar term-terminal-menu
-  (if (featurep 'xemacs)
-      '("Terminal"
-        [ "Character mode" term-char-mode (term-in-line-mode)]
-        [ "Line mode" term-line-mode (term-in-char-mode)]
-        [ "Enable paging" term-pager-toggle (not term-pager-count)]
-        [ "Disable paging" term-pager-toggle term-pager-count])
-    (let ((map (make-sparse-keymap "Terminal")))
-      (define-key map [terminal-pager-enable]
-        '(menu-item "Enable paging" term-fake-pager-enable
-          :help "Enable paging feature"))
-      (define-key map [terminal-pager-disable]
-        '(menu-item "Disable paging" term-fake-pager-disable
-          :help "Disable paging feature"))
-      (define-key map [terminal-char-mode]
-        '(menu-item "Character mode" term-char-mode
-          :help "Switch to char (raw) sub-mode of term mode"))
-      (define-key map [terminal-line-mode]
-        '(menu-item "Line mode" term-line-mode
-          :help "Switch to line (cooked) sub-mode of term mode"))
-      (cons "Terminal" map))))
-
 ;; Set up term-raw-map, etc.
 
 (defvar term-raw-map
@@ -920,9 +875,7 @@ is buffer-local."
 
     (if (featurep 'xemacs)
         (define-key map [button2] 'term-mouse-paste)
-      (define-key map [mouse-2] 'term-mouse-paste)
-      (define-key map [menu-bar terminal] term-terminal-menu)
-      (define-key map [menu-bar signals] term-signals-menu))
+      (define-key map [mouse-2] 'term-mouse-paste))
     (define-key map [up] 'term-send-up)
     (define-key map [down] 'term-send-down)
     (define-key map [right] 'term-send-right)
@@ -941,6 +894,46 @@ is buffer-local."
     map)
   "Keyboard map for sending characters directly to the inferior process.")
 
+(easy-menu-define term-terminal-menu
+  (list term-mode-map term-raw-map term-pager-break-map)
+  "Terminal menu for Term mode."
+  '("Terminal"
+    ["Line mode" term-line-mode :active (term-in-char-mode)
+     :help "Switch to line (cooked) sub-mode of term mode"]
+    ["Character mode" term-char-mode :active (term-in-line-mode)
+     :help "Switch to char (raw) sub-mode of term mode"]
+    ["Paging" term-pager-toggle :style toggle :selected term-pager-count
+     :help "Toggle paging feature"]))
+
+(easy-menu-define term-signals-menu
+  (list term-mode-map term-raw-map term-pager-break-map)
+  "Signals menu for Term mode."
+  '("Signals"
+    ["BREAK" term-interrupt-subjob :active t
+     :help "Interrupt the current subjob"]
+    ["STOP" term-stop-subjob :active t :help "Stop the current subjob"]
+    ["CONT" term-continue-subjob :active t
+     :help "Send CONT signal to process buffer's process group"]
+    ["QUIT" term-quit-subjob :active t
+     :help "Send quit signal to the current subjob"]
+    ["KILL" term-kill-subjob :active t
+     :help "Send kill signal to the current subjob"]
+    ["EOF" term-send-eof :active t
+     :help "Send an EOF to the current buffer's process"]))
+
+(easy-menu-define term-pager-menu term-pager-break-map
+  "Menu for Term pager mode."
+  '("More pages?"
+    ["1 page forwards" term-pager-page t]
+    ["1 page backwards" term-pager-back-page t]
+    ["1 line backwards" term-pager-back-line t]
+    ["1 line forwards" term-pager-line t]
+    ["Goto to beginning" term-pager-bob t]
+    ["Goto to end" term-pager-eob t]
+    ["Discard remaining output" term-pager-discard t]
+    ["Disable paging" term-pager-toggle t]
+    ["Help" term-pager-help t]))
+
 (defvar term-raw-escape-map
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map 'Control-X-prefix)
@@ -1003,13 +996,16 @@ is buffer-local."
     dt))
 
 (defun term-ansi-reset ()
-  (setq term-current-face 'term-face)
+  (setq term-current-face 'term)
   (setq term-ansi-current-underline nil)
   (setq term-ansi-current-bold nil)
   (setq term-ansi-current-reverse nil)
   (setq term-ansi-current-color 0)
   (setq term-ansi-current-invisible nil)
-  (setq term-ansi-face-already-done t)
+  ;; Stefan thought this should be t, but could not remember why.
+  ;; Setting it to t seems to cause bug#11785.  Setting it to nil
+  ;; again to see if there are other consequences...
+  (setq term-ansi-face-already-done nil)
   (setq term-ansi-current-bg-color 0))
 
 (define-derived-mode term-mode fundamental-mode "Term"
@@ -1151,9 +1147,8 @@ Entry to this mode runs the hooks on `term-mode-hook'."
 
   (set (make-local-variable 'font-lock-defaults) '(nil t))
 
-  (when (featurep 'xemacs)
-    (set-buffer-menubar
-     (append current-menubar (list term-terminal-menu))))
+  (easy-menu-add term-terminal-menu)
+  (easy-menu-add term-signals-menu)
   (or term-input-ring
       (setq term-input-ring (make-ring term-input-ring-size)))
   (term-update-mode-line))
@@ -1291,6 +1286,8 @@ intervention from Emacs, except for the escape character (usually C-c)."
   (when (term-in-line-mode)
     (setq term-old-mode-map (current-local-map))
     (use-local-map term-raw-map)
+    (easy-menu-add term-terminal-menu)
+    (easy-menu-add term-signals-menu)
 
     ;; Send existing partial line to inferior (without newline).
     (let ((pmark (process-mark (get-buffer-process (current-buffer))))
@@ -1315,8 +1312,31 @@ you type \\[term-send-input] which sends the current line to the inferior."
     (term-update-mode-line)))
 
 (defun term-update-mode-line ()
-  (let ((term-mode (if (term-in-char-mode) "char" "line"))
-        (term-page (when (term-pager-enabled) " page"))
+  (let ((term-mode
+         (if (term-in-char-mode)
+             (propertize "char"
+                         'help-echo "mouse-1: Switch to line mode"
+                         'mouse-face 'mode-line-highlight
+                         'local-map
+                         '(keymap
+                           (mode-line keymap (down-mouse-1 . term-line-mode))))
+           (propertize "line"
+                       'help-echo "mouse-1: Switch to char mode"
+                       'mouse-face 'mode-line-highlight
+                       'local-map
+                       '(keymap
+                         (mode-line keymap (down-mouse-1 . term-char-mode))))))
+        (term-page
+         (when (term-pager-enabled)
+           (concat " "
+                   (propertize
+                    "page"
+                    'help-echo "mouse-1: Disable paging"
+                    'mouse-face 'mode-line-highlight
+                    'local-map
+                    '(keymap
+                      (mode-line keymap (down-mouse-1 .
+                                                      term-pager-toggle)))))))
         (serial-item-speed)
         (serial-item-config)
         (proc (get-buffer-process (current-buffer))))
@@ -3202,18 +3222,24 @@ See `term-prompt-regexp'."
         (let ((color
                (if term-ansi-current-reverse
                    (face-foreground
-                    (elt ansi-term-color-vector term-ansi-current-color))
+                    (elt ansi-term-color-vector term-ansi-current-color)
+                    nil 'default)
                  (face-background
-                  (elt ansi-term-color-vector term-ansi-current-bg-color)))))
+                  (elt ansi-term-color-vector term-ansi-current-bg-color)
+                  nil 'default))))
           (setq term-current-face
                 (list :background color
                       :foreground color))
           ) ;; No need to bother with anything else if it's invisible.
       (setq term-current-face
             (list :foreground
-                  (face-foreground (elt ansi-term-color-vector term-ansi-current-color))
+                  (face-foreground
+                   (elt ansi-term-color-vector term-ansi-current-color)
+                   nil 'default)
                   :background
-                  (face-background (elt ansi-term-color-vector term-ansi-current-bg-color))
+                  (face-background
+                   (elt ansi-term-color-vector term-ansi-current-bg-color)
+                   nil 'default)
                   :inverse-video term-ansi-current-reverse))
 
       (when term-ansi-current-bold
@@ -3463,54 +3489,13 @@ The top-most line is line 0."
 ;; The page is full, so enter "pager" mode, and wait for input.
 
 (defun term-process-pager ()
-  (when (not term-pager-break-map)
-    (let* ((map (make-keymap))
-           ;; (i 0)
-           tmp)
-      ;; (while (< i 128)
-      ;;   (define-key map (make-string 1 i) 'term-send-raw)
-      ;;   (setq i (1+ i)))
-      (define-key map "\e"
-	(lookup-key (current-global-map) "\e"))
-      (define-key map "\C-x"
-	(lookup-key (current-global-map) "\C-x"))
-      (define-key map "\C-u"
-	(lookup-key (current-global-map) "\C-u"))
-      (define-key map " " 'term-pager-page)
-      (define-key map "\r" 'term-pager-line)
-      (define-key map "?" 'term-pager-help)
-      (define-key map "h" 'term-pager-help)
-      (define-key map "b" 'term-pager-back-page)
-      (define-key map "\177" 'term-pager-back-line)
-      (define-key map "q" 'term-pager-discard)
-      (define-key map "D" 'term-pager-disable)
-      (define-key map "<" 'term-pager-bob)
-      (define-key map ">" 'term-pager-eob)
-
-      ;; Add menu bar.
-      (unless (featurep 'xemacs)
-	(define-key map [menu-bar terminal] term-terminal-menu)
-	(define-key map [menu-bar signals] term-signals-menu)
-	(setq tmp (make-sparse-keymap "More pages?"))
-	(define-key tmp [help] '("Help" . term-pager-help))
-	(define-key tmp [disable]
-	  '("Disable paging" . term-fake-pager-disable))
-	(define-key tmp [discard]
-	  '("Discard remaining output" . term-pager-discard))
-	(define-key tmp [eob] '("Goto to end" . term-pager-eob))
-	(define-key tmp [bob] '("Goto to beginning" . term-pager-bob))
-	(define-key tmp [line] '("1 line forwards" . term-pager-line))
-	(define-key tmp [bline] '("1 line backwards" . term-pager-back-line))
-	(define-key tmp [back] '("1 page backwards" . term-pager-back-page))
-	(define-key tmp [page] '("1 page forwards" . term-pager-page))
-	(define-key map [menu-bar page] (cons "More pages?" tmp))
-	)
-
-      (setq term-pager-break-map map)))
   ;; (let ((process (get-buffer-process (current-buffer))))
   ;;   (stop-process process))
   (setq term-pager-old-local-map (current-local-map))
   (use-local-map term-pager-break-map)
+  (easy-menu-add term-terminal-menu)
+  (easy-menu-add term-signals-menu)
+  (easy-menu-add term-pager-menu)
   (make-local-variable 'term-old-mode-line-format)
   (setq term-old-mode-line-format mode-line-format)
   (setq mode-line-format
@@ -3591,14 +3576,6 @@ The top-most line is line 0."
   (interactive)
   (if (term-pager-enabled) (term-pager-disable) (term-pager-enable)))
 
-(unless (featurep 'xemacs)
- (defalias 'term-fake-pager-enable 'term-pager-toggle)
- (defalias 'term-fake-pager-disable 'term-pager-toggle)
- (put 'term-char-mode 'menu-enable '(term-in-line-mode))
- (put 'term-line-mode 'menu-enable '(term-in-char-mode))
- (put 'term-fake-pager-enable 'menu-enable '(not term-pager-count))
- (put 'term-fake-pager-disable 'menu-enable 'term-pager-count))
-
 (defun term-pager-help ()
   "Provide help on commands available in a terminal-emulator **MORE** break."
   (interactive)
@@ -4088,6 +4065,7 @@ Returns `partial' if completed as far as possible with the completion matches.
 Returns `listed' if a completion listing was shown.
 
 See also `term-dynamic-complete-filename'."
+  (declare (obsolete completion-in-region "23.2"))
   (let* ((completion-ignore-case nil)
 	 (candidates (mapcar (function (lambda (x) (list x))) candidates))
 	 (completions (all-completions stub candidates)))
@@ -4121,8 +4099,6 @@ See also `term-dynamic-complete-filename'."
  		   (t
 		    (message "Partially completed")
 		    'partial)))))))
-(make-obsolete 'term-dynamic-simple-complete 'completion-in-region "23.2")
-
 
 (defun term-dynamic-list-filename-completions ()
   "List in help buffer possible completions of the filename at point."
@@ -4214,11 +4190,16 @@ the process.  Any more args are arguments to PROGRAM."
   (term-mode)
   (term-char-mode)
 
-  ;; I wanna have find-file on C-x C-f -mm
-  ;; your mileage may definitely vary, maybe it's better to put this in your
-  ;; .emacs ...
-
-  (term-set-escape-char ?\C-x)
+  ;; Historical baggage.  A call to term-set-escape-char used to not
+  ;; undo any previous call to t-s-e-c.  Because of this, ansi-term
+  ;; ended up with both C-x and C-c as escape chars.  Who knows what
+  ;; the original intention was, but people could have become used to
+  ;; either.   (Bug#12842)
+  (let (term-escape-char)
+    ;; I wanna have find-file on C-x C-f -mm
+    ;; your mileage may definitely vary, maybe it's better to put this in your
+    ;; .emacs ...
+    (term-set-escape-char ?\C-x))
 
   (switch-to-buffer term-ansi-buffer-name))