+Mon Feb 3 07:46:33 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Gnus v5.4.10 is released.
+
+Mon Feb 3 05:48:09 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * message.el (message-fcc-handler-function): Doc fix.
+ (message-do-fcc): Revert to 5.4.8 behavior.
+
+ * gnus-util.el ((fboundp 'point-at-bol)): Made into defun.
+
+ * gnus-topic.el (gnus-topic-check-topology): Skip "dummy.group".
+ (gnus-group-sort-topic): Delete "dummy.group".
+
+ * gnus-art.el (article-make-date-line): Add a newline.
+
+ * nnkiboze.el (nnkiboze-generate-group): Check that the nov file
+ exists.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Moved some.
+
+ * gnus-art.el (gnus-article-make-menu-bar): Exclude the summary
+ menu.
+
+ * gnus.el (gnus-similar-server-opened): New function.
+ (gnus-server-extend-method): Use it.
+
+ * gnus-sum.el (gnus-data-set-header): New macro.
+ (gnus-summary-edit-article-done): Update when the Message-ID is
+ edited.
+
+ * nnml.el (nnml-request-article): Return the correct group name.
+
+Sat Feb 1 21:29:56 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * smiley.el (smiley-buffer): Use the `smiley-mouse-face' variable,
+ not face.
+
Sat Feb 1 14:19:54 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Gnus v5.4.9 is released.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.20
+;; Version: 1.24
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(stringp sexp)
(numberp sexp)
(and (fboundp 'characterp)
- (funcall (intern "characterp") sexp)))
+ (characterp sexp)))
sexp
(list 'quote sexp)))
(cond ((eq state 'hidden)
(error "Cannot set hidden variable."))
((setq val (widget-apply child :validate))
- (error "Invalid %S" val))
+ (goto-char (widget-get val :from))
+ (error "%s" (widget-get val :error)))
((eq form 'lisp)
(set symbol (eval (setq val (widget-value child))))
(put symbol 'customized-value (list val)))
(cond ((eq state 'hidden)
(error "Cannot set hidden variable."))
((setq val (widget-apply child :validate))
- (error "Invalid %S" val))
+ (goto-char (widget-get val :from))
+ (error "%s" (widget-get val :error)))
((eq form 'lisp)
(put symbol 'saved-value (list (widget-value child)))
(set symbol (eval (widget-value child))))
(defun custom-face-format-handler (widget escape)
;; We recognize extra escape sequences.
(let (child
- (state (widget-get widget :custom-state))
(symbol (widget-get widget :value)))
(cond ((eq escape ?s)
(and (string-match "XEmacs" emacs-version)
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.20
+;; Version: 1.24
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Code:
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.20
+;; Version: 1.24
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
"Customization of the One True Editor."
:link '(custom-manual "(emacs)Top"))
-(defgroup customize nil
+(defgroup customize '((widgets custom-group))
"Customization of the Customization support."
:link '(custom-manual "(custom)Top")
:link '(url-link :tag "Development Page"
(defun custom-menu-reset ()
"Reset customize menu."
(remove-hook 'custom-define-hook 'custom-menu-reset)
- (if (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))))))
+ (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)))))))
(custom-menu-reset)
(concat "Date: " date "\n"))
;; Let the user define the format.
((eq type 'user)
- (format-time-string gnus-article-time-format
- (ignore-errors
- (gnus-encode-date
- (timezone-make-date-arpa-standard
- date nil "UT")))))
+ (concat
+ (format-time-string gnus-article-time-format
+ (ignore-errors
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ date nil "UT"))))
+ "\n"))
;; Do an X-Sent lapsed format.
((eq type 'lapsed)
;; If the date is seriously mangled, the timezone functions are
["Remove carriage return" gnus-article-remove-cr t]
["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]))
- (when (boundp 'gnus-summary-article-menu)
- (define-key gnus-article-mode-map [menu-bar commands]
- (cons "Commands" gnus-summary-article-menu)))
+ (when nil
+ (when (boundp 'gnus-summary-article-menu)
+ (define-key gnus-article-mode-map [menu-bar commands]
+ (cons "Commands" gnus-summary-article-menu))))
(when (boundp 'gnus-summary-post-menu)
(define-key gnus-article-mode-map [menu-bar post]
["Remove article" gnus-cache-remove-article t])
["Enter digest buffer" gnus-summary-enter-digest-group t]
["Isearch article..." gnus-summary-isearch-article t]
- ["Search articles forward..." gnus-summary-search-article-forward t]
- ["Search articles backward..." gnus-summary-search-article-backward t]
["Beginning of the article" gnus-summary-beginning-of-article t]
["End of the article" gnus-summary-end-of-article t]
["Fetch parent of article" gnus-summary-refer-parent-article t]
["Toggle threading" gnus-summary-toggle-threads t])
["Filter articles..." gnus-summary-execute-command t]
["Run command on subjects..." gnus-summary-universal-argument t]
+ ["Search articles forward..." gnus-summary-search-article-forward t]
+ ["Search articles backward..." gnus-summary-search-article-backward t]
["Toggle line truncation" gnus-summary-toggle-truncation t]
["Expand window" gnus-summary-expand-window t]
["Expire expirable articles" gnus-summary-expire-articles
(defmacro gnus-data-header (data)
`(nth 3 ,data))
+(defmacro gnus-data-set-header (data header)
+ `(setf (nth 3 ,data) ,header))
+
(defmacro gnus-data-level (data)
`(nth 4 ,data))
(save-excursion
(save-restriction
(message-narrow-to-head)
- (let ((header (nnheader-parse-head t)))
- (set-buffer buffer)
- (mail-header-set-number header (cdr gnus-article-current))
- (gnus-summary-update-article-line
- (cdr gnus-article-current) header))))
+ (let ((head (buffer-string))
+ header)
+ (nnheader-temp-write nil
+ (insert (format "211 %d Article retrieved.\n"
+ (cdr gnus-article-current)))
+ (insert head)
+ (insert ".\n")
+ (let ((nntp-server-buffer (current-buffer)))
+ (setq header (car (gnus-get-newsgroup-headers
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-dependencies)
+ t))))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-data-set-header
+ (gnus-data-find (cdr gnus-article-current))
+ header)
+ (gnus-summary-update-article-line
+ (cdr gnus-article-current) header))))))
;; Update threads.
(set-buffer (or buffer gnus-summary-buffer))
(gnus-summary-update-article (cdr gnus-article-current)))
(let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
gnus-topic-alist)))
(entry (assoc (caar gnus-topic-topology) gnus-topic-alist))
- (newsrc gnus-newsrc-alist)
+ (newsrc (cdr gnus-newsrc-alist))
group)
(while newsrc
(unless (member (setq group (gnus-info-group (pop newsrc))) tgroups)
;; !!!Sometimes nil elements sneak into the alist,
;; for some reason or other.
(setcar alist (delq nil (car alist)))
+ (setcar alist (delete "dummy.group" (car alist)))
(gnus-topic-sort-topic (pop alist) func reverse))))
(defun gnus-topic-sort-topic (topic func reverse)
(if (fboundp 'point-at-bol)
(fset 'gnus-point-at-bol 'point-at-bol)
- (defsubst gnus-point-at-bol ()
+ (defun gnus-point-at-bol ()
"Return point at the beginning of the line."
(let ((p (point)))
(beginning-of-line)
(if (fboundp 'point-at-eol)
(fset 'gnus-point-at-eol 'point-at-eol)
- (defsubst gnus-point-at-eol ()
+ (defun gnus-point-at-eol ()
"Return point at the end of the line."
(let ((p (point)))
(end-of-line)
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "5.4.9"
+(defconst gnus-version-number "5.4.10"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Gnus v%s" gnus-version-number)
(defcustom gnus-mode-non-string-length nil
"*Max length of mode-line non-string contents.
If this is nil, Gnus will take space as is needed, leaving the rest
-of the modeline intact."
+of the modeline intact. Note that the default of nil is unlikely
+to be desirable; see the manual for further details."
:group 'gnus-various
:type '(choice (const nil)
integer))
;; "hello", and the select method is ("hello" (my-var "something"))
;; in the group "alt.alt", this will result in a new virtual server
;; called "hello+alt.alt".
- (let ((entry
- (gnus-copy-sequence
- (if (gnus-server-equal method gnus-select-method) gnus-select-method
- (cdr (assoc (car method) gnus-server-alist))))))
- (if (not entry)
- method
- (setcar (cdr entry) (concat (nth 1 entry) "+" group))
- (nconc entry (cdr method)))))
+ (if (or (not (gnus-similar-server-opened method))
+ (not (cddr method)))
+ method
+ `(,(car method) ,(concat (cadr method) "+" group)
+ (,(intern (format "%s-address" (car method))) ,(cadr method))
+ ,@(cddr method))))
+
+(defun gnus-similar-server-opened (method)
+ (let ((opened gnus-opened-servers))
+ (while (and method opened)
+ (when (and (equal (cadr method) (cadaar opened))
+ (not (equal method (caar opened))))
+ (setq method nil))
+ (pop opened))
+ (not method)))
(defun gnus-server-status (method)
"Return the status of METHOD."
(setq method
(cond ((stringp method)
(gnus-server-to-method method))
- ((stringp (car method))
+ ((stringp (cadr method))
(gnus-server-extend-method group method))
(t
method)))
;; Shut up.
-(defvar byte-compile-default-warnings)
-
(defun maybe-fbind (args)
(while args
(or (fboundp (car args))
(progn
(defvar track-mouse nil)
(maybe-fbind '(posn-point event-start x-popup-menu
- error-message-string facemenu-get-face window-at
+ facemenu-get-face window-at
coordinates-in-window-p compute-motion
x-defined-colors easy-menu-create-keymaps))
;; XEmacs thinks writting compatible code is obsolete.
device-class get-popup-menu-response event-object
x-defined-colors read-color add-submenu set-font-family
font-create-object set-font-size frame-device find-face
- set-extent-property make-extent)))
+ set-extent-property make-extent characterp display-error)))
(setq load-path (cons "." load-path))
(require 'custom)
(defcustom message-fcc-handler-function 'message-output
"*A function called to save outgoing articles.
This function will be called with the name of the file to store the
-article in. The default function is `rmail-output' which saves in Unix
+article in. The default function is `message-output' which saves in Unix
mailbox format."
- :type '(radio (function-item rmail-output)
+ :type '(radio (function-item message-output)
(function :tag "Other"))
:group 'message-sending)
(setq file (expand-file-name file))
(unless (file-exists-p (file-name-directory file))
(make-directory (file-name-directory file) t))
- (funcall message-fcc-handler-function file)))
+ (if (and message-fcc-handler-function
+ (not (eq message-fcc-handler-function 'rmail-output)))
+ (funcall message-fcc-handler-function file)
+ (if (and (file-readable-p file) (mail-file-babyl-p file))
+ (rmail-output file 1 nil t)
+ (let ((mail-use-rfc822 t))
+ (rmail-output file 1 t t))))))
(kill-buffer (current-buffer)))))
(when (file-exists-p newsrc-file)
(load newsrc-file))
(nnheader-temp-write nov-file
- (insert-file-contents nov-file)
+ (when (file-exists-p nov-file)
+ (insert-file-contents nov-file))
(setq nov-buffer (current-buffer))
;; Go through the active hashtb and add new all groups that match the
;; kiboze regexp.
(t
(nnheader-report 'nnml "Article %s retrieved" id)
;; We return the article number.
- (cons group (string-to-int (file-name-nondirectory path)))))))
+ (cons (if group-num (car group-num) group)
+ (string-to-int (file-name-nondirectory path)))))))
(deffoo nnml-request-group (group &optional server dont-check)
(cond
(set-extent-property ext 'start-open t)
(set-extent-property ext 'invisible t)
(set-extent-property ext 'keymap smiley-map)
- (set-extent-property ext 'mouse-face 'smiley-mouse-face)
+ (set-extent-property ext 'mouse-face smiley-mouse-face)
(set-extent-property ext 'intangible t)
;; set annotation params
- (set-extent-property ant 'mouse-face 'smiley-mouse-face)
+ (set-extent-property ant 'mouse-face smiley-mouse-face)
(set-extent-property ant 'keymap smiley-map)
;; remember each other
(set-extent-property ant 'smiley-extent ext)
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
-;; Version: 1.20
+;; Version: 1.24
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
"Convert an error value to an error message."
(let ((buf (get-buffer-create " *error-message*")))
(erase-buffer buf)
- (funcall (intern "display-error") obj buf)
+ (display-error obj buf)
(buffer-string buf))))
;;; Customization.
(defun widget-specify-field-update (widget from to)
;; Specify editable button for WIDGET between FROM and TO.
- (let ((map (or (widget-get widget :keymap)
- widget-keymap))
+ (let ((map (widget-get widget :keymap))
+ (secret (widget-get widget :secret))
+ (secret-to to)
+ (size (widget-get widget :size))
(face (or (widget-get widget :value-face)
'widget-field-face)))
+
+ (when secret
+ (while (and size
+ (not (zerop size))
+ (> secret-to from)
+ (eq (char-after (1- secret-to)) ?\ ))
+ (setq secret-to (1- secret-to)))
+
+ (save-excursion
+ (goto-char from)
+ (while (< (point) secret-to)
+ (let ((old (get-text-property (point) 'secret)))
+ (when old
+ (subst-char-in-region (point) (1+ (point)) secret old)))
+ (forward-char))))
+
(set-text-properties from to (list 'field widget
'read-only nil
'keymap map
'local-map map
'face face))
+
+ (when secret
+ (save-excursion
+ (goto-char from)
+ (while (< (point) secret-to)
+ (let ((old (following-char)))
+ (subst-char-in-region (point) (1+ (point)) old secret)
+ (put-text-property (point) (1+ (point)) 'secret old))
+ (forward-char))))
+
(unless (widget-get widget :size)
(add-text-properties to (1+ to) (list 'field widget
'face face
"Keymap containing useful binding for buffers containing widgets.
Recommended as a parent keymap for modes using widgets.")
-(if widget-keymap
- ()
+(unless widget-keymap
(setq widget-keymap (make-sparse-keymap))
- (set-keymap-parent widget-keymap global-map)
(define-key widget-keymap "\t" 'widget-forward)
(define-key widget-keymap "\M-\t" 'widget-backward)
(define-key widget-keymap [(shift tab)] 'widget-backward)
"Keymap used for events the widget does not handle themselves.")
(make-variable-buffer-local 'widget-global-map)
+(defvar widget-field-keymap nil
+ "Keymap used inside an editable field.")
+
+(unless widget-field-keymap
+ (setq widget-field-keymap (copy-keymap widget-keymap))
+ (define-key widget-field-keymap "\C-m" 'widget-field-activate)
+ (set-keymap-parent widget-field-keymap global-map))
+
+(defvar widget-text-keymap nil
+ "Keymap used inside a text field.")
+
+(unless widget-text-keymap
+ (setq widget-text-keymap (copy-keymap widget-keymap))
+ (set-keymap-parent widget-text-keymap global-map))
+
+(defun widget-field-activate (pos &optional event)
+ "Activate the ediable field at point."
+ (interactive "@d")
+ (let* ((field (get-text-property pos 'field)))
+ (if field
+ (widget-apply field :action event)
+ (call-interactively
+ (lookup-key widget-global-map (this-command-keys))))))
+
(defun widget-button-click (event)
"Activate button below mouse pointer."
(interactive "@e")
(define-widget 'editable-field 'default
"An editable text field."
:convert-widget 'widget-item-convert-widget
+ :keymap widget-field-keymap
:format "%v"
:value ""
:action 'widget-field-action
+ :validate 'widget-field-validate
+ :valid-regexp ""
+ :error "No match"
:value-create 'widget-field-value-create
:value-delete 'widget-field-value-delete
:value-get 'widget-field-value-get
(widget-apply widget :notify widget event)
(widget-setup)))
+(defun widget-field-validate (widget)
+ ;; Valid if the content matches `:valid-regexp'.
+ (save-excursion
+ (let ((value (widget-apply widget :value-get))
+ (regexp (widget-get widget :valid-regexp)))
+ (if (string-match regexp value)
+ nil
+ widget))))
+
(defun widget-field-value-create (widget)
;; Create an editable text field.
(insert " ")
(defun widget-field-value-delete (widget)
;; Remove the widget from the list of active editing fields.
(setq widget-field-list (delq widget widget-field-list))
- (set-marker (widget-get widget :value-from) nil)
- (set-marker (widget-get widget :value-to) nil))
+ ;; These are nil if the :format string doesn't contain `%v'.
+ (when (widget-get widget :value-from)
+ (set-marker (widget-get widget :value-from) nil))
+ (when (widget-get widget :value-from)
+ (set-marker (widget-get widget :value-to) nil)))
(defun widget-field-value-get (widget)
;; Return current text in editing field.
(let ((from (widget-get widget :value-from))
(to (widget-get widget :value-to))
(size (widget-get widget :size))
+ (secret (widget-get widget :secret))
(old (current-buffer)))
(if (and from to)
(progn
(> to from)
(eq (char-after (1- to)) ?\ ))
(setq to (1- to)))
- (prog1 (buffer-substring-no-properties from to)
- (set-buffer old)))
+ (let ((result (buffer-substring-no-properties from to)))
+ (when secret
+ (let ((index 0))
+ (while (< (+ from index) to)
+ (aset result index
+ (get-text-property (+ from index) 'secret))
+ (setq index (1+ index)))))
+ (set-buffer old)
+ result))
(widget-get widget :value))))
(defun widget-field-match (widget value)
;;; The `text' Widget.
(define-widget 'text 'editable-field
+ :keymap widget-text-keymap
"A multiline text area.")
;;; The `menu-choice' Widget.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, extensions, faces, hypermedia
-;; Version: 1.20
+;; Version: 1.24
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(set (car keywords) (car keywords)))
(setq keywords (cdr keywords)))))))
-(define-widget-keywords :sample-face :sample-face-get :case-fold
- :widget-doc
+(define-widget-keywords :valid-regexp
+ :secret :sample-face :sample-face-get :case-fold :widget-doc
:create :convert-widget :format :value-create :offset :extra-offset
:tag :doc :from :to :args :value :value-from :value-to :action
:value-set :value-delete :match :parent :delete :menu-tag-get
+Mon Feb 3 07:31:47 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Mode Lines): Addition.
+
Mon Jan 27 17:51:29 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* gnus.texi (Highlighting and Menus): Removed
@comment node-name, next, previous, up
@top The Customization Library
-Version: 1.20
+Version: 1.24
@menu
* Introduction::
@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}.
+
+Ditto for @code{kill-emacs-query-functions}.
+
+@item
+Command to check if there are any customization options that
+does not belong to an existing group.
+
@end itemize
@contents
If this variable is @code{nil} (which is the default), the mode line
strings won't be chopped off, and they won't be padded either.
+Note that the default is unlikely to be desirable, as even the
+percentage complete in the buffer may be crowded off the mode line;
+the user should configure this variable appropriately for their
+configuration.
@node Highlighting and Menus
\input texinfo.tex
-@c $Id: widget.texi,v 1.2 1997/01/26 19:51:51 steve Exp $
+@c $Id: widget.texi,v 1.3 1997/02/03 18:09:45 steve Exp $
@c %**start of header
@setfilename widget
@comment node-name, next, previous, up
@top The Emacs Widget Library
-Version: 1.20
+Version: 1.24
@menu
* Introduction::
Face used for highlighting the editable field. Default is
@code{widget-field-face}.
+@item :secret
+Character used to display the value. You can set this to e.g. @code{?*}
+if the field contains a password or other secret information. By
+default, the value is not secret.
+
+@item :valid-regexp
+By default the @code{:validate} function will match the content of the
+field with the value of this attribute. The default value is @code{""}
+which matches everything.
+
@item :keymap
-Keymap used in the editable field. @code{widget-keymap} will allow you
-to use normal editing commands, even if these has been suppressed in the
-current buffer.
+Keymap used in the editable field. The default value is
+@code{widget-field-keymap}, which allows you to use all the normal
+editing commands, even if the buffers major mode supress some of them.
+Pressing return activates the function specified by @code{:activate}.
@item :hide-front-space
@itemx :hide-rear-space
@subsection The @code{text} Widget
This is just like @code{editable-field}, but intended for multiline text
-fields.
+fields. The default @code{:keymap} is @code{widget-text-keymap}, which
+does not rebind the return key.
@node menu-choice, radio-button-choice, text, Basic Types
@comment node-name, next, previous, up
projects / gnus / commitdiff