X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-util.el;h=e2916b432dfa304da96e264ae2b6a16cc27614cd;hb=93303f3ca049a440e1cd02405b5c94769e94dbf0;hp=14e1e59c856c2e810bef2e45ee524d4eb4a6bad8;hpb=40cc1c4b49ad40541eabfe4074d28c9aa7058fbd;p=gnus diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 14e1e59c8..e2916b432 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -294,7 +294,7 @@ (define-key keymap key (pop plist)) (pop plist))))) -(defun gnus-completing-read (default prompt &rest args) +(defun gnus-completing-read-with-default (default prompt &rest args) ;; Like `completing-read', except that DEFAULT is the default argument. (let* ((prompt (if default (concat prompt " (default " default ") ") @@ -343,7 +343,8 @@ (604800 . "%a %k:%M") ;;that's one week ((gnus-seconds-month) . "%a %d") ((gnus-seconds-year) . "%b %d") - (t . "%b %m '%y")) ;;this one is used when no other does match + (t . "%b %d '%y")) ;;this one is used when no + ;;other does match "Alist of time in seconds and format specification used to display dates not older. The first element must be a number or a function returning a number. The second element is a format-specification as described in @@ -468,7 +469,7 @@ jabbering all the time." "Return a list of Message-IDs in REFERENCES." (let ((beg 0) ids) - (while (string-match "<[^> \t]+>" references beg) + (while (string-match "<[^<]+[^< \t]" references beg) (push (substring references (match-beginning 0) (setq beg (match-end 0))) ids)) (nreverse ids))) @@ -476,11 +477,15 @@ jabbering all the time." (defsubst gnus-parent-id (references &optional n) "Return the last Message-ID in REFERENCES. If N, return the Nth ancestor instead." - (when references - (let ((ids (inline (gnus-split-references references)))) - (while (nthcdr (or n 1) ids) - (setq ids (cdr ids))) - (car ids)))) + (when (and references + (not (zerop (length references)))) + (if n + (let ((ids (inline (gnus-split-references references)))) + (while (nthcdr n ids) + (setq ids (cdr ids))) + (car ids)) + (when (string-match "<[^<]+\\'" references) + (match-string 0 references))))) (defun gnus-buffer-live-p (buffer) "Say whether BUFFER is alive or not." @@ -674,9 +679,10 @@ Bind `print-quoted' and `print-readably' to t while printing." (when (get-text-property b 'gnus-face) (setq b (next-single-property-change b 'gnus-face nil end))) (when (/= b end) - (gnus-put-text-property - b (setq b (next-single-property-change b 'gnus-face nil end)) - prop val))))) + (inline + (gnus-put-text-property + b (setq b (next-single-property-change b 'gnus-face nil end)) + prop val)))))) ;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996 ;;; The primary idea here is to try to protect internal datastructures @@ -1220,7 +1226,68 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (if (memq (car spec) '(or and not)) `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) (error "Invalid predicate specifier: %s" spec))))) - + +(defun gnus-local-map-property (map) + "Return a list suitable for a text property list specifying keymap MAP." + (cond + ((featurep 'xemacs) + (list 'keymap map)) + ((>= emacs-major-version 21) + (list 'keymap map)) + (t + (list 'local-map map)))) + +(defun gnus-completing-read (prompt table &optional predicate require-match + history) + (when (and history + (not (boundp history))) + (set history nil)) + (completing-read + (if (symbol-value history) + (concat prompt " (" (car (symbol-value history)) "): ") + (concat prompt ": ")) + table + predicate + require-match + nil + history + (car (symbol-value history)))) + +(defun gnus-graphic-display-p () + (or (and (fboundp 'display-graphic-p) + (display-graphic-p)) + ;;;!!!This is bogus. Fixme! + (and (featurep 'xemacs) + t))) + +(put 'gnus-parse-without-error 'lisp-indent-function 0) +(put 'gnus-parse-without-error 'edebug-form-spec '(body)) + +(defmacro gnus-parse-without-error (&rest body) + "Allow continuing onto the next line even if an error occurs." + `(while (not (eobp)) + (condition-case () + (progn + ,@body + (goto-char (point-max))) + (error + (gnus-error 4 "Invalid data on line %d" + (count-lines (point-min) (point))) + (forward-line 1))))) + +(defun gnus-cache-file-contents (file variable function) + "Cache the contents of FILE in VARIABLE. The contents come from FUNCTION." + (let ((time (nth 5 (file-attributes file))) + contents value) + (if (or (null (setq value (symbol-value variable))) + (not (equal (car value) file)) + (not (equal (nth 1 value) time))) + (progn + (setq contents (funcall function file)) + (set variable (list file time contents)) + contents) + (nth 2 value)))) + (provide 'gnus-util) ;;; gnus-util.el ends here