;ELC ;;; compiled by amu@mit.edu on Sat Sep 13 16:20:01 1997 ;;; from file /afs/sipb.mit.edu/contrib/emacs/packages/gnus-5.4.67/lisp/gnus-util.el ;;; emacs version 19.30.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus-util.el' was compiled for Emacs 19.29 or later")) (byte-code "!!!!\"" [require custom nnheader timezone message autoload nnmail-date-to-time "nnmail"] 3) #@50 Return non-nil if VARIABLE is bound and non-nil. (defalias 'gnus-boundp #[(variable) " ! J" [boundp variable] 2 (#$ . 616)]) #@72 Pop to BUFFER, evaluate FORMS, and then return to the original window. (defalias 'gnus-eval-in-buffer-window '(macro . #[(buffer &rest forms) "!!!B\f D \fBBDE D DDE\fDFBBDEE+" [make-symbol "GnusStartBufferWindow" "w" "buf" buf w tempvar let* ((selected-window)) buffer get-buffer-window ((quote visible)) unwind-protect progn if select-window set-buffer window-buffer pop-to-buffer forms] 11 (#$ . 752)])) (byte-code "##" [put gnus-eval-in-buffer-window lisp-indent-function 1 edebug-form-spec (form body)] 4) #@62 Set hash value. Arguments are STRING, VALUE, and HASHTABLE. (defalias 'gnus-intern-safe '(macro . #[(string hashtable) " \fEDCBB" [let symbol intern string hashtable ((or (boundp symbol) (set symbol nil)) symbol)] 5 (#$ . 1310)])) (defalias 'gnus-truncate-string #[(str width) "\nO" [str 0 width] 3]) (defalias 'gnus-limit-string #[(str width) "G V\f O" [str width 0] 3]) (put (quote gnus-limit-string) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@40 Return non-nil if FORM is funcallable. (defalias 'gnus-functionp #[(form) "9 !<@=!" [form fboundp lambda compiled-function-p] 2 (#$ . 1795)]) (put (quote gnus-functionp) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'gnus-goto-char #[(point) "b" [point] 1]) (put (quote gnus-goto-char) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'gnus-buffer-exists-p '(macro . #[(buffer) " DCBB" [let buffer ((when buffer (funcall (if (stringp buffer) (quote get-buffer) (quote buffer-name)) buffer)))] 3])) (defalias 'gnus-kill-buffer '(macro . #[(buffer) "\nDCBB" [let buf buffer ((when (gnus-buffer-exists-p buf) (kill-buffer buf)))] 3])) (byte-code "! MM!M\"M" [fboundp point-at-bol gnus-point-at-bol #[nil "`y`b)" [p 0] 2 "Return point at the beginning of the line."] point-at-eol gnus-point-at-eol #[nil "``b)" [p nil] 2 "Return point at the end of the line."]] 2) #@72 Delete by side effect the first occurrence of ELT as a member of LIST. (defalias 'gnus-delete-first #[(elt list) "@ \nAA A@ A A+AA\n)" [list elt total] 3 (#$ . 2780)]) (defalias 'gnus-delete-line '(macro . #[(&optional n) "\f DBBE" [delete-region (progn (beginning-of-line) (point)) progn forward-line n 1 ((point))] 5])) #@51 Return a form that can be `eval'ed based on FUNC. (defalias 'gnus-byte-code #[(func) "K ! \"Ơ ) AAB)" [func fval compiled-function-p append nil flist byte-code progn] 4 (#$ . 3146)]) (defalias 'gnus-extract-address-components #[(from) " \" ƔƕO : !Q \": ƉO:\n\":\nƕSO\nn \"R ƔTƕSOn \"_ n \"n ƔTƕO\ns x *D" [nil address name string-match "\\b[^@ <>]+[!@][^@ <>]+\\b" from 0 "[ ]*<" regexp-quote ">" "\".*\"" 1 "(.+)" "()" "(.*"] 4]) #@58 Return the value of the header FIELD of current article. (defalias 'gnus-fetch-field #[(field) " !," [t inhibit-point-motion-hooks case-fold-search nnheader-narrow-to-headers message-fetch-field field] 2 (#$ . 3669)]) (defalias 'gnus-goto-colon #[nil "y #" [0 search-forward ":" gnus-point-at-eol t] 4]) #@64 Delete all text in the current buffer with text property PROP. (defalias 'gnus-remove-text-with-property #[(prop) "ebm?\"` \"! ` d$b)" [get-text-property prop delete-char 1 next-single-property-change nil] 5 (#$ . 3997)]) #@55 Make hierarchical directory name from NEWSGROUP name. (defalias 'gnus-newsgroup-directory-form #[(newsgroup) " ! G \" I \fW6 HU/ I T +" [gnus-newsgroup-savable-name newsgroup nil idx len string-match ":" 47 0 46] 4 (#$ . 4245)]) (defalias 'gnus-newsgroup-savable-name #[(group) " #" [nnheader-replace-chars-in-string group 47 46] 4]) (defalias 'gnus-string> #[(s1 s2) "  ?" [s1 s2] 2]) (defalias 'gnus-days-between #[(date1 date2) " !\n!Z" [gnus-day-number date1 date2] 3]) (defalias 'gnus-day-number #[(date) " !\"\fA@\f8\f@#)" [mapcar #[(s) "!" [s string-to-int] 2] timezone-parse-date date dat timezone-absolute-from-gregorian 2] 4]) #@29 Convert TIME to day number. (defalias 'gnus-time-to-day #[(time) " !\n8\n8\n8#)" [decode-time time tim timezone-absolute-from-gregorian 4 3 5] 5 (#$ . 4952)]) #@32 Convert DATE to internal time. (defalias 'gnus-encode-date #[(date) " !\n\"\nH!\"AA@A@@ AA@ A@ @ 8!_&+" [timezone-parse-date date parse mapcar #[(d) "!" [d string-to-int] 2] string-to-int timezone-parse-time 3 time encode-time timezone-zone-to-minute 4 60] 10 (#$ . 5124)]) #@30 Subtract two internal times. (defalias 'gnus-time-minus #[(t1 t2) "A@ A@W@ @Z\nÂZ\nł A@\\ A@Z)D" [t1 t2 borrow 1 0 65536] 3 (#$ . 5434)]) #@43 Say whether time T1 is less than time T2. (defalias 'gnus-time-less #[(t1 t2) "@ @W@ @UA@ A@W" [t1 t2] 2 (#$ . 5596)]) (defalias 'gnus-file-newer-than #[(file date) "\n!8@\f@V @\f@U A@\fA@V)" [5 file-attributes file fdate date] 4]) #@46 Set the keys in PLIST in the current keymap. (defalias 'gnus-local-set-keys '(macro . #[(&rest plist) " DE" [gnus-define-keys-1 (current-local-map) quote plist] 4 (#$ . 5855)])) #@37 Define all keys in PLIST in KEYMAP. (defalias 'gnus-define-keys '(macro . #[(keymap &rest plist) "\nD DE" [gnus-define-keys-1 quote keymap plist] 4 (#$ . 6043)])) #@78 Define all keys in PLIST in KEYMAP without overwriting previous definitions. (defalias 'gnus-define-keys-safe '(macro . #[(keymap &rest plist) "\nD DBBB" [gnus-define-keys-1 quote keymap plist (t)] 4 (#$ . 6216)])) (byte-code "###" [put gnus-define-keys lisp-indent-function 1 gnus-define-keys-safe gnus-local-set-keys] 4) #@37 Define all keys in PLIST in KEYMAP. (defalias 'gnus-define-keymap '(macro . #[(keymap &rest plist) " DE" [gnus-define-keys-1 keymap quote plist] 4 (#$ . 6565)])) (put (quote gnus-define-keymap) (quote lisp-indent-function) 1) (defalias 'gnus-define-keys-1 #[(keymap plist &optional safe) "!9J9!9<9@L@!AA@JA@@#@J}A@9TJ c\"=sA@#<A<)" [keymap error "Can't set keys in a null keymap" keymapp nil define-prefix-command define-key key plist safe lookup-key undefined] 5]) (defalias 'gnus-completing-read #[(default prompt &rest args) "\f R P #$GU(**" [default prompt " (default " ") " " " apply completing-read args answer 0] 5]) (defalias 'gnus-y-or-n-p #[(prompt) " !!" [y-or-n-p prompt message ""] 3]) (defalias 'gnus-yes-or-no-p #[(prompt) " !!" [yes-or-no-p prompt message ""] 3]) #@53 Return a string like DD-MMM from a big messy string (defalias 'gnus-dd-mmm #[(messy-date) " Ă$ɏ H!S 8@\"!#)" [G77697 (timezone-parse-date messy-date) ((error)) datevec "??-???" format "%2s-%s" nil (byte-code "\nH!!" [number-to-string string-to-number datevec 2] 4) ((error "??")) capitalize string-to-number 1 timezone-months-assoc "???"] 8 (#$ . 7483)]) #@88 Convert DATE string to Emacs time. Cache the result as a text property stored in DATE. (defalias 'gnus-date-get-time '(macro . #[(date) "\nDCBB" [let d date ((if (equal "" d) (quote (0 0)) (or (get-text-property 0 (quote gnus-time) d) (let ((time (nnmail-date-to-time d))) (put-text-property 0 1 (quote gnus-time) time d) time))))] 3 (#$ . 7871)])) #@50 Return a string of TIME in YYMMDDTHHMMSS format. (defalias 'gnus-time-iso8601 #[(time) "\n\"" [format-time-string "%Y%m%dT%H%M%S" time] 3 (#$ . 8230)]) (put (quote gnus-time-iso8601) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@51 Convert the date field in HEADER to YYMMDDTHHMMSS (defalias 'gnus-date-iso8601 #[(header) "" [nil (byte-code "HÚĂ'\n#'\n!  \n% ))  \")" [header 3 d "" (0 0) get-text-property 0 gnus-time nnmail-date-to-time time put-text-property 1 format-time-string "%Y%m%dT%H%M%S"] 7) ((error ""))] 3 (#$ . 8481)]) #@28 Quote all "%"'s in STRING. (defalias 'gnus-mode-string-quote #[(string) " ceb#c\n )" [gnus-set-work-buffer string search-forward "%" nil t buffer-string] 4 (#$ . 8822)]) (defalias 'gnus-make-hashtable #[(&optional hashsize) " !]\"" [make-vector hashsize gnus-create-hash-size 256 0] 3]) (defalias 'gnus-create-hash-size #[(min) "\nW \\ )" [1 i min] 3]) (custom-declare-variable (quote gnus-verbose) 7 "*Integer that says how verbose Gnus should be.\nThe higher the number, the more messages Gnus will flash to say what\nit's doing. At zero, Gnus will be totally mute; at five, Gnus will\ndisplay most important messages; and at ten, Gnus will keep on\njabbering all the time." :group (quote gnus-start) :type (quote integer)) (defalias 'gnus-message #[(level &rest args) " X \f\"\f\"" [level gnus-verbose apply message args format] 3]) #@65 Beep an error if LEVEL is equal to or less than `gnus-verbose'. (defalias 'gnus-error #[(level &rest args) " !\nX. \"  !- !Z_U-!)LJ" [floor level gnus-verbose apply message args ding nil duration floatp 10 0 sit-for] 3 (#$ . 9719)]) #@45 Return a list of Message-IDs in REFERENCES. (defalias 'gnus-split-references #[(references) " #O\nB\n*" [0 nil ids beg string-match "<[^>]+>" references] 4 (#$ . 9985)]) #@82 Return the last Message-ID in REFERENCES. If N, return the Nth ancestor instead. (defalias 'gnus-parent-id #[(references &optional n) "8\f# O B\n +* 5 A$ @)" [references 0 nil ids beg string-match "<[^>]+>" n 1] 4 (#$ . 10186)]) #@37 Say whether BUFFER is alive or not. (defalias 'gnus-buffer-live-p #[(buffer) "!!!" [buffer get-buffer buffer-name] 3 (#$ . 10459)]) (put (quote gnus-buffer-live-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@43 Recenter the current buffer horizontally. (defalias 'gnus-horizontal-recenter #[nil "i Wp\"\"`p\"! bm=`W= i] y#b Vap\"i ͥZ Z\\^\"ip\"\" +" [window-width 2 set-window-hscroll get-buffer-window t 0 orig window-end end max window-start nil 1 3] 5 (#$ . 10701)]) #@21 Get the next event. (defalias 'gnus-read-event-char #[nil "  )B" [read-event event] 3 (#$ . 11031)]) #@75 Make sortable string by string-lessp from DATE. Timezone package is used. (defalias 'gnus-sortable-date #[(date) "" [nil (byte-code ";'\"\"'!'G$, \n \f\"U\f \n \"n\f \n \"\f \n \"\f \n \"\f \n \"\f \n \"\f \n \"\f \n \fM\f\fO\fGW \fOP\f  \\O\"\"A! )\n\nO\n  O \\O\fp\f \n %w䉉%.H%&!H!\fW\f\\\fW\f\\\f\fH! H!\nH!  H!. H!/ H!0H&&% \n\f#0/._\\_\\\"%%!&!Z5/5\\//\"7.7\\./7_Z/.X_.Z.\nT\n \f\"\nW T \n W \fT\f.V.\\.\nS\n\nV S  V \fS\f \f\"\n\f \n./0%&.HHHHHH0/../0$+ \n \f\f \n %," [date nil text-properties-at 0 next-property-change copy-sequence set-text-properties "" zone time day month year string-match "\\([^ ,]+\\),[ ]+\\([0-9]+\\)[ ]+\\([^ ,]+\\)[ ]+\\([0-9]+:[0-9:]+\\)[ ]+\\(T[ ]+\\|\\)\\([0-9]+\\)[ ]*\\'" 6 3 2 4 "\\([^ ,]+\\),[ ]+\\([0-9]+\\)[ ]+\\([^ ,]+\\)[ ]+\\([0-9]+:[0-9:]+\\)[ ]+\\(T[ ]+\\|\\)\\([0-9]+\\)[ ]*\\([-+a-zA-Z0-9]+\\)" 7 "\\([0-9]+\\)[ ]+\\([^ ,]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+:[0-9:]+\\)[ ]*\\'" 1 "\\([0-9]+\\)[ ]+\\([^ ,]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+:[0-9:]+\\)[ ]*\\([-+a-zA-Z0-9]+\\)" 5 "\\([^ ,]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+:[0-9:]+\\)[ ]+\\([0-9]+\\)" "\\([^ ,]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+:[0-9:]+\\)[ ]+\\([-+a-zA-Z0-9]+\\)[ ]+\\([0-9]+\\)" "\\([0-9]+\\)[ ]+\\([^ ,]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+\\)[ ]*\\([-+a-zA-Z0-9]+\\)" "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ ]+\\([0-9]+:[0-9]+:[0-9]+\\)\\.[0-9]+" "19" -2 string int-to-string assoc timezone-months-assoc vector "0" timezone local timezone-parse-date string-to-int 50 2000 100 1900 timezone-parse-time hour minute second timezone-time-zone-from-absolute timezone-absolute-from-gregorian 60 timezone-zone-to-minute diff floor hour-fix 24 timezone-last-day-of-month 12 format "%02d:%02d:%02d" "%4d%02d%02d%s"] 10) ((error ""))] 3 (#$ . 11147)]) #@18 Copy FILE to TO. (defalias 'gnus-copy-file #[(file &optional to) " \"!!!P\"" [to read-file-name "Copy file to: " default-directory file-directory-p file-name-as-directory file-name-nondirectory file copy-file] 3 (#$ . 13433) (list (read-file-name "Copy file: " default-directory) (read-file-name "Copy file to: " default-directory))]) #@44 Delete all overlays in the current buffer. (defalias 'gnus-kill-all-overlays #[nil "?' \n@\nA\"&A@!+" [gnus-xemacs overlay-lists overlayss nil buffer-read-only delq overlays delete-overlay] 4 (#$ . 13797)]) (byte-code "! B" [boundp gnus-work-buffer " *gnus work*" current-load-list] 2) #@42 Put point in the empty Gnus work buffer. (defalias 'gnus-set-work-buffer #[nil " !\f q !q p!" [get-buffer gnus-work-buffer erase-buffer get-buffer-create kill-all-local-variables buffer-disable-undo] 2 (#$ . 14127)]) #@44 Find the real name of a foreign newsgroup. (defalias 'gnus-group-real-name '(macro . #[(group) "\nDCBB" [let gname group ((if (string-match "^[^:]+:" gname) (substring gname (match-end 0)) gname))] 3 (#$ . 14363)])) #@67 Return a composite sort condition based on the functions in FUNC. (defalias 'gnus-make-sort-function #[(funs) "< A!!E@" [funs lambda (t1 t2) gnus-make-sort-function-1 reverse] 5 (#$ . 14589)]) #@67 Return a composite sort condition based on the functions in FUNC. (defalias 'gnus-make-sort-function-1 #[(funs) "A@B@BDA!EE@B" [funs or (t1 t2) and not (t2 t1) gnus-make-sort-function-1 (t1 t2)] 6 (#$ . 14811)]) #@45 Turn off edit menu in `gnus-TYPE-mode-map'. (defalias 'gnus-turn-off-edit-menu #[(type) "\f\"!J#" [define-key intern format "gnus-%s-mode-map" type [menu-bar edit] undefined] 5 (#$ . 15046)]) #@85 Use `prin1' on FORM in the current buffer. Bind `print-quoted' to t while printing. (defalias 'gnus-prin1 #[(form) "p\"+" [t nil print-length print-level print-quoted prin1 form] 3 (#$ . 15251)]) #@51 The same as `prin1', but but `print-quoted' to t. (defalias 'gnus-prin1-to-string #[(form) " !)" [t print-quoted prin1-to-string form] 2 (#$ . 15463)]) #@59 Make DIRECTORY (and all its parents) if it doesn't exist. (defalias 'gnus-make-directory #[(directory) "!\"Ç" [directory file-exists-p make-directory t] 3 (#$ . 15625)]) #@46 Write the current buffer's contents to FILE. (defalias 'gnus-write-buffer #[(file) "\n!!ed\n%" [gnus-make-directory file-name-directory file write-region nil quietly] 6 (#$ . 15815)]) (defalias 'gnus-delete-assq '(macro . #[(key list) " DDC BBBBEE" [let listval eval list setq delq assq key (listval) (listval)] 8])) (defalias 'gnus-delete-assoc '(macro . #[(key list) "\nDC\nBBBBEE" [let listval list setq delq assoc key (listval) (listval)] 8])) #@27 Delete FILE if it exists. (defalias 'gnus-delete-file #[(file) " ! !" [file-exists-p file delete-file] 2 (#$ . 16297)]) #@43 Return STRING stripped of all whitespace. (defalias 'gnus-strip-whitespace #[(string) "\n\"ʼn\n$\n" [string-match "[ \n ]+" string replace-match "" t] 5 (#$ . 16429)]) #@89 The same as `put-text-property', but don't put this prop on any newlines in the region. (defalias 'gnus-put-text-property-excluding-newlines #[(beg end prop val) " Ž b#\" ɔ\n $`\n `\n $," [match-data match-data ((store-match-data match-data)) beg re-search-forward "[ ]*\n" end move put-text-property 0 prop val] 5 (#$ . 16616)]) #@70 If t, certain operations will be protected from interruption by C-g. (defvar gnus-atomic-be-safe t (#$ . 16978)) #@457 Evaluate FORMS atomically, which means to protect the evaluation from being interrupted by the user. An error from the forms themselves will return without finishing the operation. Since interrupts from the user are disabled, it is recommended that only the most minimal operations are performed by FORMS. If you wish to assign many complicated values atomically, compute the results into temporary variables and then do only the assignment atomically. (defalias 'gnus-atomic-progn '(macro . #[(&rest forms) "\nBB" [let ((inhibit-quit gnus-atomic-be-safe)) forms] 3 (#$ . 17098)])) (put (quote gnus-atomic-progn) (quote lisp-indent-function) 0) #@456 Evaluate FORMS, but insure that the variables listed in PROTECT are not changed if anything in FORMS signals an error or otherwise non-locally exits. The variables listed in PROTECT are updated atomically. It is safe to use gnus-atomic-progn-assign with long computations. Note that if any of the symbols in PROTECT were unbound, they will be set to nil on a sucessful assignment. In case of an error or other non-local exit, it will still be unbound. (defalias 'gnus-atomic-progn-assign '(macro . #[(protect &rest forms) "\n\" \" \"  \" \"\f!C\"BE BF\fBE." [mapcar #[(x) "\n!P!\nD" [make-symbol symbol-name x "-tmp"] 3] protect temp-sym-map #[(x) "A@@D" [x] 2] sym-temp-map #[(x) "@A@DDA@ED" [x and boundp quote] 5] temp-sym-let sym-temp-let apply append temp-sym-assign sym-temp-assign make-symbol "result-tmp" result let setq progn forms ((inhibit-quit gnus-atomic-be-safe))] 8 (#$ . 17756)])) (put (quote gnus-atomic-progn-assign) (quote lisp-indent-function) 1) #@317 Similar to setq, except that the real symbols are only assigned when there are no errors. And when the real symbols are assigned, they are done so atomically. If other variables might be changed via side-effect, see gnus-atomic-progn-assign. It is safe to use gnus-atomic-setq with potentially long computations. (defalias 'gnus-atomic-setq '(macro . #[(&rest pairs) " @\nB AA\nBE*" [pairs nil syms tpairs gnus-atomic-progn-assign setq] 5 (#$ . 18797)])) (byte-code " B" [rmail-default-rmail-file current-load-list] 2) #@61 Append the current article to an Rmail file named FILENAME. (defalias 'gnus-output-to-rmail #[(filename &optional ask) "! !p! !O !O - Q!K !q  !*!)O!q ! !ped #q!}J ~dd}!eb~!`d}eTb!!**!*" [require rmail expand-file-name filename rmail-default-rmail-file get-buffer-create " *Gnus-output*" tmpbuf artbuf get-file-buffer file-exists-p ask gnus-yes-or-no-p "\"" "\" does not exist, create it? " create-file-buffer file-buffer rmail-insert-rmail-file-header nil require-final-newline gnus-write-buffer kill-buffer error "Output file does not exist" erase-buffer insert-buffer-substring gnus-convert-article-to-rmail outbuf append-to-file boundp rmail-current-message msg buffer-read-only search-backward "" rmail-count-new-messages t rmail-show-message] 5 (#$ . 19347)]) #@59 Append the current article to a mail file named FILENAME. (defalias 'gnus-output-to-mail #[(filename &optional ask) " !p! !D !D% Q!@ !  q !* !)D!\fq !eb!]yd ۱#xycg) !\"#dbu!dbnccdbed #*\"q#dbmcc\f!)*\f!*" [expand-file-name filename get-buffer-create " *Gnus-output*" tmpbuf artbuf get-file-buffer file-exists-p ask gnus-y-or-n-p "\"" "\" does not exist, create it? " create-file-buffer file-buffer nil require-final-newline gnus-write-buffer kill-buffer error "Output file does not exist" erase-buffer insert-buffer-substring looking-at "From " 1 "From nobody " current-time-string "\n" case-fold-search re-search-forward "^From " t 0 ">" outbuf buffer-read-only -2 "\n\n" append-to-file] 5 (#$ . 20239)]) #@60 Convert article in current buffer to Rmail message format. (defalias 'gnus-convert-article-to-rmail #[nil "ebc#ʼn#dbc)" [nil buffer-read-only "\f\n0, unseen,,\n*** EOOH ***\n" search-forward "\n" t replace-match "\n^_" ""] 4 (#$ . 21073)]) (provide (quote gnus-util))