X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-util.el;h=65707dd3f4122d7507de01159b3077d399f748cb;hb=e2696774a2e225ea60d46cc665d4232c80412731;hp=5427912fbc7e9c60b94cb66a343b1efedbd4187c;hpb=288df404798143bcebde31f44f2041f786424fa6;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 5427912..65707dd 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -31,20 +31,24 @@ ;; 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") @@ -60,20 +64,7 @@ (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