Merge from emacs--devo--0

Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-308

2 files changed, 74 insertions, 42 deletions

diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 75bcb8ed138..1c1016aed97 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -64,33 +64,50 @@ hash table."
      dbus-registered-functions-table)
     result))
 
-(defun dbus-name-owner-changed-handler (service old-owner new-owner)
+(defun dbus-name-owner-changed-handler (&rest args)
   "Reapplies all signal registrations to D-Bus.
 This handler is applied when a \"NameOwnerChanged\" signal has
 arrived.  SERVICE is the object name for which the name owner has
 been changed.  OLD-OWNER is the previous owner of SERVICE, or the
 empty string if SERVICE was not owned yet.  NEW-OWNER is the new
-owner of SERVICE, or the empty string if SERVICE looses any name owner."
+owner of SERVICE, or the empty string if SERVICE looses any name owner.
+
+usage: (dbus-name-owner-changed-handler service old-owner new-owner)"
   (save-match-data
-    ;; Check whether SERVICE is a known name.
-    (when (and (stringp service) (not (string-match "^:" service))
-	       (stringp old-owner) (stringp new-owner))
-      (maphash
-       '(lambda (key value)
-	  (dolist (elt value)
-	    ;; key has the structure (BUS INTERFACE SIGNAL).
-	    ;; elt has the structure (UNAME SERVICE PATH HANDLER).
-	    (when (string-equal old-owner (car elt))
-	      ;; Remove old key, and add new entry with changed name.
-	      (dbus-unregister-signal (list key (cdr elt)))
-	      ;; Maybe we could arrange the lists a little bit better
-	      ;; that we don't need to extract every single element?
-	      (dbus-register-signal
-	       ;; BUS      SERVICE     PATH
-	       (nth 0 key) (nth 1 elt) (nth 2 elt)
-	       ;; INTERFACE SIGNAL     HANDLER
-	       (nth 1 key) (nth 2 key) (nth 3 elt)))))
-       (copy-hash-table dbus-registered-functions-table)))))
+    ;; Check the arguments.  We should silently ignore it when they
+    ;; are wrong.
+    (if (and (= (length args) 3)
+	     (stringp (car args))
+	     (stringp (cadr args))
+	     (stringp (caddr args)))
+	(let ((service (car args))
+	      (old-owner (cadr args))
+	      (new-owner (caddr args)))
+	  ;; Check whether SERVICE is a known name.
+	  (when (not (string-match "^:" service))
+	    (maphash
+	     '(lambda (key value)
+		(dolist (elt value)
+		  ;; key has the structure (BUS INTERFACE SIGNAL).
+		  ;; elt has the structure (UNAME SERVICE PATH HANDLER).
+		  (when (string-equal old-owner (car elt))
+		    ;; Remove old key, and add new entry with changed name.
+		    (dbus-unregister-signal (list key (cdr elt)))
+		    ;; Maybe we could arrange the lists a little bit better
+		    ;; that we don't need to extract every single element?
+		    (dbus-register-signal
+		     ;; BUS      SERVICE     PATH
+		     (nth 0 key) (nth 1 elt) (nth 2 elt)
+		     ;; INTERFACE SIGNAL     HANDLER
+		     (nth 1 key) (nth 2 key) (nth 3 elt)))))
+	     (copy-hash-table dbus-registered-functions-table))))
+      ;; The error is reported only in debug mode.
+      (when  dbus-debug
+	(signal
+	 'dbus-error
+	 (cons
+	  (format "Wrong arguments of %s.NameOwnerChanged" dbus-interface-dbus)
+	  args))))))
 
 ;; Register the handler.
 (condition-case nil
@@ -148,11 +165,11 @@ part of the event, is called with arguments ARGS."
   (interactive "e")
   ;; We don't want to raise an error, because this function is called
   ;; in the event handling loop.
-  (condition-case nil
+  (condition-case err
       (progn
 	(dbus-check-event event)
 	(apply (nth 6 event) (nthcdr 7 event)))
-    (dbus-error)))
+    (dbus-error (when dbus-debug (signal (car err) (cdr err))))))
 
 (defun dbus-event-bus-name (event)
   "Return the bus name the event is coming from.
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index a1a0e0ca8e9..06e5c1ad678 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1480,32 +1480,47 @@ record activity."
 	(run-hook-with-args 'rcirc-print-hooks
 			    process sender response target text)))))
 
+(defcustom rcirc-log-filename-function 'rcirc-generate-new-buffer-name
+  "A function to generate the filename used by rcirc's logging facility.
+
+It is called with two arguments, PROCESS and TARGET (see
+`rcirc-generate-new-buffer-name' for their meaning), and should
+return the filename, or nil if no logging is desired for this
+session.
+
+If the returned filename is absolute (`file-name-absolute-p'
+returns true), then it is used as-is, otherwise the resulting
+file is put into `rcirc-log-directory'."
+  :group 'rcirc
+  :type 'function)
+
 (defun rcirc-log (process sender response target text)
   "Record line in `rcirc-log', to be later written to disk."
-  (let* ((filename (rcirc-generate-new-buffer-name process target))
-	 (cell (assoc-string filename rcirc-log-alist))
-	 (line (concat (format-time-string rcirc-time-format)
-		       (substring-no-properties
-			(rcirc-format-response-string process sender
-						      response target text))
-		       "\n")))
-    (if cell
-	(setcdr cell (concat (cdr cell) line))
-      (setq rcirc-log-alist
-	    (cons (cons filename line) rcirc-log-alist)))))
+  (let ((filename (funcall rcirc-log-filename-function process target)))
+    (unless (null filename)
+      (let ((cell (assoc-string filename rcirc-log-alist))
+	    (line (concat (format-time-string rcirc-time-format)
+			  (substring-no-properties
+			   (rcirc-format-response-string process sender
+							 response target text))
+			  "\n")))
+	(if cell
+	    (setcdr cell (concat (cdr cell) line))
+	  (setq rcirc-log-alist
+		(cons (cons filename line) rcirc-log-alist)))))))
 
 (defun rcirc-log-write ()
   "Flush `rcirc-log-alist' data to disk.
 
-Log data is written to `rcirc-log-directory'."
-  (make-directory rcirc-log-directory t)
+Log data is written to `rcirc-log-directory', except for
+log-files with absolute names (see `rcirc-log-filename-function')."
   (dolist (cell rcirc-log-alist)
-    (with-temp-buffer
-      (insert (cdr cell))
-      (let ((coding-system-for-write 'utf-8))
-	(write-region (point-min) (point-max)
-		      (concat rcirc-log-directory "/" (car cell))
-		      t 'quiet))))
+    (let ((filename (expand-file-name (car cell) rcirc-log-directory))
+	  (coding-system-for-write 'utf-8))
+      (make-directory (file-name-directory filename) t)
+      (with-temp-buffer
+	(insert (cdr cell))
+	(write-region (point-min) (point-max) filename t 'quiet))))
   (setq rcirc-log-alist nil))
 
 (defun rcirc-join-channels (process channels)