--- a/lisp/ChangeLog	Sun Mar 08 20:59:25 2015 +0000
+++ b/lisp/ChangeLog	Wed Mar 11 15:06:05 2015 +0000
@@ -1,3 +1,22 @@
+2015-03-11  Aidan Kehoe  <kehoea@parhasard.net>
+
+	Correct #'clear-message and friends so the START and END supplied
+	to #'append-message are reflected when restoring messages from the
+	message stack.
+	* simple.el (remove-message-hook):
+	Update this to reflect the START and END keyword arguments.
+	* simple.el (log-message):
+	Update this to take START and END keyword arguments.
+	* simple.el (clear-message):
+	Update this to reflect a changed `message-stack' alist structure.
+	* simple.el (remove-message):
+	Update this to reflect a changed `message-stack' alist structure;
+	don't do `with-trapping-errors' and resignal use
+	#'call-with-condition-handler directly instead, for better
+	backtraces and easier debugging.
+	* simple.el (append-message):
+	Update this to reflect a changed message-stack structure.
+
 2014-12-31  Michael Sperber  <mike@xemacs.org>
 
 	* simple.el (line-move): Add `noerror' optional argument, as in

--- a/lisp/simple.el	Sun Mar 08 20:59:25 2015 +0000
+++ b/lisp/simple.el	Wed Mar 11 15:06:05 2015 +0000
@@ -4166,8 +4166,9 @@
 (defvar remove-message-hook 'log-message
   "A function or list of functions to be called when a message is removed
 from the echo area at the bottom of the frame.  The label of the removed
-message is passed as the first argument, and the text of the message
-as the second argument.")
+message is passed as the first argument, the text of the message as the second
+argument, and the start and end of the substring of the message can be
+supplied as keyword arguments.")
 
 (defcustom log-message-max-size 50000
   "Maximum size of the \" *Message-Log*\" buffer.  See `log-message'."
@@ -4300,7 +4301,7 @@
   "For use as the `log-message-filter-function'.  Only logs error messages."
   (eq label 'error))
 
-(defun log-message (label message)
+(defun* log-message (label message &key (start 0) end)
   "Stuff a copy of the message into the \" *Message-Log*\" buffer,
 if it satisfies the `log-message-filter-function'.
 
@@ -4316,12 +4317,10 @@
       (let (extent)
 	;; Mark multiline message with an extent, which `view-lossage'
 	;; will recognize.
-	(save-match-data
-	  (when (string-match "\n" message)
-	    (setq extent (make-extent (point) (point)))
-	    (set-extent-properties extent '(end-open nil message-multiline t)))
-	  )
-	(insert message "\n")
+        (when (find ?\n message :start start :end end)
+          (setq extent (make-extent (point) (point)))
+          (set-extent-properties extent '(end-open nil message-multiline t)))
+	(write-line message (current-buffer) :start start :end end)
 	(when extent
 	  (set-extent-property extent 'end-open t)))
       (when (> (point-max) (max log-message-max-size (point-min)))
@@ -4377,42 +4376,48 @@
     (if no-restore
 	nil			; just preparing to put another msg up
       (if message-stack
-	  (let ((oldmsg (cdr (car message-stack))))
-	    (raw-append-message oldmsg frame stdout-p)
-	    oldmsg)
+          (let ((oldmsg (second (car message-stack))))
+            (prog1
+                ;; #### Doesn't pass back information about the substring of
+                ;; OLDMSG displayed. None of our callers use this, as of
+                ;; 20150311, though.
+                oldmsg
+              (raw-append-message oldmsg frame stdout-p
+                                  :start (third (car message-stack))
+                                  :end (fourth (car message-stack)))))
 	;; #### Should we (redisplay-echo-area) here?  Messes some
 	;; things up.
 	nil))))
 
 (defun remove-message (&optional label frame)
-  ;; If label is nil, we want to remove all matching messages.
-  ;; Must reverse the stack first to log them in the right order.
-  (let ((log nil))
-    (while (and message-stack
-		(or (null label)	; null label means clear whole stack
-		    (eq label (car (car message-stack)))))
-      (push (car message-stack) log)
-      (setq message-stack (cdr message-stack)))
-    (let ((s  message-stack))
-      (while (cdr s)
-	(let ((msg (car (cdr s))))
-	  (if (eq label (car msg))
-	      (progn
-		(push msg log)
-		(setcdr s (cdr (cdr s))))
-	    (setq s (cdr s))))))
+  "Remove any message with a specified LABEL from `message-stack'.
+
+With nil LABEL, remove all messages from `message-stack'. Calls those
+functions specified by `remove-message-hook' with the details of each removed
+message."
+  (let (log)
+    (if label
+        (setq log (reverse (remove* label message-stack :test-not #'eq
+                                    :key #'car))
+              message-stack (delete* label message-stack :key #'car))
+      ;; If label is nil, we want to remove all messages.  Must reverse the
+      ;; stack first to log them in the right order.
+      (setq log (nreverse message-stack)
+            message-stack nil))
     ;; (possibly) log each removed message
     (while log
-      (with-trapping-errors
-	:operation 'remove-message-hook
-	:class 'message-log
-	:error-form (progn
-		      (setq remove-message-hook nil)
-		      (let ((inhibit-read-only t))
-			(erase-buffer " *Echo Area*")))
-	:resignal t
-	(run-hook-with-args 'remove-message-hook
-			    (car (car log)) (cdr (car log))))
+      (call-with-condition-handler
+          ((macro . (lambda (function) (subst '#:xEbgpd2 'error function)))
+           #'(lambda (error)
+               (setq remove-message-hook nil)
+               (let ((inhibit-read-only t))
+                 (erase-buffer " *Echo Area*"))
+               (lwarn 'message-log 'warning
+                 "Error in `remove-message-hook': %s\n\nBacktrace follows:\n%s"
+                 (error-message-string error)
+                 (backtrace-in-condition-handler-eliminating-handler 'error))))
+          #'run-hook-with-args 'remove-message-hook (caar log)
+	  (cadar log) :start (third (car log)) :end (fourth (car log)))
       (setq log (cdr log)))))
 
 (defun* append-message (label message &optional frame stdout-p
@@ -4436,10 +4441,16 @@
   ;; able to append to an existing message.
   (if (eq 'stream (frame-type frame))
       (set-device-clear-left-side (frame-device frame) nil))
-  (let ((top (car message-stack)))
-    (if (eq label (car top))
-	(setcdr top (concat (cdr top) message))
-      (push (cons label message) message-stack)))
+  (if (eq label (caar message-stack))
+      (setf (cadar message-stack)
+            (concat (subseq (cadar message-stack) (third (car message-stack))
+                            (fourth (car message-stack)))
+                    (if (or end (not (eql start 0)))
+                        (subseq message start end)
+                      message))
+            (caddar message-stack) nil
+            (car (cdddar message-stack)) nil)
+    (push (list label message start end) message-stack))
   (raw-append-message message frame stdout-p :start start :end end)
   (if (eq 'stream (frame-type frame))
       (set-device-clear-left-side (frame-device frame) t)))