view lisp/cus-theme.el @ 82988:f82e3a6f5ccb

A few more bugfixes and new features. (Sigh.) I obviously need to remember to separate individual changes to multiple commits. src/emacsclient.c: Improved error handling. (decode_options): Changed frame option (again) from -f to -t. (print_help_and_exit): Ditto. (copy_from_to): Check EINTR after write, not EAGAIN. Removed SIGIO hack. (pty_conversation): Handle errors transmitted through the socket. Handle pty errors by not reading from it anymore. (main): Restore correct errno after socket_status failed. Send -tty on -t, not -pty. lisp/server.el (server-process-filter): Watch -tty, not -pty. Use make-frame-on-tty instead of make-terminal-frame. Don't set newframe to t if make-frame-on-tty failed. Don't delete frames here. Print correct message when there are no files to edit, but a new frame was requested. (server-sentinel): Delete the frame after the process. (server-handle-delete-frame): New function for delete-frame-functions. (server-start): Add server-handle-delete-frame to delete-frame-functions. (server-buffer-done): Don't delete frames here. src/alloc.c (mark_ttys): Add prototype. (Fgarbage_collect): Call mark_ttys. src/emacs.c: (shut_down_emacs): Don't flush stdout before reset_sys_modes(). src/process.c (add_keyboard_wait_descriptor_called_flag): Removed. (add_keyboard_wait_descriptor): Removed stdin hack. src/sysdep.c: Unconditionally include sysselect.h. (old_fcntl_flags): Changed to an array. (init_sigio, reset_sigio): Use it. (narrow_foreground_group, widen_foreground_group): Use setpgid, not setpgrp. (old_fcntl_owner): Changed to an array. (init_sys_modes, reset_sys_modes): Use it. Fix fsync() and reset_sigio() calls. src/term.c (Qframe_tty_name, Qframe_tty_type): New variables. (syms_of_term): Initialize them. (Fframe_tty_name, Fframe_tty_type): New functions. (term_init): Call add_keyboard_wait_descriptor(). (Fdelete_tty): New function. (delete_tty): Call delete_keyboard_wait_descriptor(). (get_current_tty): Removed. (mark_ttys): New function. git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-28

;;; cus-theme.el -- custom theme creation user interface
;;
;; Copyright (C) 2001 Free Software Foundation, Inc.
;;
;; Author: Alex Schroeder <[e-mail]>
;; Maintainer: FSF
;; Keywords: help, faces

;; 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.

;;; Code:

(require 'widget)
(require 'cus-edit)

(eval-when-compile
  (require 'wid-edit))

;;;###autoload
(defun customize-create-theme ()
  "Create a custom theme."
  (interactive)
  (if (get-buffer "*New Custom Theme*")
      (kill-buffer "*New Custom Theme*"))
  (switch-to-buffer "*New Custom Theme*")
  (kill-all-local-variables)
  (make-local-variable 'custom-theme-name)
  (make-local-variable 'custom-theme-variables)
  (make-local-variable 'custom-theme-faces)
  (make-local-variable 'custom-theme-description)
  (let ((inhibit-read-only t))
    (erase-buffer))
  (widget-insert "This buffer helps you write a custom theme elisp file.
This will help you share your customizations with other people.\n\n")
  (widget-insert "Theme name: ")
  (setq custom-theme-name
	(widget-create 'editable-field
		       :size 10
		       user-login-name))
  (widget-insert "\n\nDocumentation:\n")
  (setq custom-theme-description
	(widget-create 'text
		       :value (format-time-string "Created %Y-%m-%d.")))
  (widget-insert "\nVariables:\n\n")
  (setq custom-theme-variables
     	(widget-create 'editable-list
     		       :entry-format "%i %d %v"
		       'variable))
  (widget-insert "\nFaces:\n\n")
  (setq custom-theme-faces
     	(widget-create 'editable-list
     		       :entry-format "%i %d %v"
		       'face))
  (widget-insert "\n")
  (widget-create 'push-button
     		 :notify (function custom-theme-write)
     		 "Done")
  (widget-insert " ")
  (widget-create 'push-button
     		 :notify (lambda (&rest ignore)
     			   (customize-create-theme))
     		 "Reset")
  (widget-insert " ")
  (widget-create 'push-button
     		 :notify (lambda (&rest ignore)
     			   (bury-buffer))
     		 "Bury Buffer")
  (widget-insert "\n")
  (use-local-map widget-keymap)
  (widget-setup))

(defun custom-theme-write (&rest ignore)
  (let ((name (widget-value custom-theme-name))
	(doc (widget-value custom-theme-description))
	(variables (widget-value custom-theme-variables))
	(faces (widget-value custom-theme-faces)))
    (switch-to-buffer (concat name "-theme.el"))
    (setq buffer-file-name (expand-file-name (concat name "-theme.el")))
    (let ((inhibit-read-only t))
      (erase-buffer))
    (insert "(deftheme " name)
    (when doc
      (newline)
      (insert "  \"" doc "\""))
    (insert  ")\n")
    (custom-theme-write-variables name variables)
    (custom-theme-write-faces name faces)
    (insert "\n(provide-theme '" name ")\n")))

(defun custom-theme-write-variables (theme vars)
  "Write a `custom-theme-set-variables' command for THEME.
It includes all variables in list VARS."
  ;; Most code is stolen from `custom-save-variables'.
  (when vars
    (let ((standard-output (current-buffer)))
      (princ "\n(custom-theme-set-variables\n")
      (princ " '")
      (princ theme)
      (princ "\n")
      (mapc (lambda (symbol)
	      (when (boundp symbol)
		(unless (bolp)
		  (princ "\n"))
		(princ " '(")
		(prin1 symbol)
		(princ " ")
		(prin1 (symbol-value symbol))
		(princ ")")))
	      vars)
      (if (bolp)
	  (princ " "))
      (princ ")")
      (unless (looking-at "\n")
	(princ "\n")))))

(defun custom-theme-write-faces (theme faces)
  "Write a `custom-theme-set-faces' command for THEME.
It includes all faces in list FACES."
  (when faces
    (let ((standard-output (current-buffer)))
      (princ "\n(custom-theme-set-faces\n")
      (princ " '")
      (princ theme)
      (princ "\n")
      (mapc (lambda (symbol)
	      (when (facep symbol)
		(unless (bolp)
		  (princ "\n"))
		(princ " '(")
		(prin1 symbol)
		(princ " ")
		(prin1 (or (get symbol 'customized-face)
			   (get symbol 'face-defface-spec)))
		(princ ")")))
	      faces)
      (if (bolp)
	  (princ " "))
      (princ ")")
      (unless (looking-at "\n")
	(princ "\n")))))

;;; arch-tag: cd6919bc-63af-410e-bae2-b6702e762344
;;; cus-theme.el ends here