🚀 go-pugleaf

Recently some wonderful people (i.e., Epoch users) were asking some
questions about how to use buttons. Here is a short file that I use
when I post (like I am now). It sets me into "Xrn" mode when I edit an
Xrn file. It's main purposes are to 1) bind \C-c \C-c to 'server-edit,
and 2) highlight certain fields in the news headers. For instance,
looking up I see that all my normal text is yellow, but the
"gnu.epoch.misc" in the Newsgroups: field is red, and the "world" in
the Distribution: is underlined in green. This is done using buttons.
The code follows. I hope that it is simple enough to be a readable
example of how to use buttons. Feel free to email me questions about
it.

;;; This is in my .epoch to define a generic underlining attribute I can
;;; use in many different places:

(defvar amc:underline-attribute (reserve-attribute)
  "Attribute for underlining things"
)

(defvar amc:underline-style
  (let ((s (make-style)))
    (set-style-foreground s (foreground))
    (set-style-background s (background))
    (set-style-underline s "green")
  )
  "Style for underlining attribute"
)
(set-attribute-style amc:underline-attribute amc:underline-style)

;;; This is the actual xrn.el file

;;; The mode keymap
(defvar xrn-mode-map (make-sparse-keymap) "XRN mode keymap")

;;; This is the only key currently in the key map. I use it because it's the
;;; same as for MH-e.
(define-key xrn-mode-map "\C-c\C-c" 'server-edit)

;;; We want to mark "interesting" headers, and need a default style and
;;; attribute to mark them with (although things are set up so that other
;;; attributes can be used if desired.

;;; This is the attribute
(defvar xrn-header-attribute (reserve-attribute)
  "Default Xrn attribute for headers"
)

;;; Create a style for the default attribute. If we're color, then set up
;;; foreground and background, otherwise just let it default to reverse
;;; video.
(defvar xrn-header-style
  (let ((s (make-style)))
    (when (< 2 (number-of-colors))
      (set-style-foreground s "red")
      (set-style-background s (background))
)))

;;; Put the style into the attribute so that it can be used.
(set-attribute-style xrn-header-attribute xrn-header-style)

(defvar xrn-mode-headers
  (list
    (cons "^Distribution: " amc:underline-attribute)
    (cons "^[fF]ollowup-To:" xrn-header-attribute)
    (cons "^Newsgroups:" xrn-header-attribute)
  )
  "*A list of (re . attribute) pairs for marking headers in the Xrn buffer"
)

;;; Inhibit mode inheritance
(put 'xrn-mode 'mode-class 'special)

;;; Set up the auto mode stuff, but try to avoid putting it in twice if we
;;; have to reload this file.
(let ((re "/tmp/xrn[A-Za-z]+[0-9]+$"))
  (setq auto-mode-alist
    (cons
      (cons re 'xrn-mode)		; our mode
      (delete-if			; get rid of any previous version
	(eval (` '(lambda (x) (equal (, re) (car x)))))
	auto-mode-alist
))))

;;; The actual mode itself.
(defun xrn-mode ()

  "Switch into XRN editing mode

 \\[server-edit] : Finish the edit and post"

  (use-local-map xrn-mode-map)
  (setq major-mode 'xrn-mode)
  (setq mode-name "Xrn")
  ;; deal with the headers
  (dolist (h xrn-mode-headers)
    (let
      (
	(re (car h))			;the RE to find
	(attr (or (cdr h) xrn-header-attribute))	;the attribute to use
      )
      (goto-char (point-min))
      (while (re-search-forward re nil t)
	(end-of-line)
	(add-button (match-end 0) (point) attr (list 'xrn))
  )))
  (run-hooks 'xrn-mode-hooks)
)


-- 
Alan M. Carroll                "I hate shopping with the reality-impaired"
Epoch Development Team                 - Susan
CS Grad / U of Ill @ Urbana    ...{ucbvax,pur-ee,convex}!cs.uiuc.edu!carroll