Mercurial > emacs
view vms/make-mms-derivative.el @ 94938:5752d7154afc
Throughout the file, delete all USE_FONT_BACKEND
conditionals. Don't check enable_font_backend. Delete all codes
used only when USE_FONT_BACKEND is not defined. Use
FONT_XXX_NAME_NUMERIC instead of face_numeric_xxx.
(QCfoundry, QCadstyle, QCregistry, QCspacing, QCsize, QCavgwidth)
(Qp): Extern them.
(clear_font_table, load_face_font, xlfd_lookup_field_contents):
Deleted.
(struct font_name): Deleted.
(xlfd_numeric_value, xlfd_symbolic_value): Deleted.
(compare_fonts_by_sort_order): New function.
(xlfd_numeric_slant, xlfd_symbolic_slant, xlfd_numeric_weight)
(xlfd_symbolic_weight, xlfd_numeric_swidth, xlfd_symbolic_swidth):
Deleted.
(Fx_family_fonts): Use font_list_entities, and sort fonts by
compare_fonts_by_sort_order.
(Fx_font_family_list): Call Ffont_family_list.
(face_numeric_value, face_numeric_weight, face_numeric_slant)
(face_numeric_swidth, face_symbolic_value, face_symbolic_weight)
(face_symbolic_slant, face_symbolic_swidth)
(split_font_name_into_vector, build_font_name_from_vector)
(xlfd_fixed_p, xlfd_point_size, pixel_point_size)
(font_rescale_ratio, split_font_name, build_font_name)
(free_font_names, sort_fonts, x_face_list_fonts)
(face_font_available_p, sorted_font_list, cmp_font_names)
(font_list_1, concat_font_list, font_list, remove_duplicates):
Deleted.
(Fx_list_fonts): Use Ffont_list.
(LFACE_AVGWIDTH): Deleted.
(check_lface_attrs): Don't check LFACE_AVGWIDTH. Check LFACE_FONT
by FONTP.
(lface_fully_specified_p): Don't check LFACE_AVGWIDTH.
(set_lface_from_font_name): Delete it.
(set_lface_from_font): Renamed from
set_lface_from_font_and_fontset. Caller changed. Don't set
LFACE_AVGWIDTH. Use FONT_XXX_FOR_FACE to get a symbol suitable
for face.
(merge_face_vectors): Copy font-spec if necessary. Clear
properties of the font-spec if necessary.
(merge_face_ref): Clear properties of the font-spec if necessary.
(Finternal_set_lisp_face_attribute): Likewise.
(set_font_frame_param): Use font_load_for_lface to load a
font-object, and call Fmodify_frame_parameters with it.
(x_update_menu_appearance): Don't check LFACE_AVGWIDTH. Get XLFD
font name by Ffont_xlfd_name.
(Finternal_lisp_face_attribute_values): Don't check QCweight,
QCslant, and QCwidth.
(Fface_font): Get a font name from font->props[FONT_NAME_INDEX].
(lface_same_font_attributes_p): Don't check LFACE_AVGWIDTH.
Compare fonts by EQ.
(lookup_non_ascii_face): Deleted.
(face_for_font): The 2nd argument changed.
(x_supports_face_attributes_p): Don't check LFACE_AVGWIDTH. Check
atomic font properties by case insensitive.
(realize_non_ascii_face): Set face->overstrike correctly.
(realize_x_face): Likewise. Check if LFACE_FONT is a font_object.
(dump_realized_face): Get font name from
font->props[FONT_NAME_INDEX]. Don't print font_info_id.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Wed, 14 May 2008 01:41:52 +0000 |
parents | 2281719c874d |
children |
line wrap: on
line source
;;; make-mms-derivative.el --- framework to do horrible things for VMS support ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 ;; Free Software Foundation, Inc. ;; Author: Thien-Thi Nguyen <ttn@gnu.org> ;; Keywords: maint build vms mms makefile levitte autoconf war-is-a-lose ;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: ;; Under VMS the standard make-like program is called MMS, which looks ;; for an input file in the default directory named DESCRIP.MMS and runs ;; the DCL command rules therein. As of 2005, the build process ;; requires a hand translation of the Makefile.in and Emacs-specific ;; methodology to DCL and TPU commands, so to alleviate this pain, we ;; provide `make-mms-derivative', which given a source FILENAME, inserts ;; the file contents in a new buffer and loads FILENAME-2mms. The lisp ;; code in the -2mms file can (do whatever -- it's emacs -- and), as ;; long as it arranges to write out the modified buffer after loading by ;; specifying, on a line of its own, the directive: ;; ;; :output RELATIVE-OUTPUT ;; ;; where RELATIVE-OUTPUT is a filename (a string) relative to FILENAME's ;; directory, typically something simple like "descrip.mms_in_in". Only ;; the first :output directive is recognized. ;; ;; The only other special directive at this time has the form: ;; ;; :gigo NAME ;; ;;blah blah blah ;; ;;(more text here) ;; ;; NAME is anything distinguishable w/ `eq' (number, symbol or keyword). ;; This associates NAME with the block of text starting immediately below ;; the :gigo directive and ending at the first line that does not begin ;; with two semicolons (which are stripped from each line in the block). ;; To insert this block of text, pass NAME to `make-mms-derivative-gigo'. ;; ;; Directives are scanned before normal evaluation, so their placement ;; in the file is not important. During loading, plain strings are ;; displayed in the echo area, prefixed with the current line number. ;; ;; Over the long run, the convenience functions provided (see source) ;; will be augmented by factoring maximally the -2mms files, squeezing ;; as much algorithm out of those nasty heuristics as possible. What ;; makes them nasty is not that they rely on the conventions of the ;; Emacs makefiles; that's no big deal. What makes them nasty is that ;; they rely on the conventions of separately maintained tools (namely ;; Autoconf for VMS and GNU Autoconf), and the separation of conventions ;; is how people drift apart, dragging their software behind ;; mercilessly. ;; ;; In general, codified thought w/o self-synchronization is doomed. ;; That a generation would eat its young (most discriminatingly, even) ;; is no reason GNU cannot build around such woe. ;;; Code: (defvar make-mms-derivative-data nil "Plist of data specific to `make-mms-derivative'.") (defun make-mms-derivative-data (key &optional newval) (if newval (setq make-mms-derivative-data (plist-put make-mms-derivative-data key newval)) (plist-get make-mms-derivative-data key))) (defun make-mms-derivative-gigo (name) "Insert the text associated with :gigo NAME." (insert (cdr (assq name (make-mms-derivative-data :gigo))))) (defun make-mms-derivative (filename) "Take FILENAME contents, load FILENAME-2mms, and write out the result. The output file is specified by the :output directive in FILENAME-2mms. See commentary of make-mms-derivative.el for full documentation." (interactive "fSource File: ") (let* ((todo (let ((fn (concat filename "-2mms"))) (unless (file-exists-p fn) (error "Could not find %s" fn)) (set-buffer (get-buffer-create " *make-mms-derivative todo*")) (insert-file-contents fn) (current-buffer))) (deriv (get-buffer-create (format "*mms-derivative: %s" (file-relative-name filename)))) output gigo form) (set-buffer todo) (re-search-forward "^:output") (setq output (expand-file-name (read (current-buffer)) (file-name-directory filename))) (goto-char (point-min)) (while (re-search-forward "^:gigo" (point-max) t) (let ((name (read (current-buffer))) (p (progn (forward-line 1) (point)))) (while (looking-at ";;") (delete-char 2) (forward-line 1)) (setq gigo (cons (cons name (buffer-substring p (point))) gigo)) (delete-region p (point)))) (message "Munging...") (switch-to-buffer deriv) (erase-buffer) (insert-file-contents filename) (set (make-local-variable 'make-mms-derivative-data) (list :gigo gigo)) (set-buffer todo) (goto-char (point-min)) (while (condition-case nil (setq form (read (current-buffer))) (end-of-file nil)) (if (stringp form) (message "%d: %s" (count-lines (point-min) (point)) form) (save-excursion (set-buffer deriv) (eval form)))) (set-buffer deriv) (message "Munging...done") (write-file output) (kill-buffer todo) (kill-buffer deriv))) (provide 'make-mms-derivative) ;; arch-tag: a5b08625-3952-4053-be16-296220e27bb0 ;;; make-mms-derivative.el ends here