Mercurial > emacs
view lisp/mh-e/mh-acros.el @ 60092:04686828d0da
2004-11-08 Benjamin Riefenstahl <Benjamin.Riefenstahl@epost.de>
* w32select.c: Summary: Thorough rework to implement Unicode
clipboard operations and delayed rendering.
Drop last_clipboard_text and related code, keep track of
ownership via clipboard_owner instead. Drop old #if0
sections.
(DEFAULT_LCID, ANSICP, OEMCP, QUNICODE, QANSICP, QOEMCP)
(clipboard_owner, modifying_clipboard, cfg_coding_system)
(cfg_codepage, cfg_lcid, cfg_clipboard_type, current_text)
(current_coding_system, current_requires_encoding)
(current_num_nls, current_clipboard_type, current_lcid): New
static variables.
(convert_to_handle_as_ascii, convert_to_handle_as_coded)
(render, render_all, run_protected, lisp_error_handler)
(owner_callback, create_owner, setup_config)
(enum_locale_callback, cp_from_locale, coding_from_cp): New
local functions.
(term_w32select, globals_of_w32select): New global functions.
(Fw32_set_clipboard_data): Ignore parameter FRAME, use
clipboard_owner instead. Use delayed rendering and provide
all text formats. Provide CF_LOCALE if necessary.
(Fw32_get_clipboard_data): Handle CF_UNICODETEXT and
CF_LOCALE. Fall back to CF_TEXT, if CF_UNICODETEXT is not
available. Force DOS line-ends for decoding.
(Fx_selection_exists_p): Handle CF_UNICODETEXT.
(syms_of_w32select): Init and register new variables.
* w32.h: Add prototypes for globals_of_w32select and
term_w32select. Make the neighboring K&R declarations into
prototypes, too.
* emacs.c: Include w32.h to get function prototypes.
(main): Call globals_of_w32select.
* w32.c (term_ntproc): Call term_w32select.
* mule-cmds.el (set-locale-environment): Remove call to
set-selection-coding-system on Windows.
* s/ms-w32.h: Guard MSC-specific #pragmas with an #ifdef.
author | Jason Rumney <jasonr@gnu.org> |
---|---|
date | Tue, 15 Feb 2005 23:19:26 +0000 |
parents | 25da1d331c99 |
children | 4f4f410e6fe8 |
line wrap: on
line source
;;; mh-acros.el --- Macros used in MH-E ;; Copyright (C) 2004 Free Software Foundation, Inc. ;; Author: Satyaki Das <satyaki@theforce.stanford.edu> ;; Maintainer: Bill Wohler <wohler@newt.com> ;; Keywords: mail ;; See: mh-e.el ;; 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: ;; This file contains macros that would normally be in mh-utils.el except that ;; their presence there would cause a dependency loop with mh-customize.el. ;; This file must always be included like this: ;; ;; (eval-when-compile (require 'mh-acros)) ;; ;; It is so named with a silent `m' so that it is compiled first. Otherwise, ;; "make recompile" in Emacs 21.4 fails. ;;; Change Log: ;;; Code: (require 'cl) ;; The Emacs coding conventions require that the cl package not be required at ;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl ;; routines in their macro expansions. Use mh-require-cl to provide the cl ;; routines in the best way possible. (defmacro mh-require-cl () "Macro to load `cl' if needed. Some versions of `cl' produce code for the expansion of \(setf (gethash ...) ...) that uses functions in `cl' at run time. This macro recognizes that and loads `cl' where appropriate." (if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash) `(require 'cl) `(eval-when-compile (require 'cl)))) ;;; Macros to generate correct code for different emacs variants (defmacro mh-do-in-gnu-emacs (&rest body) "Execute BODY if in GNU Emacs." (unless (featurep 'xemacs) `(progn ,@body))) (put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun) (defmacro mh-do-in-xemacs (&rest body) "Execute BODY if in GNU Emacs." (when (featurep 'xemacs) `(progn ,@body))) (put 'mh-do-in-xemacs 'lisp-indent-hook 'defun) (defmacro mh-funcall-if-exists (function &rest args) "Call FUNCTION with ARGS as parameters if it exists." (if (fboundp function) `(funcall ',function ,@args))) (defmacro mh-make-local-hook (hook) "Make HOOK local if needed. XEmacs and versions of GNU Emacs before 21.1 require `make-local-hook' to be called." (when (and (fboundp 'make-local-hook) (not (get 'make-local-hook 'byte-obsolete-info))) `(make-local-hook ,hook))) (defmacro mh-mark-active-p (check-transient-mark-mode-flag) "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs. In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if variable `transient-mark-mode' is active." (cond ((featurep 'xemacs) ;XEmacs `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p))) ((not check-transient-mark-mode-flag) ;GNU Emacs `(and (boundp 'mark-active) mark-active)) (t ;GNU Emacs `(and (boundp 'transient-mark-mode) transient-mark-mode (boundp 'mark-active) mark-active)))) (defmacro mh-defstruct (name-spec &rest fields) "Replacement for `defstruct' from the `cl' package. The `defstruct' in the `cl' library produces compiler warnings, and generates code that uses functions present in `cl' at run-time. This is a partial replacement, that avoids these issues. NAME-SPEC declares the name of the structure, while FIELDS describes the various structure fields. Lookup `defstruct' for more details." (let* ((struct-name (if (atom name-spec) name-spec (car name-spec))) (conc-name (or (and (consp name-spec) (cadr (assoc :conc-name (cdr name-spec)))) (format "%s-" struct-name))) (predicate (intern (format "%s-p" struct-name))) (constructor (or (and (consp name-spec) (cadr (assoc :constructor (cdr name-spec)))) (intern (format "make-%s" struct-name)))) (field-names (mapcar #'(lambda (x) (if (atom x) x (car x))) fields)) (field-init-forms (mapcar #'(lambda (x) (and (consp x) (cadr x))) fields)) (struct (gensym "S")) (x (gensym "X")) (y (gensym "Y"))) `(progn (defun* ,constructor (&key ,@(mapcar* #'(lambda (x y) (list x y)) field-names field-init-forms)) (list (quote ,struct-name) ,@field-names)) (defun ,predicate (arg) (and (consp arg) (eq (car arg) (quote ,struct-name)))) ,@(loop for x from 1 for y in field-names collect `(defmacro ,(intern (format "%s%s" conc-name y)) (z) (list 'nth ,x z))) (quote ,struct-name)))) (defadvice require (around mh-prefer-el activate) "Modify `require' to load uncompiled MH-E files." (or (featurep (ad-get-arg 0)) (and (string-match "^mh-" (symbol-name (ad-get-arg 0))) (load (format "%s.el" (ad-get-arg 0)) t t)) ad-do-it)) (provide 'mh-acros) ;;; Local Variables: ;;; no-byte-compile: t ;;; indent-tabs-mode: nil ;;; sentence-end-double-space: nil ;;; End: ;; arch-tag: b383b49a-494f-4ed0-a30a-cb6d5d2da4ff ;;; mh-acros.el ends here