Synch to No Gnus 200406292138.
[elisp/gnus.git-] / lisp / gnus-util.el
index 5427912..65707dd 100644 (file)
 ;; Gnus first.
 
 ;; [Unfortunately, it does depend on other parts of Gnus, e.g. the
-;; autoloads below...]
+;; autoloads and defvars below...]
 
 ;;; Code:
 
 (eval-when-compile
   (require 'cl)
   ;; Fixme: this should be a gnus variable, not nnmail-.
-  (defvar nnmail-pathname-coding-system))
-(eval-when-compile (require 'static))
+  (defvar nnmail-pathname-coding-system)
+
+  ;; Inappropriate references to other parts of Gnus.
+  (defvar gnus-emphasize-whitespace-regexp)
+  )
 
-(require 'custom)
 (require 'time-date)
 (require 'netrc)
 
+(eval-when-compile (require 'static))
+
 (eval-and-compile
   (autoload 'message-fetch-field "message")
   (autoload 'gnus-get-buffer-window "gnus-win")
     (defalias 'gnus-replace-in-string 'replace-in-string))
    ((fboundp 'replace-regexp-in-string)
     (defun gnus-replace-in-string  (string regexp newtext &optional literal)
-      (replace-regexp-in-string regexp newtext string nil literal)))
-   (t
-    (defun gnus-replace-in-string (string regexp newtext &optional literal)
-      (let ((start 0) tail)
-       (while (string-match regexp string start)
-         (setq tail (- (length string) (match-end 0)))
-         (setq string (replace-match newtext nil literal string))
-         (setq start (- (length string) tail))))
-      string))))
-
-;;; bring in the netrc functions as aliases
-(defalias 'gnus-netrc-get 'netrc-get)
-(defalias 'gnus-netrc-machine 'netrc-machine)
-(defalias 'gnus-parse-netrc 'netrc-parse)
+      (replace-regexp-in-string regexp newtext string nil literal)))))
 
 (defun gnus-boundp (variable)
   "Return non-nil if VARIABLE is bound and non-nil."
@@ -204,8 +195,7 @@ is slower."
   "Return the value of the header FIELD of current article."
   (save-excursion
     (save-restriction
-      (let ((case-fold-search t)
-           (inhibit-point-motion-hooks t))
+      (let ((inhibit-point-motion-hooks t))
        (nnheader-narrow-to-headers)
        (message-fetch-field field)))))
 
@@ -232,12 +222,15 @@ is slower."
 
 (defun gnus-remove-text-with-property (prop)
   "Delete all text in the current buffer with text property PROP."
-  (save-excursion
-    (goto-char (point-min))
-    (while (not (eobp))
-      (while (get-text-property (point) prop)
-       (delete-char 1))
-      (goto-char (next-single-property-change (point) prop nil (point-max))))))
+  (let ((start (point-min))
+       end)
+    (unless (get-text-property start prop)
+      (setq start (next-single-property-change start prop)))
+    (while start
+      (setq end (text-property-any start (point-max) prop nil))
+      (delete-region start (or end (point-max)))
+      (setq start (when end
+                   (next-single-property-change start prop))))))
 
 (defun gnus-newsgroup-directory-form (newsgroup)
   "Make hierarchical directory name from NEWSGROUP name."
@@ -541,13 +534,7 @@ If N, return the Nth ancestor instead."
 
 (defun gnus-read-event-char (&optional prompt)
   "Get the next event."
-  (let ((event (condition-case nil
-                  (read-event prompt)
-                ;; `read-event' doesn't allow arguments in Mule 2.3
-                (wrong-number-of-arguments
-                 (when prompt
-                   (message "%s" prompt))
-                 (read-event)))))
+  (let ((event (read-event prompt)))
     ;; should be gnus-characterp, but this can't be called in XEmacs anyway
     (cons (and (numberp event) event) event)))
 
@@ -576,7 +563,8 @@ If N, return the Nth ancestor instead."
        (set-buffer gnus-work-buffer)
        (erase-buffer))
     (set-buffer (gnus-get-buffer-create gnus-work-buffer))
-    (kill-all-local-variables)))
+    (kill-all-local-variables)
+    (set-buffer-multibyte t)))
 
 (defmacro gnus-group-real-name (group)
   "Find the real name of a foreign newsgroup."
@@ -1380,17 +1368,9 @@ CHOICE is a list of the choice char and help message at IDX."
                (x-focus-frame frame))
               ((eq window-system 'w32)
                (w32-focus-frame frame)))
-        (when (or (not (boundp 'focus-follows-mouse))
-                  (symbol-value 'focus-follows-mouse))
+        (when focus-follows-mouse
           (set-mouse-position frame (1- (frame-width frame)) 0)))))
 
-(unless (fboundp 'frame-parameter)
-  (defalias 'frame-parameter
-    (lambda (frame parameter)
-      "Return FRAME's value for parameter PARAMETER.
-If FRAME is nil, describe the currently selected frame."
-      (cdr (assq parameter (frame-parameters frame))))))
-
 (defun gnus-frame-or-window-display-name (object)
   "Given a frame or window, return the associated display name.
 Return nil otherwise."
@@ -1494,6 +1474,32 @@ predicate on the elements."
         "")))
      (t emacs-version))))
 
+(defun gnus-rename-file (old-path new-path &optional trim)
+  "Rename OLD-PATH as NEW-PATH.  If TRIM, recursively delete
+empty directories from OLD-PATH."
+  (when (file-exists-p old-path)
+    (let* ((old-dir (file-name-directory old-path))
+          (old-name (file-name-nondirectory old-path))
+          (new-dir (file-name-directory new-path))
+          (new-name (file-name-nondirectory new-path))
+          temp)
+      (gnus-make-directory new-dir)
+      (rename-file old-path new-path t)
+      (when trim
+       (while (progn (setq temp (directory-files old-dir))
+                     (while (member (car temp) '("." ".."))
+                       (setq temp (cdr temp)))
+                     (= (length temp) 0))
+         (delete-directory old-dir)
+         (setq old-dir (file-name-as-directory 
+                        (file-truename 
+                         (concat old-dir "..")))))))))
+
+(defun gnus-set-file-modes (filename mode)
+  "Wrapper for set-file-modes."
+  (ignore-errors
+    (set-file-modes filename mode)))
+
 (provide 'gnus-util)
 
 ;;; gnus-util.el ends here