Mercurial > emacs
view lisp/mail/rmailsort.el @ 59146:9bde7721ad0f
* dispextern.h: Change HAVE_CARBON to MAC_OS.
(struct glyph_string): Likewise.
* emacs.c (main) [MAC_OS8]: Call mac_term_init instead of
mac_initialize.
* fileio.c (Fnext_read_file_uses_dialog_p, Fread_file_name):
Change TARGET_API_MAC_CARBON to HAVE_CARBON.
* fns.c (vector): Change MAC_OSX to MAC_OS.
* frame.c (x_set_frame_parameters, x_report_frame_params)
(x_set_fullscreen): Remove #ifndef HAVE_CARBON.
(x_set_border_width, Vdefault_frame_scroll_bars): Change
HAVE_CARBON to MAC_OS.
* image.c [MAC_OS]: Include sys/stat.h.
[MAC_OS && !MAC_OSX]: Include sys/param.h, ImageCompression.h, and
QuickTimeComponents.h.
* mac.c [!MAC_OSX] (mac_wait_next_event): Add extern.
[!MAC_OSX] (select): Use mac_wait_next_event.
[!MAC_OSX] (run_mac_command): Change EXEC_SUFFIXES to
Vexec_suffixes.
[!MAC_OSX] (select, run_mac_command): Change `#ifdef
TARGET_API_MAC_CARBON' to `#if TARGET_API_MAC_CARBON'.
(mac_clear_font_name_table): Add extern.
(Fmac_clear_font_name_table): New defun.
(syms_of_mac): Defsubr it.
[MAC_OSX] (SELECT_POLLING_PERIOD_USEC): New define.
[MAC_OSX] (select_and_poll_event): New function.
[MAC_OSX] (sys_select): Use it.
[MAC_OSX && SELECT_USE_CFSOCKET] (socket_callback): New function.
[MAC_OSX && SELECT_USE_CFSOCKET]
(SELECT_TIMEOUT_THRESHOLD_RUNLOOP, EVENT_CLASS_SOCK): New defines.
[MAC_OSX] (sys_select) [SELECT_USE_CFSOCKET]: Use CFSocket and
RunLoop for simultaneously monitoring two kinds of inputs, window
events and process outputs, without periodically polling.
* macfns.c (mac_initialized): Remove extern.
(stricmp): Put in #if 0. All callers changed to use xstricmp in
xfaces.c.
(strnicmp): Decrement `n' at the end of each loop, not the
beginning.
(check_mac): Use the term "Mac native windows" instead of "Mac
OS".
(check_x_display_info, x_display_info_for_name): Sync with xfns.c.
(mac_get_rdb_resource): New function (from w32reg.c).
(x_get_string_resource): Use it.
(install_window_handler): Add extern.
(mac_window): New function.
(Fx_create_frame): Use it instead of make_mac_frame. Set
parameter for Qfullscreen. Call x_wm_set_size_hint.
(Fx_open_connection, Fx_close_connection): New defuns.
(syms_of_macfns): Defsubr them.
(x_create_tip_frame) [TARGET_API_MAC_CARBON]: Add
kWindowNoUpdatesAttribute to the window attribute.
(x_create_tip_frame) [!TARGET_API_MAC_CARBON]: Use NewCWindow.
(x_create_tip_frame): Don't call ShowWindow.
(Fx_show_tip): Call ShowWindow.
(Fx_file_dialog): Change `#ifdef TARGET_API_MAC_CARBON' to `#if
TARGET_API_MAC_CARBON'.
(mac_frame_parm_handlers): Set handlers for Qfullscreen.
(syms_of_macfns) [MAC_OSX]: Initialize mac_in_use to 0.
* macgui.h [!MAC_OSX]: Don't include Controls.h. Include
Windows.h.
(Window): Typedef to WindowPtr and move outside `#if
TARGET_API_MAC_CARBON'.
(XSizeHints): New struct.
* macterm.c (x_update_begin, x_update_end)
[TARGET_API_MAC_CARBON]: Disable screen updates during update of a
frame.
(x_draw_glyph_string_background, x_draw_glyph_string_foreground)
[MAC_OS8]: Use XDrawImageString/XDrawImageString16.
(construct_mouse_click): Put in #if 0.
(x_check_fullscreen, x_check_fullscreen_move): Remove decls.
(x_scroll_bar_create, x_scroll_bar_handle_click): Change `#ifdef
TARGET_API_MAC_CARBON' to `#if TARGET_API_MAC_CARBON'.
(activate_scroll_bars, deactivate_scroll_bars)
[!TARGET_API_MAC_CARBON]: Use ActivateControl/DeactivateControl.
(x_make_frame_visible) [TARGET_API_MAC_CARBON]: Reposition window
if the position is neither user-specified nor program-specified.
(x_free_frame_resources): Free size_hints.
(x_wm_set_size_hint): Allocate size_hints if needed. Set
size_hints.
(mac_clear_font_name_table): New function.
(mac_do_list_fonts): Initialize font_name_table if needed.
(x_list_fonts): Don't initialize font_name_table. Add BLOCK_INPUT
around mac_do_list_fonts.
(mac_unload_font): New function.
(x_load_font): Add BLOCK_INPUT around XLoadQueryFont.
(init_mac_drag_n_drop, mac_do_receive_drag): Enclose declarations
and definitions with #if TARGET_API_MAC_CARBON.
[USE_CARBON_EVENTS] (mac_handle_window_event): Add decl.
(install_window_handler): Add decl.
(do_window_update): Add BeginUpdate/EndUpdate for the tooltip
window. Use UpdateControls. Get the rectangle that should be
updated and restrict the target of expose_frame to it.
(do_grow_window): Set minimum height/width according to
size_hints.
(do_grow_window) [TARGET_API_MAC_CARBON]: Use ResizeWindow.
(do_zoom_window): Don't use x_set_window_size.
[USE_CARBON_EVENTS] (mac_handle_window_event): New function.
(install_window_handler): New function.
[!USE_CARBON_EVENTS] (mouse_region): New variable.
[!USE_CARBON_EVENTS] (mac_wait_next_event): New function.
(XTread_socket) [USE_CARBON_EVENTS]: Move call to
GetEventDispatcherTarget inside BLOCK_INPUT.
(XTread_socket) [!USE_CARBON_EVENTS]: Use mac_wait_next_event.
Update mouse_region when mouse is moved.
(make_mac_frame): Remove.
(make_mac_terminal_frame): Put in #ifdef MAC_OS8. Initialize
mouse pointer shapes. Change values of f->left_pos and
f->top_pos. Don't use make_mac_frame. Use NewCWindow. Don't
call ShowWindow.
(mac_initialize_display_info) [MAC_OSX]: Create mac_id_name from
Vinvocation_name and Vsystem_name.
(mac_make_rdb): New function (from w32term.c).
(mac_term_init): Use it. Add BLOCK_INPUT. Error if display has
already been opened. Don't pass argument to
mac_initialize_display_info. Don't set dpyinfo->height/width.
Add entries to x_display_list and x_display_name_list.
(x_delete_display): New function.
(mac_initialize): Don't call mac_initialize_display_info.
(syms_of_macterm) [!MAC_OSX]: Don't call Fprovide.
* macterm.h (check_mac): Add extern.
(struct mac_output): New member size_hints.
(FRAME_SIZE_HINTS): New macro.
(mac_unload_font): Add extern.
* xdisp.c (expose_window, expose_frame): Remove kludges for Mac.
* xfaces.c (clear_font_table) [MAC_OS]: call mac_unload_font.
author | Steven Tamm <steventamm@mac.com> |
---|---|
date | Mon, 27 Dec 2004 17:27:30 +0000 |
parents | 695cf19ef79e |
children | 18a818a2ee7c 375f2633d815 |
line wrap: on
line source
;;; rmailsort.el --- Rmail: sort messages ;; Copyright (C) 1990, 1993, 1994, 2001 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp> ;; Maintainer: FSF ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;;; Code: (require 'sort) ;; For rmail-select-summary (require 'rmail) (autoload 'timezone-make-date-sortable "timezone") ;; Sorting messages in Rmail buffer ;;;###autoload (defun rmail-sort-by-date (reverse) "Sort messages of current Rmail file by date. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-messages reverse (function (lambda (msg) (rmail-make-date-sortable (rmail-fetch-field msg "Date")))))) ;;;###autoload (defun rmail-sort-by-subject (reverse) "Sort messages of current Rmail file by subject. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-messages reverse (function (lambda (msg) (let ((key (or (rmail-fetch-field msg "Subject") "")) (case-fold-search t)) ;; Remove `Re:' (if (string-match "^\\(re:[ \t]*\\)*" key) (substring key (match-end 0)) key)))))) ;;;###autoload (defun rmail-sort-by-author (reverse) "Sort messages of current Rmail file by author. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-messages reverse (function (lambda (msg) (downcase ;Canonical name (mail-strip-quoted-names (or (rmail-fetch-field msg "From") (rmail-fetch-field msg "Sender") ""))))))) ;;;###autoload (defun rmail-sort-by-recipient (reverse) "Sort messages of current Rmail file by recipient. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-messages reverse (function (lambda (msg) (downcase ;Canonical name (mail-strip-quoted-names (or (rmail-fetch-field msg "To") (rmail-fetch-field msg "Apparently-To") "") )))))) ;;;###autoload (defun rmail-sort-by-correspondent (reverse) "Sort messages of current Rmail file by other correspondent. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-messages reverse (function (lambda (msg) (rmail-select-correspondent msg '("From" "Sender" "To" "Apparently-To")))))) (defun rmail-select-correspondent (msg fields) (let ((ans "")) (while (and fields (string= ans "")) (setq ans (rmail-dont-reply-to (mail-strip-quoted-names (or (rmail-fetch-field msg (car fields)) "")))) (setq fields (cdr fields))) ans)) ;;;###autoload (defun rmail-sort-by-lines (reverse) "Sort messages of current Rmail file by number of lines. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-messages reverse (function (lambda (msg) (count-lines (rmail-msgbeg msg) (rmail-msgend msg)))))) ;;;###autoload (defun rmail-sort-by-labels (reverse labels) "Sort messages of current Rmail file by labels. If prefix argument REVERSE is non-nil, sort them in reverse order. KEYWORDS is a comma-separated list of labels." (interactive "P\nsSort by labels: ") (or (string-match "[^ \t]" labels) (error "No labels specified")) (setq labels (concat (substring labels (match-beginning 0)) ",")) (let (labelvec) (while (string-match "[ \t]*,[ \t]*" labels) (setq labelvec (cons (concat ", ?\\(" (substring labels 0 (match-beginning 0)) "\\),") labelvec)) (setq labels (substring labels (match-end 0)))) (setq labelvec (apply 'vector (nreverse labelvec))) (rmail-sort-messages reverse (function (lambda (msg) (let ((n 0)) (while (and (< n (length labelvec)) (not (rmail-message-labels-p msg (aref labelvec n)))) (setq n (1+ n))) n)))))) ;; Basic functions (defun rmail-sort-messages (reverse keyfun) "Sort messages of current Rmail file. If 1st argument REVERSE is non-nil, sort them in reverse order. 2nd argument KEYFUN is called with a message number, and should return a key." (save-current-buffer ;; If we are in a summary buffer, operate on the Rmail buffer. (if (eq major-mode 'rmail-summary-mode) (set-buffer rmail-buffer)) (let ((buffer-read-only nil) (point-offset (- (point) (point-min))) (predicate nil) ;< or string-lessp (sort-lists nil)) (message "Finding sort keys...") (widen) (let ((msgnum 1)) (while (>= rmail-total-messages msgnum) (setq sort-lists (cons (list (funcall keyfun msgnum) ;Make sorting key (eq rmail-current-message msgnum) ;True if current (aref rmail-message-vector msgnum) (aref rmail-message-vector (1+ msgnum))) sort-lists)) (if (zerop (% msgnum 10)) (message "Finding sort keys...%d" msgnum)) (setq msgnum (1+ msgnum)))) (or reverse (setq sort-lists (nreverse sort-lists))) ;; Decide predicate: < or string-lessp (if (numberp (car (car sort-lists))) ;Is a key numeric? (setq predicate (function <)) (setq predicate (function string-lessp))) (setq sort-lists (sort sort-lists (function (lambda (a b) (funcall predicate (car a) (car b)))))) (if reverse (setq sort-lists (nreverse sort-lists))) ;; Now we enter critical region. So, keyboard quit is disabled. (message "Reordering messages...") (let ((inhibit-quit t) ;Inhibit quit (current-message nil) (msgnum 1) (msginfo nil)) ;; There's little hope that we can easily undo after that. (buffer-disable-undo (current-buffer)) (goto-char (rmail-msgbeg 1)) ;; To force update of all markers. (insert-before-markers ?Z) (backward-char 1) ;; Now reorder messages. (while sort-lists (setq msginfo (car sort-lists)) ;; Swap two messages. (insert-buffer-substring (current-buffer) (nth 2 msginfo) (nth 3 msginfo)) (delete-region (nth 2 msginfo) (nth 3 msginfo)) ;; Is current message? (if (nth 1 msginfo) (setq current-message msgnum)) (setq sort-lists (cdr sort-lists)) (if (zerop (% msgnum 10)) (message "Reordering messages...%d" msgnum)) (setq msgnum (1+ msgnum))) ;; Delete the garbage inserted before. (delete-char 1) (setq quit-flag nil) (buffer-enable-undo) (rmail-set-message-counters) (rmail-show-message current-message) (goto-char (+ point-offset (point-min))) (if (rmail-summary-exists) (rmail-select-summary (rmail-update-summary))))))) (defun rmail-fetch-field (msg field) "Return the value of the header FIELD of MSG. Arguments are MSG and FIELD." (save-restriction (widen) (let ((next (rmail-msgend msg))) (goto-char (rmail-msgbeg msg)) (narrow-to-region (if (search-forward "\n*** EOOH ***\n" next t) (point) (forward-line 1) (point)) (progn (search-forward "\n\n" nil t) (point))) (mail-fetch-field field)))) (defun rmail-make-date-sortable (date) "Make DATE sortable using the function string-lessp." ;; Assume the default time zone is GMT. (timezone-make-date-sortable date "GMT" "GMT")) (provide 'rmailsort) ;;; arch-tag: 0d90896b-0c35-46ac-b240-38be5ada2360 ;;; rmailsort.el ends here