-(defun gnus-group-add-icon ()
- "Add an icon to the current line according to `gnus-group-icon-list'."
- (let* ((p (point))
- (end (progn (end-of-line) (point)))
- ;; now find out where the line starts and leave point there.
- (beg (progn (beginning-of-line) (point))))
- (save-restriction
- (narrow-to-region beg end)
- (goto-char beg)
- (when (search-forward "==&&==" nil t)
- (let* ((group (gnus-group-group-name))
- (entry (gnus-group-entry group))
- (unread (if (numberp (car entry)) (car entry) 0))
- (active (gnus-active group))
- (total (if active (1+ (- (cdr active) (car active))) 0))
- (info (nth 2 entry))
- (method (gnus-server-get-method group (gnus-info-method info)))
- (marked (gnus-info-marks info))
- (mailp (memq 'mail (assoc (symbol-name
- (car (or method gnus-select-method)))
- gnus-valid-select-methods)))
- (level (or (gnus-info-level info) gnus-level-killed))
- (score (or (gnus-info-score info) 0))
- (ticked (gnus-range-length (cdr (assq 'tick marked))))
- (group-age (gnus-group-timestamp-delta group))
- (inhibit-read-only t)
- (list gnus-group-icon-list)
- (mystart (match-beginning 0))
- (myend (match-end 0)))
- (goto-char (point-min))
- (while (and list
- (not (eval (caar list))))
- (setq list (cdr list)))
- (if list
- (let* ((file (cdar list))
- (glyph (gnus-group-icon-create-glyph
- (buffer-substring mystart myend)
- file)))
- (if glyph
- (progn
- (mapcar 'delete-annotation (annotations-at myend))
- (let ((ext (make-extent mystart myend))
- (ant (make-annotation glyph myend 'text)))
- ;; set text extent params
- (set-extent-property ext 'end-open t)
- (set-extent-property ext 'start-open t)
- (set-extent-property ext 'invisible t)))
- (delete-region mystart myend)))
- (delete-region mystart myend))))
- (widen))
- (goto-char p)))
-
-(defun gnus-group-icon-create-glyph (substring pixmap)
- "Create a glyph for insertion into a group line."
- (and
- gnus-group-running-xemacs
- (or
- (cdr-safe (assoc pixmap gnus-group-icon-cache))
- (let* ((glyph (make-glyph
- (list
- (cons 'x
- (expand-file-name pixmap gnus-xmas-glyph-directory))
- (cons 'mswindows
- (expand-file-name pixmap gnus-xmas-glyph-directory))
- (cons 'tty substring)))))
- (setq gnus-group-icon-cache
- (cons (cons pixmap glyph) gnus-group-icon-cache))
- (set-glyph-face glyph 'default)
- glyph))))
+(defun gnus-xmas-mime-security-button-menu (event prefix)
+ "Construct a context-sensitive menu of security commands."
+ (interactive "e\nP")
+ (let ((response
+ (get-popup-menu-response
+ `("Security Part"
+ ,@(delq nil
+ (mapcar (lambda (c)
+ (unless (eq (car c) 'undefined)
+ `[,(caddr c) ,(car c) t]))
+ gnus-mime-security-button-commands))))))
+ (set-buffer (event-buffer event))
+ (goto-char (event-point event))
+ (funcall (event-function response) (event-object response))))
+
+(defun gnus-xmas-mailing-list-menu-add ()
+ (gnus-xmas-menu-add mailing-list
+ gnus-mailing-list-menu))
+
+(defun gnus-xmas-image-type-available-p (type)
+ (and (if (fboundp 'display-images-p)
+ (display-images-p)
+ window-system)
+ (featurep (if (eq type 'pbm) 'xbm type))))
+
+(defun gnus-xmas-create-image (file &optional type data-p &rest props)
+ (let ((type (cond
+ (type
+ (symbol-name type))
+ ((and (not data-p)
+ (string-match "[.]" file))
+ (car (last (split-string file "[.]"))))))
+ (face (plist-get props :face))
+ glyph)
+ (when (equal type "pbm")
+ (with-temp-buffer
+ (if data-p
+ (insert file)
+ (insert-file-contents-literally file))
+ (shell-command-on-region (point-min) (point-max)
+ "ppmtoxpm 2>/dev/null" t)
+ (setq file (buffer-string)
+ type "xpm"
+ data-p t)))
+ (setq glyph
+ (if (equal type "xbm")
+ (make-glyph (list (cons 'x file)))
+ (with-temp-buffer
+ (if data-p
+ (insert file)
+ (insert-file-contents-literally file))
+ (make-glyph
+ (vector
+ (if type
+ (intern type)
+ (mm-image-type-from-buffer))
+ :data (buffer-string))))))
+ (when face
+ (set-glyph-face glyph face))
+ glyph))
+
+(defun gnus-xmas-put-image (glyph &optional string category)
+ "Insert STRING, but display GLYPH.
+Warning: Don't insert text immediately after the image."
+ (let ((begin (point))
+ extent)
+ (if (and (bobp) (not string))
+ (setq string " "))
+ (if string
+ (insert string)
+ (setq begin (1- begin)))
+ (setq extent (make-extent begin (point)))
+ (set-extent-property extent 'gnus-image category)
+ (set-extent-property extent 'duplicable t)
+ (if string
+ (set-extent-property extent 'invisible t))
+ (set-extent-property extent 'end-glyph glyph))
+ glyph)
+
+(defun gnus-xmas-remove-image (image &optional category)
+ "Remove the image matching IMAGE and CATEGORY found first."
+ (map-extents
+ (lambda (ext unused)
+ (when (equal (extent-end-glyph ext) image)
+ (set-extent-property ext 'invisible nil)
+ (set-extent-property ext 'end-glyph nil)
+ t))
+ nil nil nil nil nil 'gnus-image category))
+
+(defun gnus-xmas-assq-delete-all (key alist)
+ (let ((elem nil))
+ (while (setq elem (assq key alist))
+ (setq alist (delq elem alist)))
+ alist))