+Sun Mar 2 04:40:48 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Gnus v5.4.17 is released.
+
+Sun Mar 2 04:01:29 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * message.el (message-mail): Don't `list' other-headers.
+
+Sat Mar 1 22:46:37 1997 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus.el: Added mail keyword.
+ (gnus): Add to mail and news customization groups.
+ (gnus-visual): Added to the faces customization group.
+ * message.el (message): Add to mail and news customization groups.
+
+ * gnus-cus.el (wid-edit): Changed from widget-edit.
+
+Sun Mar 2 03:44:07 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-sum.el (gnus-summary-respool-query): Use it.
+
+ * gnus.el (gnus-narrow-to-body): New function.
+
+ * nnfolder.el (nnfolder-active-number): Simplify.
+
+Sun Mar 2 03:26:57 1997 Joev Dubach <dubach1@husc.harvard.edu>
+
+ * gnus-art.el (article-make-date-line): Add "Date: ".
+
+Sun Mar 2 02:54:13 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-uu.el (gnus-quote-arg-for-sh-or-csh): Also escape {}.
+
+ * gnus-srvr.el (gnus-server-prepare): Don't insert servers twice.
+
+ * nnmail.el (nnmail-read-passwd): Conditionalize
+ `ange-ftp-read-passwd'.
+
+Sat Mar 1 17:53:05 1997 Hrvoje Niksic <hniksic@srce.hr>
+
+ * gnus-xmas.el (gnus-xmas-read-event-char): Exit on button-press
+ event.
+
+ * nnml.el (nnml-retrieve-headers): Make sure file is non-nil.
+
+Sun Mar 2 02:43:46 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * nndoc.el (nndoc-type-alist): Have rfc934 separators handled
+ better.
+
+ * nnmail.el (nnmail-move-inbox): Take heed of the return value
+ from movemail.
+
+Fri Feb 21 19:54:24 1997 Hrvoje Niksic <hniksic@srce.hr>
+
+ * gnus-xmas.el (gnus-xmas-redefine): Use `region-active-p'.
+ (gnus-xmas-region-active-p): Removed.
+
+Sun Mar 2 02:16:38 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-sum.el (gnus-summary-update-article-line): Only insert
+ Subject string when needed.
+
+ * gnus-util.el (gnus-output-to-mail): Quote all "From " lines.
+
+Sun Mar 2 02:13:17 1997 David Martin <dm@cs.bu.edu>
+
+ * nndir.el (nndir): Use `nnml-close-group'.
+
+Sun Mar 2 01:51:21 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-start.el (gnus-init-file): Changed default.
+
+ * gnus-group.el (gnus-ephemeral-group-server): New server.
+ (gnus-group-read-ephemeral-group): Use it to use unique servers.
+
+Sat Mar 1 04:06:11 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-art.el (gnus-article-mode): Made `gnus-button-marker-list'
+ buffer-local.
+ (gnus-article-add-buttons): Don't buttonize the same article
+ twice.
+
+ * gnus-sum.el (gnus-set-mode-line): Chop better.
+
+ * gnus-art.el (gnus-article-treat-html): Not a new function.
+ Uh-uh. No way. I don't even exist.
+
+ * gnus-cite.el (gnus-article-fill-cited-article): Bind
+ filladapt-mode to nil.
+
Sat Mar 1 03:51:18 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Gnus v5.4.16 is released.
-;;; custom-edit.el --- Tools for customization Emacs.
+;;; cus-edit.el --- Tools for customization Emacs.
;;
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.38
+;; Version: 1.48
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
;;; Code:
(require 'custom)
-(require 'widget-edit)
+(require 'wid-edit)
(require 'easymenu)
(define-widget-keywords :custom-prefixes :custom-menu :custom-show
:custom-set :custom-save :custom-reset-current :custom-reset-saved
:custom-reset-factory)
+;;; Customization Groups.
+
+(defgroup emacs nil
+ "Customization of the One True Editor."
+ :link '(custom-manual "(emacs)Top"))
+
+;; Most of these groups are stolen from `finder.el',
+(defgroup editing nil
+ "Basic text editing facilities."
+ :group 'emacs)
+
+(defgroup abbrev nil
+ "Abbreviation handling, typing shortcuts, macros."
+ :tag "Abbreviations"
+ :group 'editing)
+
+(defgroup matching nil
+ "Various sorts of searching and matching."
+ :group 'editing)
+
+(defgroup emulations nil
+ "Emulations of other editors."
+ :group 'editing)
+
+(defgroup mouse nil
+ "Mouse support."
+ :group 'editing)
+
+(defgroup outlines nil
+ "Support for hierarchical outlining."
+ :group 'editing)
+
+(defgroup external nil
+ "Interfacing to external utilities."
+ :group 'emacs)
+
+(defgroup bib nil
+ "Code related to the `bib' bibliography processor."
+ :tag "Bibliography"
+ :group 'external)
+
+(defgroup processes nil
+ "Process, subshell, compilation, and job control support."
+ :group 'external
+ :group 'development)
+
+(defgroup programming nil
+ "Support for programming in other languages."
+ :group 'emacs)
+
+(defgroup languages nil
+ "Specialized modes for editing programming languages."
+ :group 'programming)
+
+(defgroup lisp nil
+ "Lisp support, including Emacs Lisp."
+ :group 'languages
+ :group 'development)
+
+(defgroup c nil
+ "Support for the C language and related languages."
+ :group 'languages)
+
+(defgroup tools nil
+ "Programming tools."
+ :group 'programming)
+
+(defgroup oop nil
+ "Support for object-oriented programming."
+ :group 'programming)
+
+(defgroup applications nil
+ "Applications written in Emacs."
+ :group 'emacs)
+
+(defgroup calendar nil
+ "Calendar and time management support."
+ :group 'applications)
+
+(defgroup mail nil
+ "Modes for electronic-mail handling."
+ :group 'applications)
+
+(defgroup news nil
+ "Support for netnews reading and posting."
+ :group 'applications)
+
+(defgroup games nil
+ "Games, jokes and amusements."
+ :group 'applications)
+
+(defgroup development nil
+ "Support for further development of Emacs."
+ :group 'emacs)
+
+(defgroup docs nil
+ "Support for Emacs documentation."
+ :group 'development)
+
+(defgroup extensions nil
+ "Emacs Lisp language extensions."
+ :group 'development)
+
+(defgroup internal nil
+ "Code for Emacs internals, build process, defaults."
+ :group 'development)
+
+(defgroup maint nil
+ "Maintenance aids for the Emacs development group."
+ :tag "Maintenance"
+ :group 'development)
+
+(defgroup environment nil
+ "Fitting Emacs with its environment."
+ :group 'emacs)
+
+(defgroup comm nil
+ "Communications, networking, remote access to files."
+ :tag "Communication"
+ :group 'environment)
+
+(defgroup hardware nil
+ "Support for interfacing with exotic hardware."
+ :group 'environment)
+
+(defgroup terminals nil
+ "Support for terminal types."
+ :group 'environment)
+
+(defgroup unix nil
+ "Front-ends/assistants for, or emulators of, UNIX features."
+ :group 'environment)
+
+(defgroup vms nil
+ "Support code for vms."
+ :group 'environment)
+
+(defgroup i18n nil
+ "Internationalization and alternate character-set support."
+ :group 'environment
+ :group 'editing)
+
+(defgroup frames nil
+ "Support for Emacs frames and window systems."
+ :group 'environment)
+
+(defgroup data nil
+ "Support editing files of data."
+ :group 'emacs)
+
+(defgroup wp nil
+ "Word processing."
+ :group 'emacs)
+
+(defgroup tex nil
+ "Code related to the TeX formatter."
+ :group 'wp)
+
+(defgroup faces nil
+ "Support for multiple fonts."
+ :group 'emacs)
+
+(defgroup hypermedia nil
+ "Support for links between text or other media types."
+ :group 'emacs)
+
+(defgroup help nil
+ "Support for on-line help systems."
+ :group 'emacs)
+
+(defgroup local nil
+ "Code local to your site."
+ :group 'emacs)
+
+(defgroup customize '((widgets custom-group))
+ "Customization of the Customization support."
+ :link '(custom-manual "(custom)Top")
+ :link '(url-link :tag "Development Page"
+ "http://www.dina.kvl.dk/~abraham/custom/")
+ :prefix "custom-"
+ :group 'help
+ :group 'faces)
+
;;; Utilities.
(defun custom-quote (sexp)
(custom-buffer-create (list (list symbol 'custom-variable))))
;;;###autoload
-(defun customize-face (symbol)
- "Customize FACE."
- (interactive (list (completing-read "Customize face: "
+(defun customize-face (&optional symbol)
+ "Customize SYMBOL, which should be a face name or nil.
+If SYMBOL is nil, customize all faces."
+ (interactive (list (completing-read "Customize face: (default all) "
obarray 'custom-facep)))
- (if (stringp symbol)
- (setq symbol (intern symbol)))
- (unless (symbolp symbol)
- (error "Should be a symbol %S" symbol))
- (custom-buffer-create (list (list symbol 'custom-face))))
+ (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
+ (let ((found nil))
+ (message "Looking for faces...")
+ (mapcar (lambda (symbol)
+ (setq found (cons (list symbol 'custom-face) found)))
+ (face-list))
+ (message "Creating customization buffer...")
+ (custom-buffer-create found))
+ (if (stringp symbol)
+ (setq symbol (intern symbol)))
+ (unless (symbolp symbol)
+ (error "Should be a symbol %S" symbol))
+ (custom-buffer-create (list (list symbol 'custom-face)))))
;;;###autoload
(defun customize-customized ()
:tag "Done"
:help-echo "Push me to bury the buffer."
:action (lambda (widget &optional event)
- (bury-buffer)))
+ (bury-buffer)
+ ;; Steal button release event.
+ (if (and (fboundp 'button-press-event-p)
+ (fboundp 'next-command-event))
+ ;; XEmacs
+ (and event
+ (button-press-event-p event)
+ (next-command-event))
+ ;; Emacs
+ (when (memq 'down (event-modifiers event))
+ (read-event)))))
(widget-insert "\n")
(widget-setup))
(default-value symbol)
(widget-get widget :value)))
tmp
- (state (cond ((and (setq tmp (get symbol 'customized-value))
- (not (condition-case nil
- (equal value (eval (car tmp)))
- (error nil))))
- 'set)
- ((and (setq tmp (get symbol 'saved-value))
- (not (condition-case nil
- (equal value (eval (car tmp)))
- (error nil))))
- 'saved)
+ (state (cond ((setq tmp (get symbol 'customized-value))
+ (if (condition-case nil
+ (equal value (eval (car tmp)))
+ (error nil))
+ 'set
+ 'changed))
+ ((setq tmp (get symbol 'saved-value))
+ (if (condition-case nil
+ (equal value (eval (car tmp)))
+ (error nil))
+ 'saved
+ 'changed))
((setq tmp (get symbol 'factory-value))
(if (condition-case nil
(equal value (eval (car tmp)))
(error nil))
'factory
- 'set))
+ 'changed))
(t 'rogue))))
(widget-put widget :custom-state state)))
(widget-put widget :custom-state 'unknown)
(custom-redraw widget))
(let* ((completion-ignore-case t)
- (answer (widget-choose (symbol-name (widget-get widget :value))
+ (answer (widget-choose (custom-unlispify-tag-name
+ (widget-get widget :value))
custom-variable-menu
event)))
(if answer
:format-handler 'custom-face-format-handler
:sample-face 'custom-face-tag-face
:help-echo "Push me to set or reset this face."
- :documentation-property 'face-documentation
+ :documentation-property '(lambda (face)
+ (get-face-documentation face))
:value-create 'custom-face-value-create
:action 'custom-face-action
:custom-set 'custom-face-set
(custom-redraw widget))
(let* ((completion-ignore-case t)
(symbol (widget-get widget :value))
- (answer (widget-choose (symbol-name symbol)
+ (answer (widget-choose (custom-unlispify-tag-name symbol)
custom-face-menu event)))
(if answer
(funcall answer widget)))))
(widget-put widget :custom-state 'unknown)
(custom-redraw widget))
(let* ((completion-ignore-case t)
- (answer (widget-choose (symbol-name (widget-get widget :value))
+ (answer (widget-choose (custom-unlispify-tag-name
+ (widget-get widget :value))
custom-group-menu
event)))
(if answer
;;; The End.
-(provide 'custom-edit)
+(provide 'cus-edit)
-;; custom-edit.el ends here
+;; cus-edit.el ends here
--- /dev/null
+;;; cus-face.el -- XEmacs specific custom support.
+;;
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+;;
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Keywords: help, faces
+;; Version: 1.48
+;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+
+;;; Commentary:
+;;
+;; See `custom.el'.
+
+;;; Code:
+
+(require 'custom)
+
+;;; Compatibility.
+
+(unless (fboundp 'frame-property)
+ ;; XEmacs function missing in Emacs 19.34.
+ (defun frame-property (frame property &optional default)
+ "Return FRAME's value for property PROPERTY."
+ (or (cdr (assq property (frame-parameters frame)))
+ default)))
+
+(unless (fboundp 'x-color-values)
+ ;; Emacs function missing in XEmacs 19.14.
+ (defun x-color-values (color &optional frame)
+ "Return a description of the color named COLOR on frame FRAME.
+The value is a list of integer RGB values--(RED GREEN BLUE).
+These values appear to range from 0 to 65280 or 65535, depending
+on the system; white is (65280 65280 65280) or (65535 65535 65535).
+If FRAME is omitted or nil, use the selected frame."
+ (color-instance-rgb-components (make-color-instance color))))
+
+;; XEmacs and Emacs have different definitions of `facep'.
+;; The Emacs definition is the useful one, so emulate that.
+(cond ((not (fboundp 'facep))
+ (defun custom-facep (face)
+ "No faces"
+ nil))
+ ((string-match "XEmacs" emacs-version)
+ (defalias 'custom-facep 'find-face))
+ (t
+ (defalias 'custom-facep 'facep)))
+
+;; Overwrite Emacs definition.
+(if (string-match "XEmacs" emacs-version)
+ (progn
+ (defun custom-extract-frame-properties (frame)
+ "Return a plist with the frame properties of FRAME used by custom."
+ (list 'type (device-type (frame-device frame))
+ 'class (device-class (frame-device frame))
+ 'background (or custom-background-mode
+ (frame-property frame
+ 'background-mode)
+ (custom-background-mode frame))))
+
+ (defun get-face-documentation (face)
+ "Get the documentation string for FACE."
+ (face-property face 'doc-string))
+
+ (defun set-face-documentation (face string)
+ "Set the documentation string for FACE to STRING."
+ (set-face-property face 'doc-string string)))
+
+ (defun custom-extract-frame-properties (frame)
+ "Return a plist with the frame properties of FRAME used by custom."
+ (list 'type window-system
+ 'class (frame-property frame 'display-type)
+ 'background (or custom-background-mode
+ (frame-property frame
+ 'background-mode)
+ (custom-background-mode frame))))
+
+ (defun get-face-documentation (face)
+ "Get the documentation string for FACE."
+ (get face 'face-documentation))
+
+ (defun set-face-documentation (face string)
+ "Set the documentation string for FACE to STRING."
+ (put face 'face-documentation string)))
+
+;;; Declaring a face.
+
+;;;###autoload
+(defun custom-declare-face (face spec doc &rest args)
+ "Like `defface', but FACE is evaluated as a normal argument."
+ (when (fboundp 'load-gc)
+ ;; This should be allowed, somehow.
+ (error "Attempt to declare a face during dump"))
+ (unless (get face 'factory-face)
+ (put face 'factory-face spec)
+ (when (fboundp 'facep)
+ (unless (and (custom-facep face)
+ (not (get face 'saved-face)))
+ ;; If the user has already created the face, respect that.
+ (let ((value (or (get face 'saved-face) spec))
+ (frames (custom-relevant-frames))
+ frame)
+ ;; Create global face.
+ (custom-face-display-set face value)
+ ;; Create frame local faces
+ (while frames
+ (setq frame (car frames)
+ frames (cdr frames))
+ (custom-face-display-set face value frame)))))
+ (when (and doc (null (get-face-documentation face)))
+ (set-face-documentation face doc))
+ (custom-handle-all-keywords face args 'custom-face)
+ (run-hooks 'custom-define-hook))
+ face)
+
+;;; Font Attributes.
+
+(defun custom-face-attribites-set (face frame &rest atts)
+ "For FACE on FRAME set the attributes [KEYWORD VALUE]....
+Each keyword should be listed in `custom-face-attributes'.
+
+If FRAME is nil, set the default face."
+ (while atts
+ (let* ((name (nth 0 atts))
+ (value (nth 1 atts))
+ (fun (nth 2 (assq name custom-face-attributes))))
+ (setq atts (cdr (cdr atts)))
+ (condition-case nil
+ (funcall fun face value frame)
+ (error nil)))))
+
+(defconst custom-face-attributes
+ '((:bold (toggle :format "Bold: %[%v%]\n") custom-set-face-bold)
+ (:italic (toggle :format "Italic: %[%v%]\n") custom-set-face-italic)
+ (:underline
+ (toggle :format "Underline: %[%v%]\n") set-face-underline-p)
+ (:foreground (color :tag "Foreground") set-face-foreground)
+ (:background (color :tag "Background") set-face-background)
+ (:stipple (editable-field :format "Stipple: %v") set-face-stipple))
+ "Alist of face attributes.
+
+The elements are of the form (KEY TYPE SET) where KEY is a symbol
+identifying the attribute, TYPE is a widget type for editing the
+attibute, SET is a function for setting the attribute value.
+
+The SET function should take three arguments, the face to modify, the
+value of the attribute, and optionally the frame where the face should
+be changed.")
+
+(defun custom-set-face-bold (face value &optional frame)
+ "Set the bold property of FACE to VALUE."
+ (if value
+ (make-face-bold face frame)
+ (make-face-unbold face frame)))
+
+(defun custom-set-face-italic (face value &optional frame)
+ "Set the italic property of FACE to VALUE."
+ (if value
+ (make-face-italic face frame)
+ (make-face-unitalic face frame)))
+
+(when (string-match "XEmacs" emacs-version)
+ ;; Support for special XEmacs font attributes.
+ (autoload 'font-create-object "font" nil)
+
+ (unless (fboundp 'face-font-name)
+ (defun face-font-name (face &rest args)
+ (apply 'face-font face args)))
+
+ (defun custom-set-face-font-size (face size &rest args)
+ "Set the font of FACE to SIZE"
+ (let* ((font (apply 'face-font-name face args))
+ (fontobj (font-create-object font)))
+ (set-font-size fontobj size)
+ (apply 'set-face-font face fontobj args)))
+
+ (defun custom-set-face-font-family (face family &rest args)
+ "Set the font of FACE to FAMILY"
+ (let* ((font (apply 'face-font-name face args))
+ (fontobj (font-create-object font)))
+ (set-font-family fontobj family)
+ (apply 'set-face-font face fontobj args)))
+
+ (nconc custom-face-attributes
+ '((:family (editable-field :format "Family: %v")
+ custom-set-face-font-family)
+ (:size (editable-field :format "Size: %v")
+ custom-set-face-font-size)))
+
+ ;; Disable frame local faces.
+ (setq custom-relevant-frames nil)
+ (remove-hook 'after-make-frame-hook 'custom-initialize-frame))
+
+;;; Frames.
+
+(and (fboundp 'make-face)
+ (make-face 'custom-face-empty))
+
+(defun custom-face-display-set (face spec &optional frame)
+ "Set FACE to the attributes to the first matching entry in SPEC.
+Iff optional FRAME is non-nil, set it for that frame only.
+See `defface' for information about SPEC."
+ (when (fboundp 'copy-face)
+ (while spec
+ (let* ((entry (car spec))
+ (display (nth 0 entry))
+ (atts (nth 1 entry)))
+ (setq spec (cdr spec))
+ (when (custom-display-match-frame display frame)
+ ;; Avoid creating frame local duplicates of the global face.
+ (unless (and frame (eq display (get face 'custom-face-display)))
+ (copy-face 'custom-face-empty face frame)
+ (apply 'custom-face-attribites-set face frame atts))
+ (unless frame
+ (put face 'custom-face-display display))
+ (setq spec nil))))))
+
+(defcustom custom-background-mode nil
+ "The brightness of the background.
+Set this to the symbol dark if your background color is dark, light if
+your background is light, or nil (default) if you want Emacs to
+examine the brightness for you."
+ :group 'customize
+ :type '(choice (choice-item dark)
+ (choice-item light)
+ (choice-item :tag "default" nil)))
+
+(defun custom-background-mode (frame)
+ "Kludge to detect background mode for FRAME."
+ (let* ((bg-resource
+ (condition-case ()
+ (x-get-resource ".backgroundMode" "BackgroundMode" 'string)
+ (error nil)))
+ color
+ (mode (cond (bg-resource
+ (intern (downcase bg-resource)))
+ ((and (setq color (condition-case ()
+ (or (frame-property
+ frame
+ 'background-color)
+ (color-instance-name
+ (specifier-instance
+ (face-background 'default))))
+ (error nil)))
+ (< (apply '+ (x-color-values color))
+ (/ (apply '+ (x-color-values "white"))
+ 3)))
+ 'dark)
+ (t 'light))))
+ (modify-frame-parameters frame (list (cons 'background-mode mode)))
+ mode))
+
+(defvar custom-default-frame-properties nil
+ "The frame properties used for the global faces.
+Frames who doesn't match these propertiess should have frame local faces.
+The value should be nil, if uninitialized, or a plist otherwise.
+See `defface' for a list of valid keys and values for the plist.")
+
+(defun custom-get-frame-properties (&optional frame)
+ "Return a plist with the frame properties of FRAME used by custom.
+If FRAME is nil, return the default frame properties."
+ (cond (frame
+ ;; Try to get from cache.
+ (let ((cache (frame-property frame 'custom-properties)))
+ (unless cache
+ ;; Oh well, get it then.
+ (setq cache (custom-extract-frame-properties frame))
+ ;; and cache it...
+ (modify-frame-parameters frame
+ (list (cons 'custom-properties cache))))
+ cache))
+ (custom-default-frame-properties)
+ (t
+ (setq custom-default-frame-properties
+ (custom-extract-frame-properties (selected-frame))))))
+
+(defun custom-display-match-frame (display frame)
+ "Non-nil iff DISPLAY matches FRAME.
+If FRAME is nil, the current FRAME is used."
+ ;; This is a kludge to get started, we really should use specifiers!
+ (if (eq display t)
+ t
+ (let* ((props (custom-get-frame-properties frame))
+ (type (plist-get props 'type))
+ (class (plist-get props 'class))
+ (background (plist-get props 'background))
+ (match t)
+ (entries display)
+ entry req options)
+ (while (and entries match)
+ (setq entry (car entries)
+ entries (cdr entries)
+ req (car entry)
+ options (cdr entry)
+ match (cond ((eq req 'type)
+ (memq type options))
+ ((eq req 'class)
+ (memq class options))
+ ((eq req 'background)
+ (memq background options))
+ (t
+ (error "Unknown req `%S' with options `%S'"
+ req options)))))
+ match)))
+
+(defvar custom-relevant-frames t
+ "List of frames whose custom properties differ from the default.")
+
+(defun custom-relevant-frames ()
+ "List of frames whose custom properties differ from the default."
+ (when (eq custom-relevant-frames t)
+ (setq custom-relevant-frames nil)
+ (let ((default (custom-get-frame-properties))
+ (frames (frame-list))
+ frame)
+ (while frames
+ (setq frame (car frames)
+ frames (cdr frames))
+ (unless (equal default (custom-get-frame-properties frame))
+ (push frame custom-relevant-frames)))))
+ custom-relevant-frames)
+
+(defun custom-initialize-faces (&optional frame)
+ "Initialize all custom faces for FRAME.
+If FRAME is nil or omitted, initialize them for all frames."
+ (mapatoms (lambda (symbol)
+ (let ((spec (or (get symbol 'saved-face)
+ (get symbol 'factory-face))))
+ (when spec
+ (custom-face-display-set symbol spec frame))))))
+
+(defun custom-initialize-frame (&optional frame)
+ "Initialize local faces for FRAME if necessary.
+If FRAME is missing or nil, the first member (frame-list) is used."
+ (unless frame
+ (setq frame (car (frame-list))))
+ (unless (equal (custom-get-frame-properties)
+ (custom-get-frame-properties frame))
+ (custom-initialize-faces frame)
+ (push frame custom-relevant-frames)))
+
+;; Enable. This should go away when bundled with Emacs.
+(add-hook 'after-make-frame-hook 'custom-initialize-frame)
+
+;;; Initializing.
+
+;;;###autoload
+(defun custom-set-faces (&rest args)
+ "Initialize faces according to user preferences.
+The arguments should be a list where each entry has the form:
+
+ (FACE SPEC [NOW])
+
+SPEC will be stored as the saved value for FACE. If NOW is present
+and non-nil, FACE will also be created according to SPEC.
+
+See `defface' for the format of SPEC."
+ (while args
+ (let ((entry (car args)))
+ (if (listp entry)
+ (let ((face (nth 0 entry))
+ (spec (nth 1 entry))
+ (now (nth 2 entry)))
+ (put face 'saved-face spec)
+ (when now
+ (put face 'force-face t)
+ (custom-face-display-set face spec))
+ (setq args (cdr args)))
+ ;; Old format, a plist of FACE SPEC pairs.
+ (let ((face (nth 0 args))
+ (spec (nth 1 args)))
+ (put face 'saved-face spec))
+ (setq args (cdr (cdr args)))))))
+
+;;; The End.
+
+(provide 'cus-face)
+
+;; cus-face.el ends here
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.38
+;; Version: 1.48
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
;;
;; This file only contain the code needed to declare and initialize
;; user options. The code to customize options is autoloaded from
-;; `custom-edit.el'.
+;; `cus-edit.el'.
+
+;; The code implementing face declarations is in `cus-face.el'
;;; Code:
;; These autoloads should be deleted when the file is added to Emacs
(unless (fboundp 'load-gc)
- (autoload 'customize "custom-edit" nil t)
- (autoload 'customize-variable "custom-edit" nil t)
- (autoload 'customize-face "custom-edit" nil t)
- (autoload 'customize-apropos "custom-edit" nil t)
- (autoload 'customize-customized "custom-edit" nil t)
- (autoload 'custom-buffer-create "custom-edit")
- (autoload 'custom-menu-update "custom-edit")
- (autoload 'custom-make-dependencies "custom-edit"))
-
-;;; Compatibility.
-
-(unless (fboundp 'x-color-values)
- ;; Emacs function missing in XEmacs 19.14.
- (defun x-color-values (color)
- "Return a description of the color named COLOR on frame FRAME.
-The value is a list of integer RGB values--(RED GREEN BLUE).
-These values appear to range from 0 to 65280 or 65535, depending
-on the system; white is (65280 65280 65280) or (65535 65535 65535).
-If FRAME is omitted or nil, use the selected frame."
- (color-instance-rgb-components (make-color-instance color))))
-
-(unless (fboundp 'frame-property)
- ;; XEmacs function missing in Emacs 19.34.
- (defun frame-property (frame property &optional default)
- "Return FRAME's value for property PROPERTY."
- (or (cdr (assq property (frame-parameters frame)))
- default)))
-
-(defun custom-background-mode ()
- "Kludge to detext background mode."
- (let* ((bg-resource
- (condition-case ()
- (x-get-resource ".backgroundMode" "BackgroundMode" 'string)
- (error nil)))
- color
- (mode (cond (bg-resource
- (intern (downcase bg-resource)))
- ((and (setq color (condition-case ()
- (or (frame-property
- (selected-frame)
- 'background-color)
- (color-instance-name
- (specifier-instance
- (face-background 'default))))
- (error nil)))
- (< (apply '+ (x-color-values color))
- (/ (apply '+ (x-color-values "white"))
- 3)))
- 'dark)
- (t 'light))))
- (modify-frame-parameters (selected-frame)
- (list (cons 'background-mode mode)))
- mode))
-
-;; XEmacs and Emacs have different definitions of `facep'.
-;; The Emacs definition is the useful one, so emulate that.
-(cond ((not (fboundp 'facep))
- (defun custom-facep (face)
- "No faces"
- nil))
- ((string-match "XEmacs" emacs-version)
- (defun custom-facep (face)
- "Face symbol or object."
- (or (facep face)
- (find-face face))))
- (t
- (defalias 'custom-facep 'facep)))
+ ;; From cus-edit.el
+ (autoload 'customize "cus-edit" nil t)
+ (autoload 'customize-variable "cus-edit" nil t)
+ (autoload 'customize-face "cus-edit" nil t)
+ (autoload 'customize-apropos "cus-edit" nil t)
+ (autoload 'customize-customized "cus-edit" nil t)
+ (autoload 'custom-buffer-create "cus-edit")
+ (autoload 'custom-menu-update "cus-edit")
+ (autoload 'custom-make-dependencies "cus-edit")
+ ;; From cus-face.el
+ (autoload 'custom-declare-face "cus-face")
+ (autoload 'custom-set-faces "cus-face"))
;;; The `defcustom' Macro.
(defun custom-declare-variable (symbol value doc &rest args)
- "Like `defcustom', but SYMBOL and VALUE are evaluated as notmal arguments."
+ "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments."
(unless (and (default-boundp symbol)
(not (get symbol 'saved-value)))
(set-default symbol (if (get symbol 'saved-value)
;;; The `defface' Macro.
-(defun custom-declare-face (face spec doc &rest args)
- "Like `defface', but FACE is evaluated as a normal argument."
- (put face 'factory-face spec)
- (when (fboundp 'facep)
- (unless (and (custom-facep face)
- (not (get face 'saved-face)))
- ;; If the user has already created the face, respect that.
- (let ((value (or (get face 'saved-face) spec)))
- (custom-face-display-set face value))))
- (when doc
- (put face 'face-documentation doc))
- (custom-handle-all-keywords face args 'custom-face)
- (run-hooks 'custom-define-hook)
- face)
-
(defmacro defface (face spec doc &rest args)
"Declare FACE as a customizable face that defaults to SPEC.
FACE does not need to be quoted.
(unless (member load loads)
(put symbol 'custom-loads (cons load loads)))))
-;;; Face Utilities.
-
-(and (fboundp 'make-face)
- (make-face 'custom-face-empty))
-
-(defun custom-face-display-set (face spec &optional frame)
- "Set FACE to the attributes to the first matching entry in SPEC.
-Iff optional FRAME is non-nil, set it for that frame only.
-See `defface' for information about SPEC."
- (when (fboundp 'copy-face)
- (copy-face 'custom-face-empty face)
- (while spec
- (let* ((entry (car spec))
- (display (nth 0 entry))
- (atts (nth 1 entry)))
- (setq spec (cdr spec))
- (when (custom-display-match-frame display frame)
- (apply 'custom-face-attribites-set face frame atts)
- (setq spec nil))))))
-
-(defcustom custom-background-mode nil
- "The brightness of the background.
-Set this to the symbol dark if your background color is dark, light if
-your background is light, or nil (default) if you want Emacs to
-examine the brightness for you."
- :group 'customize
- :type '(choice (choice-item dark)
- (choice-item light)
- (choice-item :tag "default" nil)))
-
-(defun custom-display-match-frame (display frame)
- "Non-nil iff DISPLAY matches FRAME.
-If FRAME is nil, the current FRAME is used."
- ;; This is a kludge to get started, we really should use specifiers!
- (unless frame
- (setq frame (selected-frame)))
- (if (eq display t)
- t
- (let ((match t))
- (while (and display match)
- (let* ((entry (car display))
- (req (car entry))
- (options (cdr entry)))
- (setq display (cdr display))
- (cond ((eq req 'type)
- (let ((type (if (fboundp 'device-type)
- (device-type (frame-device frame))
- window-system)))
- (setq match (memq type options))))
- ((eq req 'class)
- (let ((class (if (fboundp 'device-class)
- (device-class (frame-device frame))
- (frame-property frame 'display-type))))
- (setq match (memq class options))))
- ((eq req 'background)
- (let ((background (or custom-background-mode
- (frame-property frame 'background-mode)
- (custom-background-mode))))
- (setq match (memq background options))))
- (t
- (error "Unknown req `%S' with options `%S'" req options)))))
- match)))
-
-(defconst custom-face-attributes
- '((:bold (toggle :format "Bold: %[%v%]\n") custom-set-face-bold)
- (:italic (toggle :format "Italic: %[%v%]\n") custom-set-face-italic)
- (:underline
- (toggle :format "Underline: %[%v%]\n") set-face-underline-p)
- (:foreground (color :tag "Foreground") set-face-foreground)
- (:background (color :tag "Background") set-face-background)
- (:stipple (editable-field :format "Stipple: %v") set-face-stipple))
- "Alist of face attributes.
-
-The elements are of the form (KEY TYPE SET) where KEY is a symbol
-identifying the attribute, TYPE is a widget type for editing the
-attibute, SET is a function for setting the attribute value.
-
-The SET function should take three arguments, the face to modify, the
-value of the attribute, and optionally the frame where the face should
-be changed.")
-
-(when (string-match "XEmacs" emacs-version)
- ;; Support for special XEmacs font attributes.
- (require 'font)
-
- (unless (fboundp 'face-font-name)
- (defun face-font-name (face &rest args)
- (apply 'face-font face args)))
-
- (defun set-face-font-size (face size &rest args)
- "Set the font of FACE to SIZE"
- (let* ((font (apply 'face-font-name face args))
- (fontobj (font-create-object font)))
- (set-font-size fontobj size)
- (apply 'set-face-font face fontobj args)))
-
- (defun set-face-font-family (face family &rest args)
- "Set the font of FACE to FAMILY"
- (let* ((font (apply 'face-font-name face args))
- (fontobj (font-create-object font)))
- (set-font-family fontobj family)
- (apply 'set-face-font face fontobj args)))
-
- (nconc custom-face-attributes
- '((:family (editable-field :format "Family: %v")
- set-face-font-family)
- (:size (editable-field :format "Size: %v")
- set-face-font-size))))
-
-(defun custom-face-attribites-set (face frame &rest atts)
- "For FACE on FRAME set the attributes [KEYWORD VALUE]....
-Each keyword should be listed in `custom-face-attributes'.
-
-If FRAME is nil, set the default face."
- (while atts
- (let* ((name (nth 0 atts))
- (value (nth 1 atts))
- (fun (nth 2 (assq name custom-face-attributes))))
- (setq atts (cdr (cdr atts)))
- (condition-case nil
- (funcall fun face value)
- (error nil)))))
-
-(defun custom-set-face-bold (face value &optional frame)
- "Set the bold property of FACE to VALUE."
- (if value
- (make-face-bold face frame)
- (make-face-unbold face frame)))
-
-(defun custom-set-face-italic (face value &optional frame)
- "Set the italic property of FACE to VALUE."
- (if value
- (make-face-italic face frame)
- (make-face-unitalic face frame)))
-
-(defun custom-initialize-faces (&optional frame)
- "Initialize all custom faces for FRAME.
-If FRAME is nil or omitted, initialize them for all frames."
- (mapatoms (lambda (symbol)
- (let ((spec (or (get symbol 'saved-face)
- (get symbol 'factory-face))))
- (when spec
- (custom-face-display-set symbol spec frame))))))
-
;;; Initializing.
(defun custom-set-variables (&rest args)
(put symbol 'saved-value (list value)))
(setq args (cdr (cdr args)))))))
-(defun custom-set-faces (&rest args)
- "Initialize faces according to user preferences.
-The arguments should be a list where each entry has the form:
-
- (FACE SPEC [NOW])
-
-SPEC will be stored as the saved value for FACE. If NOW is present
-and non-nil, FACE will also be created according to SPEC.
-
-See `defface' for the format of SPEC."
- (while args
- (let ((entry (car args)))
- (if (listp entry)
- (let ((face (nth 0 entry))
- (spec (nth 1 entry))
- (now (nth 2 entry)))
- (put face 'saved-face spec)
- (when now
- (put face 'force-face t)
- (custom-face-display-set face spec))
- (setq args (cdr args)))
- ;; Old format, a plist of FACE SPEC pairs.
- (let ((face (nth 0 args))
- (spec (nth 1 args)))
- (put face 'saved-face spec))
- (setq args (cdr (cdr args)))))))
-
;;; Meta Customization
-(defgroup emacs nil
- "Customization of the One True Editor."
- :link '(custom-manual "(emacs)Top"))
-
-(defgroup customize '((widgets custom-group))
- "Customization of the Customization support."
- :link '(custom-manual "(custom)Top")
- :link '(url-link :tag "Development Page"
- "http://www.dina.kvl.dk/~abraham/custom/")
- :prefix "custom-"
- :group 'emacs)
-
(defcustom custom-define-hook nil
"Hook called after defining each customize option."
:group 'customize
(defun custom-menu-reset ()
"Reset customize menu."
(remove-hook 'custom-define-hook 'custom-menu-reset)
- (cond ((fboundp 'add-submenu)
- ;; XEmacs with menus.
- (add-submenu '("Help") custom-help-menu))
- ((string-match "XEmacs" emacs-version)
- ;; XEmacs without menus.
- )
- (t
- ;; Emacs.
- (define-key global-map [menu-bar help-menu customize-menu]
- (cons (car custom-help-menu)
- (easy-menu-create-keymaps (car custom-help-menu)
- (cdr custom-help-menu)))))))
-
-(unless (fboundp 'load-gc)
- (custom-menu-reset))
+ (if (string-match "XEmacs" emacs-version)
+ (when (fboundp 'add-submenu)
+ (add-submenu '("Help") custom-help-menu))
+ (define-key global-map [menu-bar help-menu customize-menu]
+ (cons (car custom-help-menu)
+ (easy-menu-create-keymaps (car custom-help-menu)
+ (cdr custom-help-menu))))))
;;; The End.
(goto-char cur)
nil)))
+(eval-and-compile
+ (autoload 'w3-parse-buffer "w3-parse"))
+
+(defun gnus-article-treat-html ()
+ "Render HTML."
+ (interactive)
+ (let ((cbuf (current-buffer)))
+ (set-buffer gnus-article-buffer)
+ (let (buf buffer-read-only b e)
+ (goto-char (point-min))
+ (narrow-to-region
+ (if (search-forward "\n\n" nil t)
+ (setq b (point))
+ (point-max))
+ (setq e (point-max)))
+ (nnheader-temp-write nil
+ (insert-buffer-substring gnus-article-buffer b e)
+ (save-window-excursion
+ (setq buf (car (w3-parse-buffer (current-buffer))))))
+ (when buf
+ (delete-region (point-min) (point-max))
+ (insert-buffer-substring buf)
+ (kill-buffer buf))
+ (widen)
+ (goto-char (point-min))
+ (set-window-start (get-buffer-window (current-buffer)) (point-min))
+ (set-buffer cbuf))))
+
(defun gnus-article-hidden-arg ()
"Return the current prefix arg as a number, or 0 if no prefix."
(list (if current-prefix-arg
(concat "Date: " date "\n"))
;; Let the user define the format.
((eq type 'user)
- (concat
+ (concat
+ "Date: "
(format-time-string gnus-article-time-format
(ignore-errors
(gnus-encode-date
(article-date-ut 'lapsed highlight))
(defun article-date-user (&optional highlight)
- "Convert the current article date to the user-defined format."
+ "Convert the current article date to the user-defined format.
+This format is defined by the `gnus-article-time-format' variable."
(interactive (list t))
(article-date-ut 'user highlight))
(use-local-map gnus-article-mode-map)
(gnus-update-format-specifications nil 'article-mode)
(set (make-local-variable 'page-delimiter) gnus-page-delimiter)
+ (set (make-local-variable 'gnus-button-marker-list) nil)
(gnus-set-default-directory)
(buffer-disable-undo (current-buffer))
(setq buffer-read-only t)
(save-excursion
(set-buffer gnus-article-buffer)
;; Remove all old markers.
- (while gnus-button-marker-list
- (set-marker (pop gnus-button-marker-list) nil))
+ (let (marker entry)
+ (while (setq marker (pop gnus-button-marker-list))
+ (goto-char marker)
+ (when (setq entry (gnus-button-entry))
+ (put-text-property (match-beginning (nth 1 entry))
+ (match-end (nth 1 entry))
+ 'gnus-callback nil))
+ (set-marker marker nil)))
(let ((buffer-read-only nil)
(inhibit-point-motion-hooks t)
(case-fold-search t)
(from (match-beginning 0)))
(when (and (or (eq t (nth 1 entry))
(eval (nth 1 entry)))
- (not (gnus-button-in-region-p from end 'gnus-callback)))
+ (not (gnus-button-in-region-p
+ start end 'gnus-callback)))
;; That optional form returned non-nil, so we add the
- ;; button.
+ ;; button.
(gnus-article-add-button
start end 'gnus-button-push
(car (push (set-marker (make-marker) from)
(inhibit-point-motion-hooks t)
(marks (gnus-dissect-cited-text))
(adaptive-fill-mode nil)
+ (filladapt-mode nil)
(fill-column (if width (prefix-numeric-value width) fill-column)))
(save-restriction
(while (cdr marks)
;;; Code:
-(require 'widget-edit)
+(require 'wid-edit)
(require 'gnus-score)
;;; Widgets:
(gnus))
(gnus-group-read-group nil nil group))
+(defvar gnus-ephemeral-group-server 0)
+
;; Enter a group that is not in the group buffer. Non-nil is returned
;; if selection was successful.
(defun gnus-group-read-ephemeral-group (group method &optional activate
If REQUEST-ONLY, don't actually read the group; just request it.
Return the name of the group is selection was successful."
+ ;; Transform the select method into a unique server.
+ (let ((saddr (intern (format "%s-address" (car method)))))
+ (setq method (gnus-copy-sequence method))
+ (unless (assq saddr method)
+ (nconc method `((,saddr ,(cadr method)))))
+ (setf (cadr method) (format "%s-%d" (cadr method)
+ (incf gnus-ephemeral-group-server))))
(let ((group (if (gnus-group-foreign-p group) group
(gnus-group-prefixed-name group method))))
(gnus-sethash
(setq gnus-inserted-opened-servers nil)
;; First we do the real list of servers.
(while alist
- (unless (member (caar alist) done)
- (push (caar alist) done)
+ (unless (member (cdar alist) done)
+ (push (cdar alist) done)
(cdr (setq server (pop alist)))
(when (and server (car server) (cdr server))
(gnus-server-insert-server-line (car server) (cdr server)))))
;; Then we insert the list of servers that have been opened in
;; this session.
(while opened
- (unless (member (cadaar opened) done)
- (push (cadaar opened) done)
+ (unless (member (caar opened) done)
+ (push (caar opened) done)
(gnus-server-insert-server-line
(setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened))))
(caar opened))
;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
(defvar gnus-init-inhibit nil)
(defun gnus-read-init-file (&optional inhibit-next)
- ;; Don't load .gnus if -q option was used.
+ ;; Don't load .gnus if the -q option was used.
(when init-file-user
(if gnus-init-inhibit
(setq gnus-init-inhibit nil)
"r" gnus-summary-caesar-message
"t" gnus-article-hide-headers
"v" gnus-summary-verbose-headers
- "m" gnus-summary-toggle-mime)
+ "m" gnus-summary-toggle-mime
+ "h" gnus-article-treat-html)
(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
"a" gnus-article-hide
header level nil (gnus-article-mark article)
(memq article gnus-newsgroup-replied)
(memq article gnus-newsgroup-expirable)
- (mail-header-subject header)
+ ;; Only insert the Subject string when it's different
+ ;; from the previous Subject string.
+ (unless (gnus-subject-equal
+ (condition-case ()
+ (mail-header-subject
+ (gnus-data-header
+ (cadr
+ (gnus-data-find-list
+ article
+ (gnus-data-list t)))))
+ (error ""))
+ (mail-header-subject header))
+ (mail-header-subject header))
nil (cdr (assq article gnus-newsgroup-scored))
(memq article gnus-newsgroup-processable))
(when length
(gnus-mode-string-quote
(mail-header-subject gnus-current-headers))
""))
- max-len
+ bufname-length max-len
gnus-tmp-header);; passed as argument to any user-format-funcs
(setq mode-string (eval mformat))
+ (setq bufname-length (if (string-match "%b" mode-string)
+ (- (length
+ (buffer-name
+ (if (eq where 'summary)
+ nil
+ (get-buffer gnus-article-buffer))))
+ 2)
+ 0))
(setq max-len (max 4 (if gnus-mode-non-string-length
(- (window-width)
gnus-mode-non-string-length
- (if (string-match "%%b" mode-string)
- (length (buffer-name))
- 0))
+ bufname-length)
(length mode-string))))
;; We might have to chop a bit of the string off...
(when (> (length mode-string) max-len)
(save-excursion
(set-buffer gnus-article-buffer)
(save-restriction
- (goto-char (point-min))
- (search-forward "\n\n")
- (narrow-to-region (point-min) (point))
+ (gnus-narrow-to-body)
(message "This message would go to %s"
(mapconcat 'car (nnmail-article-group 'identity) ", "))))))
(erase-buffer)
(insert-buffer-substring artbuf)
(goto-char (point-min))
- (unless (looking-at "From ")
+ (if (looking-at "From ")
+ (forward-line 1)
(insert "From nobody " (current-time-string) "\n"))
+ (let (case-fold-search)
+ (while (re-search-forward "^From " nil t)
+ (beginning-of-line)
+ (insert ">")))
;; Decide whether to append to a file or to an Emacs buffer.
(let ((outbuf (get-file-buffer filename)))
(if (not outbuf)
(defun gnus-quote-arg-for-sh-or-csh (arg)
(let ((pos 0) new-pos accum)
;; *** bug: we don't handle newline characters properly
- (while (setq new-pos (string-match "[!`\"$\\& \t]" arg pos))
+ (while (setq new-pos (string-match "[!`\"$\\& \t{}]" arg pos))
(push (substring arg pos new-pos) accum)
(push "\\" accum)
(push (list (aref arg new-pos)) accum)
(let ((event (next-command-event)))
(sit-for 0)
;; We junk all non-key events. Is this naughty?
- (while (not (key-press-event-p event))
+ (while (not (or (key-press-event-p event)
+ (button-press-event-p event)))
+ (dispatch-event event)
(setq event (next-command-event)))
(cons (and (key-press-event-p event)
(event-to-character event))
(color-instance-rgb-components
(make-color-instance color))))))
-(defun gnus-xmas-region-active-p ()
- (and (fboundp 'region-active-p)
- (region-active-p)))
-
(defun gnus-xmas-redefine ()
"Redefine lots of Gnus functions for XEmacs."
(fset 'gnus-summary-make-display-table 'ignore)
(fset 'gnus-mode-line-buffer-identification
'gnus-xmas-mode-line-buffer-identification)
(fset 'gnus-key-press-event-p 'key-press-event-p)
- (fset 'gnus-region-active-p 'gnus-xmas-region-active-p)
+ (fset 'gnus-region-active-p 'region-active-p)
(add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
(add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
+;; Keywords: news, mail
;; This file is part of GNU Emacs.
(defgroup gnus nil
"The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
- :group 'emacs)
+ :group 'news
+ :group 'mail)
(defgroup gnus-start nil
"Starting your favorite newsreader."
;; Other
(defgroup gnus-visual nil
"Options controling the visual fluff."
- :group 'gnus)
+ :group 'gnus
+ :group 'faces)
(defgroup gnus-files nil
"Files used by Gnus."
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "5.4.16"
+(defconst gnus-version-number "5.4.17"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Gnus v%s" gnus-version-number)
group nil)))
name))
+(defun gnus-narrow-to-body ()
+ "Narrow to the body of an article."
+ (narrow-to-region
+ (progn
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t)
+ (point-max)))
+ (point-max)))
+
\f
;;;
;;; Kill file handling.
(user-full-name custom-variable))
"Mail and news message composing."
:link '(custom-manual "(message)Top")
- :group 'emacs)
+ :group 'mail
+ :group 'news)
(put 'user-mail-address 'custom-type 'string)
(put 'user-full-name 'custom-type 'string)
".fsf")))
(defun message-number-base36 (num len)
- (if (if (< len 0) (<= num 0) (= len 0))
+ (if (if (< len 0)
+ (<= num 0)
+ (= len 0))
""
(concat (message-number-base36 (/ num 36) (1- len))
(char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
(message-setup
(nconc
`((To . ,(or to "")) (Subject . ,(or subject "")))
- (when other-headers (list other-headers))))))
+ (when other-headers other-headers)))))
;;;###autoload
(defun message-news (&optional newsgroups subject)
(nnml-retrieve-headers 0 nndir-current-group 0 0)
(nnmh-request-article 0 nndir-current-group 0 0)
(nnmh-request-group nndir-current-group 0 0)
- (nnmh-close-group nndir-current-group 0)
+ (nnml-close-group nndir-current-group 0)
(nnmh-request-list (nnoo-current-server 'nndir) nndir-directory)
(nnmh-request-newsgroups (nnoo-current-server 'nndir) nndir-directory))
(body-end . "^-+ End of forwarded message -+$")
(prepare-body-function . nndoc-unquote-dashes))
(rfc934
- (article-begin . "^-.*\n+")
- (body-end . "^-.*$")
+ (article-begin . "^--.*\n+")
+ (body-end . "^--.*$")
(prepare-body-function . nndoc-unquote-dashes))
(clari-briefs
(article-begin . "^ \\*")
(nnmail-activate 'nnfolder)))
(defun nnfolder-active-number (group)
- (when group
- (save-excursion
- ;; Find the next article number in GROUP.
- (prog1
- (let ((active (cadr (assoc group nnfolder-group-alist))))
- (if active
- (setcdr active (1+ (cdr active)))
- ;; This group is new, so we create a new entry for it.
- ;; This might be a bit naughty... creating groups on the drop of
- ;; a hat, but I don't know...
- (push (list group (setq active (cons 1 1)))
- nnfolder-group-alist))
- (cdr active))
- (nnfolder-possibly-activate-groups group)))))
+ ;; Find the next article number in GROUP.
+ (let ((active (cadr (assoc group nnfolder-group-alist))))
+ (if active
+ (setcdr active (1+ (cdr active)))
+ ;; This group is new, so we create a new entry for it.
+ ;; This might be a bit naughty... creating groups on the drop of
+ ;; a hat, but I don't know...
+ (push (list group (setq active (cons 1 1)))
+ nnfolder-group-alist))
+ (cdr active)))
;; This method has a problem if you've accidentally let the active list get
(delete-file nnmail-crash-box))
(let ((inbox (file-truename (expand-file-name inbox)))
(tofile (file-truename (expand-file-name nnmail-crash-box)))
- movemail popmail errors)
+ movemail popmail errors result)
(if (setq popmail (string-match
"^po:" (file-name-nondirectory inbox)))
(setq inbox (file-name-nondirectory inbox))
(let ((default-directory "/"))
(if (nnheader-functionp nnmail-movemail-program)
(funcall nnmail-movemail-program inbox tofile)
- (apply
- 'call-process
- (append
- (list
- (expand-file-name
- nnmail-movemail-program exec-directory)
- nil errors nil inbox tofile)
- (when nnmail-internal-password
- (list nnmail-internal-password))))))
- (if (not (buffer-modified-p errors))
+ (setq result
+ (apply
+ 'call-process
+ (append
+ (list
+ (expand-file-name
+ nnmail-movemail-program exec-directory)
+ nil errors nil inbox tofile)
+ (when nnmail-internal-password
+ (list nnmail-internal-password)))))))
+ (if (and (not (buffer-modified-p errors))
+ (zerop result))
;; No output => movemail won
(progn
(unless popmail
(when (looking-at "movemail: ")
(delete-region (point-min) (match-end 0)))
(unless (yes-or-no-p
- (format "movemail: %s. Continue? "
- (buffer-string)))
+ (format "movemail: %s (%d return). Continue? "
+ (buffer-string) result))
(error "%s" (buffer-string)))
(setq tofile nil)))))))
(message "Getting mail from %s...done" inbox)
(unless nnmail-read-passwd
(if (load "passwd" t)
(setq nnmail-read-passwd 'read-passwd)
- (autoload 'ange-ftp-read-passwd "ange-ftp")
+ (unless (fboundp 'ange-ftp-read-passwd)
+ (autoload 'ange-ftp-read-passwd "ange-ftp"))
(setq nnmail-read-passwd 'ange-ftp-read-passwd)))
(funcall nnmail-read-passwd prompt)))
(while sequence
(setq article (car sequence))
(setq file (nnml-article-to-file article))
- (when (and (file-exists-p file)
+ (when (and file
+ (file-exists-p file)
(not (file-directory-p file)))
(insert (format "221 %d Article retrieved.\n" article))
(setq beg (point))
-;;; widget-browse.el --- Functions for browsing widgets.
+;;; wid-browse.el --- Functions for browsing widgets.
;;
;; Copyright (C) 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
-;; Version: 1.38
+;; Version: 1.48
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(require 'easymenu)
(require 'custom)
-(require 'widget-edit)
+(require 'wid-edit)
(require 'cl)
(defgroup widget-browse nil
;;; The End:
-(provide 'widget-browse)
+(provide 'wid-browse)
-;; widget-browse.el ends here
+;; wid-browse.el ends here
-;;; widget-edit.el --- Functions for creating and using widgets.
+;;; wid-edit.el --- Functions for creating and using widgets.
;;
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
-;; Version: 1.38
+;; Version: 1.48
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(unless (and (featurep 'custom) (fboundp 'custom-declare-variable))
;; We have the old custom-library, hack around it!
(defmacro defgroup (&rest args) nil)
- (defmacro defcustom (&rest args) nil)
+ (defmacro defcustom (var value doc &rest args)
+ `(defvar ,var ,value ,doc))
(defmacro defface (&rest args) nil)
(define-widget-keywords :prefix :tag :load :link :options :type :group)
(when (fboundp 'copy-face)
(copy-face 'default 'widget-documentation-face)
(copy-face 'bold 'widget-button-face)
- (copy-face 'italic 'widget-field-face))
- (defvar widget-mouse-face 'highlight)
- (defvar widget-menu-max-size 40)))
+ (copy-face 'italic 'widget-field-face))))
;;; Compatibility.
:link '(url-link :tag "Development Page"
"http://www.dina.kvl.dk/~abraham/custom/")
:prefix "widget-"
- :group 'emacs)
+ :group 'extensions
+ :group 'faces
+ :group 'hypermedia)
(defface widget-documentation-face '((((class color)
(background dark))
event (fboundp 'popup-menu) window-system)
;; We are in XEmacs, pressed by the mouse
(let ((val (get-popup-menu-response
- (cons ""
+ (cons title
(mapcar
(function
(lambda (x)
(define-key widget-keymap "\t" 'widget-forward)
(define-key widget-keymap "\M-\t" 'widget-backward)
(define-key widget-keymap [(shift tab)] 'widget-backward)
- (define-key widget-keymap [(shift tab)] 'widget-backward)
(define-key widget-keymap [backtab] 'widget-backward)
(if (string-match "XEmacs" (emacs-version))
(progn
(if (and (fboundp 'make-gui-button)
(fboundp 'make-glyph)
widget-push-button-gui
+ (fboundp 'device-on-window-system-p)
+ (device-on-window-system-p)
(string-match "XEmacs" emacs-version))
(progn
(unless gui
;;; The End:
-(provide 'widget-edit)
+(provide 'wid-edit)
-;; widget-edit.el ends here
+;; wid-edit.el ends here
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, extensions, faces, hypermedia
-;; Version: 1.38
+;; Version: 1.48
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
;; If you want to use this code, please visit the URL above.
;;
;; This file only contain the code needed to define new widget types.
-;; Everything else is autoloaded from `widget-edit.el'.
+;; Everything else is autoloaded from `wid-edit.el'.
;;; Code:
:hide-rear-space)
;; These autoloads should be deleted when the file is added to Emacs.
-(autoload 'widget-create "widget-edit")
-(autoload 'widget-insert "widget-edit")
-(autoload 'widget-browse "widget-browse" nil t)
-(autoload 'widget-browse-at "widget-browse" nil t)
+(unless (fboundp 'load-gc)
+ (autoload 'widget-create "wid-edit")
+ (autoload 'widget-insert "wid-edit")
+ (autoload 'widget-browse "wid-browse" nil t)
+ (autoload 'widget-browse-at "wid-browse" nil t))
-;;;###autoload
(defun define-widget (name class doc &rest args)
"Define a new widget type named NAME from CLASS.
+Sun Mar 2 02:08:40 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Startup Files): Addition.
+ (Score File Format): Fix.
+
Fri Feb 28 23:23:31 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* gnus.texi (Archived Messages): Clarify.
@comment node-name, next, previous, up
@top The Customization Library
-Version: 1.34
+Version: 1.48
@menu
* Introduction::
* Declaring Groups::
* Declaring Variables::
* Declaring Faces::
+* Usage for Package Authors::
@end menu
All the customization declarations can be changes by keyword arguments.
member. For other types variables, the effect is undefined."
@end defun
-@node Declaring Faces, , Declaring Variables, Declarations
+@node Declaring Faces, Usage for Package Authors, Declaring Variables, Declarations
@comment node-name, next, previous, up
@subsection Declaring Faces
@end defun
+@node Usage for Package Authors, , Declaring Faces, Declarations
+@comment node-name, next, previous, up
+@subsection Usage for Package Authors
+
+The recommended usage for the author of a typical emacs lisp package is
+to create one group identifying the package, and make all user options
+and faces members of that group. If the package has more than around 20
+such options, they should be divided into a number of subgroups, with
+each subgroup being member of the top level group.
+
+The top level group for the package should itself be member of one or
+more of the standard customization groups. There exists a group for
+each @emph{finder} keyword. Press @kbd{C-c p} to see a list of finder
+keywords, and add you group to each of them, using the @code{:group}
+keyword.
+
@node Utilities, The Init File, Declarations, Top
@comment node-name, next, previous, up
@section Utilities
We need @strong{much} better support for keyboard operations in the
customize buffer.
-@item
-Support real specifiers under XEmacs.
-
@item
Integrate with @file{w3} so you can customization buffers with much
better formatting. I'm thinking about adding a <custom>name</custom>
@item
Make it possible to append to `choice', `radio', and `set' options.
-@item
-There should be a way to exit the buffer.
-
-An @sc{open look} pushpin would do wonders.
-
@item
Ask whether set or modified variables should be saved in
@code{kill-buffer-hook}.
Command to check if there are any customization options that
does not belong to an existing group.
+@item
+Optionally disable the point-cursor and instead highlight the selected
+item in XEmacs. This is like the *Completions* buffer in XEmacs.
+Suggested by Jens Lautenbacher
+@samp{<jens@@lemming0.lem.uni-karlsruhe.de>}.@refill
+
@end itemize
@contents
@vindex gnus-init-file
When Gnus starts, it will read the @code{gnus-site-init-file}
-(@file{.../site-lisp/gnus.el} by default) and @code{gnus-init-file}
-(@file{~/.gnus.el} by default) files. These are normal Emacs Lisp files
-and can be used to avoid cluttering your @file{.emacs} and
-@file{site-init} files with Gnus stuff.
+(@file{.../site-lisp/gnus} by default) and @code{gnus-init-file}
+(@file{~/.gnus} by default) files. These are normal Emacs Lisp files
+and can be used to avoid cluttering your @file{~/.emacs} and
+@file{site-init} files with Gnus stuff. Gnus will also check for files
+with the same names as these, but with @file{.elc} and @file{.el}
+suffixes. In other words, if you have set @code{gnus-init-file} to
+@file{~/.gnus}, it will look for @file{~/.gnus.elc}, @file{~/.gnus.el},
+and finally @file{~/.gnus} (in this order).
+
@node Auto Save
element}. This date says when the last time this score entry matched,
which provides a mechanism for expiring the score entries. It this
element is not present, the score entry is permanent. The date is
-represented by the number of days since December 31, 1 ce.
+represented by the number of days since December 31, 1 BCE.
@item
If the fourth element is present, it should be a symbol---the @dfn{type
\input texinfo.tex
-@c $Id: widget.texi,v 1.4 1997/02/16 21:58:10 steve Exp $
+@c $Id: widget.texi,v 3.60 1997/03/05 06:00:44 larsi Exp $
@c %**start of header
@setfilename widget
@comment node-name, next, previous, up
@top The Emacs Widget Library
-Version: 1.34
+Version: 1.48
@menu
* Introduction::
@item widget.el
This will declare the user variables, define the function
@code{widget-define}, and autoload the function @code{widget-create}.
-@item widget-edit.el
+@item wid-edit.el
Everything else is here, there is no reason to load it explicitly, as
it will be autoloaded when needed.
@end table
selected and the previous selected radio button will become unselected.
@item The @samp{@b{[Apply Form]}} @samp{@b{[Reset Form]}} buttons.
These are explicit buttons made with the @code{push-button} widget. The main
-difference from the @code{link} widget is that the buttons are intended
-to be displayed more like buttons in a GUI, once Emacs grows powerful
+difference from the @code{link} widget is that the buttons are will be
+displayed as GUI buttons when possible.
enough.
@end table
(require 'widget)
(eval-when-compile
- (require 'widget-edit))
+ (require 'wid-edit))
(defvar widget-example-repeat)
@item
Activate the item this is below the mouse when the button is
released, not the item this is below the mouse when the button is
-pressed. Dired and grep gets this right.
+pressed. Dired and grep gets this right. Give feedback if possible.
@item
Use @samp{@@deffn Widget} to document widgets.
@item
Document @code{widget-browse}.
+@item
+Make indentation work with glyphs and propertional fonts.
+
@item
Add object and class hierarchies to the browser.