Mercurial > emacs

changeset 82982:1747ce67f759

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merged in changes from CVS head Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-4 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-22
author Karoly Lorentey <lorentey@elte.hu>
date Mon, 29 Dec 2003 13:59:23 +0000
parents 56e4b7166995 (current diff) d3b9902eacfe (diff)
children 21720c013048
files lisp/ChangeLog
diffstat 7 files changed, 168 insertions(+), 63 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Mon Dec 29 08:28:35 2003 +0000
+++ b/lisp/ChangeLog	Mon Dec 29 13:59:23 2003 +0000
@@ -1,3 +1,25 @@
+2003-12-28  Sam Steingold  <sds@gnu.org>
+
+	* net/ange-ftp.el (ange-ftp-file-attributes): Add new optional
+	parameter ID-FORMAT to conform with the 2003-11-30 patch.
+
+2003-12-28  Nick Roberts  <nick@nick.uklinux.net>
+
+	* progmodes/gud.el (gud-gdb-command-name): Set default to
+	"gdb --annotate=3".
+	(gud-gdb-marker-filter): Look out for annotations.
+	(gdb-first-pre-prompt): New variable.
+	Remove trailing white space.
+
+	* gdb-ui.el (gdb-prompt): Change filter for level 3 annotations,
+	if necessary.
+	(gdb-ann3): New function. Initialise M-x gdb as for M-x gdba if
+	annotations are detected.
+	(gud-gdba-marker-filter): Use global variable gud-marker-acc
+	instead of a local one to allow transition from
+	gud-gdb-marker-filter.
+	Remove trailing white space.
+
 2003-12-27  Kim F. Storm  <storm@cua.dk>
 
 	* ido.el: Handle non-readable directories.
@@ -112,7 +134,7 @@
 	(group, documentation-string): Removed redundant (per 2003-10-25
 	change) calls to `widget-children-value-delete'.
 	(widget-choice-value-get, widget-choice-value-inline): Removed
-	functions. 
+	functions.
 	(menu-choice): Updated widget.
 
 2003-12-03  Kenichi Handa  <handa@m17n.org>
@@ -1888,7 +1910,7 @@
 	which does not exist in LaTeX.
 	(reftex-cite-format-builtin): Added amsrefs support.
 	(reftex-toc-confirm-promotion): New option
-	
+
 	* reftex-toc.el
 	(reftex-toc): Use `reftex-toc-split-windows-fraction'.
 	(reftex-toc-demote, reftex-toc-promote)
--- a/lisp/gdb-ui.el	Mon Dec 29 08:28:35 2003 +0000
+++ b/lisp/gdb-ui.el	Mon Dec 29 13:59:23 2003 +0000
@@ -42,8 +42,8 @@
 ;; info manual. Some GDB/MI commands are also used through th CLI command
 ;; 'interpreter mi <mi-command>'.
 ;;
-;; Known Bugs: 
-;; 
+;; Known Bugs:
+;;
 
 ;;; Code:
 
@@ -144,8 +144,10 @@
 			  (gud-call "until *%a" arg)))
 	   "\C-u" "Continue to current line or address.")
 
-  (define-key gud-minor-mode-map [left-margin mouse-1] 'gdb-mouse-toggle-breakpoint)
-  (define-key gud-minor-mode-map [left-fringe mouse-1] 'gdb-mouse-toggle-breakpoint)
+  (define-key gud-minor-mode-map [left-margin mouse-1]
+    'gdb-mouse-toggle-breakpoint)
+  (define-key gud-minor-mode-map [left-fringe mouse-1]
+    'gdb-mouse-toggle-breakpoint)
 
   (setq comint-input-sender 'gdb-send)
   ;;
@@ -158,6 +160,7 @@
   (setq gdb-selected-view 'source)
   (setq gdb-var-list nil)
   (setq gdb-var-changed nil)
+  (setq gdb-first-pre-prompt nil)
   ;;
   (mapc 'make-local-variable gdb-variables)
   (setq gdb-buffer-type 'gdba)
@@ -184,7 +187,7 @@
   "Watch expression at point."
   (interactive)
   (let ((expr (tooltip-identifier-from-point (point))))
-    (if (and (string-equal gdb-current-language "c") 
+    (if (and (string-equal gdb-current-language "c")
 	     gdb-use-colon-colon-notation)
 	(setq expr (concat gdb-current-frame "::" expr)))
     (catch 'already-watched
@@ -212,9 +215,9 @@
 	  (speedbar 1)
 	  (if (equal (nth 2 var) "0")
 	      (gdb-enqueue-input
-	       (list (concat "server interpreter mi \"-var-evaluate-expression " 
-			     (nth 1 var) "\"\n") 
-		     `(lambda () (gdb-var-evaluate-expression-handler 
+	       (list (concat "server interpreter mi \"-var-evaluate-expression "
+			     (nth 1 var) "\"\n")
+		     `(lambda () (gdb-var-evaluate-expression-handler
 				  ,(nth 1 var) nil))))
 	    (setq gdb-var-changed t)))
       (if (re-search-forward "Undefined command" nil t)
@@ -267,11 +270,11 @@
 		   (push varchild var-list)
 		   (if (equal (nth 2 varchild) "0")
 		       (gdb-enqueue-input
-			(list 
-			 (concat 
+			(list
+			 (concat
 			  "server interpreter mi \"-var-evaluate-expression "
-				 (nth 1 varchild) "\"\n") 
-			 `(lambda () (gdb-var-evaluate-expression-handler 
+				 (nth 1 varchild) "\"\n")
+			 `(lambda () (gdb-var-evaluate-expression-handler
 				      ,(nth 1 varchild) nil))))))))
 	   (push var var-list)))
        (setq gdb-var-list (nreverse var-list))))))
@@ -279,7 +282,7 @@
 (defun gdb-var-update ()
   (if (not (member 'gdb-var-update (gdb-get-pending-triggers)))
       (progn
-	(gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n" 
+	(gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n"
 				 'gdb-var-update-handler))
 	(gdb-set-pending-triggers (cons 'gdb-var-update
 					(gdb-get-pending-triggers))))))
@@ -292,9 +295,9 @@
     (while (re-search-forward gdb-var-update-regexp nil t)
 	(let ((varnum (match-string 1)))
 	  (gdb-enqueue-input
-	   (list (concat "server interpreter mi \"-var-evaluate-expression " 
+	   (list (concat "server interpreter mi \"-var-evaluate-expression "
 			 varnum "\"\n") 
-		     `(lambda () (gdb-var-evaluate-expression-handler 
+		     `(lambda () (gdb-var-evaluate-expression-handler
 				  ,varnum t)))))))
   (gdb-set-pending-triggers
    (delq 'gdb-var-update (gdb-get-pending-triggers))))
@@ -683,6 +686,9 @@
 (defun gdb-prompt (ignored)
   "An annotation handler for `prompt'.
 This sends the next command (if any) to gdb."
+  (when gdb-first-pre-prompt
+      (gdb-ann3)
+      (setq gdb-first-pre-prompt nil))
   (let ((sink (gdb-get-output-sink)))
     (cond
      ((eq sink 'user) t)
@@ -702,6 +708,66 @@
 	(gdb-set-prompting t)
 	(gud-display-frame)))))
 
+(defun gdb-ann3 ()
+  (set (make-local-variable 'gud-minor-mode) 'gdba)
+  (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter)
+  ;;
+  (gud-def gud-break (if (not (string-equal mode-name "Machine"))
+			 (gud-call "break %f:%l" arg)
+		       (save-excursion
+			 (beginning-of-line)
+			 (forward-char 2)
+			 (gud-call "break *%a" arg)))
+	   "\C-b" "Set breakpoint at current line or address.")
+  ;;
+  (gud-def gud-remove (if (not (string-equal mode-name "Machine"))
+			  (gud-call "clear %f:%l" arg)
+			(save-excursion
+			  (beginning-of-line)
+			  (forward-char 2)
+			  (gud-call "clear *%a" arg)))
+	   "\C-d" "Remove breakpoint at current line or address.")
+  ;;
+  (gud-def gud-until  (if (not (string-equal mode-name "Machine"))
+			  (gud-call "until %f:%l" arg)
+			(save-excursion
+			  (beginning-of-line)
+			  (forward-char 2)
+			  (gud-call "until *%a" arg)))
+	   "\C-u" "Continue to current line or address.")
+
+  (define-key gud-minor-mode-map [left-margin mouse-1]
+    'gdb-mouse-toggle-breakpoint)
+  (define-key gud-minor-mode-map [left-fringe mouse-1]
+    'gdb-mouse-toggle-breakpoint)
+
+  (setq comint-input-sender 'gdb-send)
+  ;;
+  ;; (re-)initialise
+  (setq gdb-current-address "main")
+  (setq gdb-previous-address nil)
+  (setq gdb-previous-frame nil)
+  (setq gdb-current-frame "main")
+  (setq gdb-view-source t)
+  (setq gdb-selected-view 'source)
+  (setq gdb-var-list nil)
+  (setq gdb-var-changed nil)
+  ;;
+  (mapc 'make-local-variable gdb-variables)
+  (setq gdb-buffer-type 'gdba)
+  ;;
+  (gdb-clear-inferior-io)
+  ;;
+  (if (eq window-system 'w32)
+      (gdb-enqueue-input (list "set new-console off\n" 'ignore)))
+  (gdb-enqueue-input (list "set height 0\n" 'ignore))
+  ;; find source file and compilation directory here
+  (gdb-enqueue-input (list "server list main\n"   'ignore))   ; C program
+  (gdb-enqueue-input (list "server list MAIN__\n" 'ignore))   ; Fortran program
+  (gdb-enqueue-input (list "server info source\n" 'gdb-source-info))
+  ;;
+  (run-hooks 'gdba-mode-hook))
+
 (defun gdb-subprompt (ignored)
   "An annotation handler for non-top-level prompts."
   (gdb-set-prompting t))
@@ -775,15 +841,14 @@
 
 (defun gud-gdba-marker-filter (string)
   "A gud marker filter for gdb. Handle a burst of output from GDB."
-  (let (
-	;; Recall the left over burst from last time
-	(burst (concat (gdb-get-burst) string))
-	;; Start accumulating output for the GUD buffer
-	(output ""))
+  ;; Recall the left over gud-marker-acc from last time
+  (setq gud-marker-acc (concat gud-marker-acc string))
+  ;; Start accumulating output for the GUD buffer
+  (let ((output ""))
     ;;
     ;; Process all the complete markers in this chunk.
-    (while (string-match "\n\032\032\\(.*\\)\n" burst)
-      (let ((annotation (match-string 1 burst)))
+    (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
+      (let ((annotation (match-string 1 gud-marker-acc)))
 	;;
 	;; Stuff prior to the match is just ordinary output.
 	;; It is either concatenated to OUTPUT or directed
@@ -791,11 +856,11 @@
 	(setq output
 	      (gdb-concat-output
 	       output
-	       (substring burst 0 (match-beginning 0))))
-
-	;; Take that stuff off the burst.
-	(setq burst (substring burst (match-end 0)))
-
+	       (substring gud-marker-acc 0 (match-beginning 0))))
+        ;;
+	;; Take that stuff off the gud-marker-acc.
+	(setq gud-marker-acc (substring gud-marker-acc (match-end 0)))
+        ;;
 	;; Parse the tag from the annotation, and maybe its arguments.
 	(string-match "\\(\\S-*\\) ?\\(.*\\)" annotation)
 	(let* ((annotation-type (match-string 1 annotation))
@@ -812,25 +877,23 @@
 	    ))))
     ;;
     ;; Does the remaining text end in a partial line?
-    ;; If it does, then keep part of the burst until we get more.
+    ;; If it does, then keep part of the gud-marker-acc until we get more.
     (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
-		      burst)
+		      gud-marker-acc)
 	(progn
 	  ;; Everything before the potential marker start can be output.
 	  (setq output
 		(gdb-concat-output output
-				   (substring burst 0 (match-beginning 0))))
+				   (substring gud-marker-acc 0
+					      (match-beginning 0))))
 	  ;;
 	  ;; Everything after, we save, to combine with later input.
-	  (setq burst (substring burst (match-beginning 0))))
+	  (setq gud-marker-acc (substring gud-marker-acc (match-beginning 0))))
       ;;
-      ;; In case we know the burst contains no partial annotations:
+      ;; In case we know the gud-marker-acc contains no partial annotations:
       (progn
-	(setq output (gdb-concat-output output burst))
-	(setq burst "")))
-    ;;
-    ;; Save the remaining burst for the next call to this function.
-    (gdb-set-burst burst)
+	(setq output (gdb-concat-output output gud-marker-acc))
+	(setq gud-marker-acc "")))
     output))
 
 (defun gdb-concat-output (so-far new)
@@ -1552,7 +1615,7 @@
 )
 
 (let ((menu (make-sparse-keymap "View")))
-   (define-key gud-menu-map [view] 
+   (define-key gud-menu-map [view]
      `(menu-item "View" ,menu :visible (eq gud-minor-mode 'gdba)))
 ;  (define-key menu [both] '(menu-item "Both" gdb-view-both
 ;	       :help "Display both source and assembler"
@@ -1619,7 +1682,7 @@
   (other-window 1)
   (switch-to-buffer (gdb-locals-buffer-name))
   (other-window 1)
-  (if (and gdb-view-source 
+  (if (and gdb-view-source
 	   (eq gdb-selected-view 'source))
       (switch-to-buffer
        (if gud-last-last-frame
@@ -1665,7 +1728,7 @@
     (delete-other-windows)
     (split-window)
     (other-window 1)
-    (if (and gdb-view-source 
+    (if (and gdb-view-source
 	   (eq gdb-selected-view 'source))
 	(switch-to-buffer
 	 (if gud-last-last-frame
@@ -1888,7 +1951,7 @@
 	(unless (string-equal gdb-current-frame gdb-previous-frame)
 	  (if (or (not (member 'gdb-invalidate-assembler
 			       (gdb-get-pending-triggers)))
-		  (not (string-equal gdb-current-address 
+		  (not (string-equal gdb-current-address
 				     gdb-previous-address)))
 	  (progn
 	    ;; take previous disassemble command off the queue
@@ -1896,7 +1959,7 @@
 	      (let ((queue (gdb-get-input-queue)) (item))
 		(dolist (item queue)
 		  (if (equal (cdr item) '(gdb-assembler-handler))
-		      (gdb-set-input-queue 
+		      (gdb-set-input-queue
 		       (delete item (gdb-get-input-queue)))))))
 	    (gdb-enqueue-input
 	     (list (concat "server disassemble " gdb-current-address "\n")
@@ -1928,14 +1991,14 @@
 	  (let ((address (match-string 1)))
 	    ;; remove leading 0s from output of info frame command.
 	    (if (string-match "^0+\\(.*\\)" address)
-		(setq gdb-current-address 
+		(setq gdb-current-address
 		      (concat "0x" (match-string 1 address)))
 	      (setq gdb-current-address (concat "0x" address))))
 	  (if (or (if (not (looking-at ".*(\\S-*:[0-9]*)"))
 		      (progn (setq gdb-view-source nil) t))
 		  (eq gdb-selected-view 'assembler))
 	      (progn
-		(set-window-buffer 
+		(set-window-buffer
 		 gdb-source-window
 		 (gdb-get-create-buffer 'gdb-assembler-buffer))
 		;;update with new frame for machine code if necessary
--- a/lisp/net/ange-ftp.el	Mon Dec 29 08:28:35 2003 +0000
+++ b/lisp/net/ange-ftp.el	Mon Dec 29 13:59:23 2003 +0000
@@ -3434,7 +3434,7 @@
 	  (nreverse files)))
     (apply 'ange-ftp-real-directory-files directory full match v19-args)))
 
-(defun ange-ftp-file-attributes (file)
+(defun ange-ftp-file-attributes (file &optional id-format)
   (setq file (expand-file-name file))
   (let ((parsed (ange-ftp-ftp-name file)))
     (if parsed
@@ -3467,7 +3467,7 @@
 		      inode		;10 "inode number".
 		      -1		;11 device number [v19 only]
 		      ))))
-      (ange-ftp-real-file-attributes file))))
+      (ange-ftp-real-file-attributes file id-format))))
 
 (defun ange-ftp-file-newer-than-file-p (f1 f2)
   (let ((f1-parsed (ange-ftp-ftp-name f1))
--- a/lisp/progmodes/gud.el	Mon Dec 29 08:28:35 2003 +0000
+++ b/lisp/progmodes/gud.el	Mon Dec 29 13:59:23 2003 +0000
@@ -319,10 +319,10 @@
 If the GUD BUFFER is not running a supported debugger, then turn
 off the specialized speedbar mode."
   (let ((minor-mode (with-current-buffer buffer gud-minor-mode)))
-    (cond 
+    (cond
      ((eq minor-mode 'gdba)
       (when (or gdb-var-changed
-		(not (save-excursion 
+		(not (save-excursion
 		       (goto-char (point-min))
 		       (let ((case-fold-search t))
 			 (looking-at "Watch Expressions:")))))
@@ -339,8 +339,8 @@
 		  (speedbar-make-tag-line 'bracket ?? nil nil
 					  (concat (car var) "\t" (nth 4 var))
 					  'gdb-edit-value
-					  nil 
-					  (if (and (nth 5 var) 
+					  nil
+					  (if (and (nth 5 var)
 						   gdb-show-changed-values)
 					      'font-lock-warning-face
 					    nil) depth)
@@ -354,7 +354,7 @@
 					nil nil depth)))
 	    (setq var-list (cdr var-list))))
 	(setq gdb-var-changed nil)))
-     (t (if (and (save-excursion 
+     (t (if (and (save-excursion
 		   (goto-char (point-min))
 		   (looking-at "Current Stack"))
 		 (equal gud-last-last-frame gud-last-speedbar-stackframe))
@@ -406,7 +406,7 @@
 ;; History of argument lists passed to gdb.
 (defvar gud-gdb-history nil)
 
-(defcustom gud-gdb-command-name "gdb --fullname"
+(defcustom gud-gdb-command-name "gdb --annotate=3"
   "Default command to execute an executable under the GDB debugger."
    :type 'string
    :group 'gud)
@@ -447,6 +447,19 @@
        ;; Set the accumulator to the remaining text.
        gud-marker-acc (substring gud-marker-acc (match-end 0))))
 
+    (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
+      (when (string-equal (match-string 1 gud-marker-acc) "prompt")
+	(require 'gdb-ui)
+	(gdb-prompt nil))
+      (setq
+       ;; Append any text before the marker to the output we're going
+       ;; to return - we don't include the marker in this text.
+       output (concat output
+		      (substring gud-marker-acc 0 (match-beginning 0)))
+
+       ;; Set the accumulator to the remaining text.
+       gud-marker-acc (substring gud-marker-acc (match-end 0))))
+
     ;; Does the remaining text look like it might end with the
     ;; beginning of another marker?  If it does, then keep it in
     ;; gud-marker-acc until we receive the rest of it.	Since we
@@ -492,6 +505,8 @@
      gud-minibuffer-local-map nil
      hist-sym)))
 
+(defvar gdb-first-pre-prompt t)
+
 ;;;###autoload
 (defun gdb (command-line)
   "Run gdb on program FILE in buffer *gud-FILE*.
@@ -522,8 +537,8 @@
   (local-set-key "\C-i" 'gud-gdb-complete-command)
   (setq comint-prompt-regexp "^(.*gdb[+]?) *")
   (setq paragraph-start comint-prompt-regexp)
-  (run-hooks 'gdb-mode-hook)
-  )
+  (setq gdb-first-pre-prompt t)
+  (run-hooks 'gdb-mode-hook))
 
 ;; One of the nice features of GDB is its impressive support for
 ;; context-sensitive command completion.  We preserve that feature
--- a/src/ChangeLog	Mon Dec 29 08:28:35 2003 +0000
+++ b/src/ChangeLog	Mon Dec 29 13:59:23 2003 +0000
@@ -1,3 +1,7 @@
+2003-12-28  Luc Teirlinck  <teirllm@auburn.edu>
+
+	* coding.c (Fcheck_coding_system): Doc fix.
+
 2003-12-28  Kim F. Storm  <storm@cua.dk>
 
 	* Makefile.in (eval.o): Depend on dispextern.h.
--- a/src/buffer.c	Mon Dec 29 08:28:35 2003 +0000
+++ b/src/buffer.c	Mon Dec 29 13:59:23 2003 +0000
@@ -89,10 +89,6 @@
    If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
    but there is a default value which is copied into each buffer.
 
-   If a slot in this structure is negative, then even though there may
-   be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
-   and the corresponding slot in buffer_defaults is not used.
-
    If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
    zero, that is a bug */
 
@@ -1202,6 +1198,10 @@
       buf = Fcdr (XCAR (tail));
       if (EQ (buf, buffer))
 	continue;
+      if (NILP (buf))
+	continue;
+      if (NILP (XBUFFER (buf)->name))
+	continue;
       if (SREF (XBUFFER (buf)->name, 0) == ' ')
 	continue;
       /* If the selected frame has a buffer_predicate,
@@ -1429,7 +1429,8 @@
   if (STRINGP (b->auto_save_file_name)
       && b->auto_save_modified != 0
       && BUF_SAVE_MODIFF (b) < b->auto_save_modified
-      && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
+      && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
+      && NILP (Fsymbol_value (intern ("auto-save-visited-file-name"))))
     {
       Lisp_Object tem;
       tem = Fsymbol_value (intern ("delete-auto-save-files"));
--- a/src/coding.c	Mon Dec 29 08:28:35 2003 +0000
+++ b/src/coding.c	Mon Dec 29 13:59:23 2003 +0000
@@ -6385,8 +6385,8 @@
        1, 1, 0,
        doc: /* Check validity of CODING-SYSTEM.
 If valid, return CODING-SYSTEM, else signal a `coding-system-error' error.
-It is valid if it is a symbol with a non-nil `coding-system' property.
-The value of property should be a vector of length 5.  */)
+It is valid if it is nil or a symbol with a non-nil `coding-system' property.
+The value of this property should be a vector of length 5.  */)
      (coding_system)
      Lisp_Object coding_system;
 {