emacs/code/elpa/auctex-13.1.3/style/letter.el

;;; letter.el - Special code for letter style.  -*- lexical-binding: t; -*-

;; Copyright (C) 1993, 2012, 2013, 2014, 2018, 2020 Free Software Foundation, Inc.

;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: auctex-devel@gnu.org
;; Keywords: tex

;; This file is part of AUCTeX.

;; AUCTeX 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, or (at your option)
;; any later version.

;; AUCTeX 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 AUCTeX; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301, USA.

;;; Code:

(require 'tex)
(require 'latex)

;; Silence the compiler:
(declare-function font-latex-add-keywords
                  "font-latex"
                  (keywords class))

(defvar LaTeX-letter-class-options
  '("a4paper" "a5paper" "b5paper" "letterpaper" "legalpaper" "executivepaper"
    "landscape" "10pt" "11pt" "12pt" "oneside" "twoside" "draft" "final"
    "leqno" "fleqn")
  "Package options for the letter class.")

;; You may want to define this in tex-site.el to contain your
;; organizations address.
(defvar LaTeX-letter-sender-address ""
  "Initial value when prompting for a sender address in the letter style.")

(TeX-add-style-hook
 "letter"
 (lambda ()
   (LaTeX-add-environments
    '("letter" LaTeX-env-recipient))
   (LaTeX-add-pagestyles "headings" "firstpage")
   (setq LaTeX-default-document-environment "letter")
   (TeX-add-symbols
    '("name" "Sender")
    '("address" "Sender address")
    '("signature" "Signature")
    '("opening" "Opening")
    '("closing" "Closing")
    "location"
    "telephone"
    "makelabels"
    "stopbreaks"
    "startbreaks"
    "cc"
    "encl"
    "ps"
    "stopletter"
    "returnaddress"
    "startlabels"
    "mlabel"
    "descriptionlabel"
    "ccname"
    "enclname"
    "pagename"
    "headtoname")

   ;; Fontification
   (when (and (featurep 'font-latex)
              (eq TeX-install-font-lock 'font-latex-setup))
     (font-latex-add-keywords '(("name" "{")
                                ("address" "{")
                                ("signature" "{")
                                ("opening" "{")
                                ("closing" "{")
                                ("location" "{")
                                ("telephone" "{")
                                ("cc" "{")
                                ("encl" "{")
                                ("ps" "{"))
                              'function)))
 TeX-dialect)

(defun LaTeX-env-recipient (environment)
  "Insert ENVIRONMENT and prompt for recipient and address."
  (let ((sender (TeX-read-string "Sender: " (user-full-name)))
        (sender-address (TeX-read-string "Sender address: "
                                         LaTeX-letter-sender-address))
        (recipient (TeX-read-string "Recipient: "))
        (address (TeX-read-string "Recipient address: "))
        (signature (TeX-read-string "Signature: "))
        (opening (TeX-read-string "Opening: "))
        (closing (TeX-read-string "Closing: "))
        (date (TeX-read-string "Date: " (LaTeX-today)))
        ;; COMPATIBILITY for EMACS<26
        (func (if (fboundp 'indent-relative-first-indent-point)
                  #'indent-relative-first-indent-point
                ;; Stay away from using #' to avoid compiler warning.
                'indent-relative-maybe)))

    (insert TeX-esc "name" TeX-grop sender TeX-grcl)
    (newline-and-indent)
    (if (not (zerop (length sender-address)))
        (progn
          (setq LaTeX-letter-sender-address sender-address)
          (insert TeX-esc "address" TeX-grop sender-address TeX-grcl)
          (newline-and-indent)))
    (if (not (zerop (length signature)))
        (progn
          (insert TeX-esc "signature" TeX-grop signature TeX-grcl)
          (newline-and-indent)))
    (if (not (zerop (length date)))
        (progn
          (insert TeX-esc "renewcommand" TeX-grop TeX-esc "today" TeX-grcl
                  TeX-grop date TeX-grcl)
          (newline-and-indent)))
    (newline-and-indent)

    (let ((indentation (current-column)))
      (LaTeX-insert-environment
       environment
       (concat TeX-grop recipient
               (if (not (zerop (length address)))
                   (concat
                    (if (not (zerop (length recipient)))
                        (concat " " TeX-esc TeX-esc " "))
                    address))
               TeX-grcl))
      (save-excursion                   ; Fix indentation of address
        (if (search-backward TeX-grcl nil 'move)
            (let ((addr-end (point-marker)))
              (if (search-backward TeX-grop nil 'move)
                  (let ((addr-column (current-column)))
                    (while (search-forward
                            (concat TeX-esc TeX-esc)
                            (marker-position addr-end) 'move)
                      (progn
                        (newline)
                        (indent-to addr-column)))))
              (set-marker addr-end nil))))
      (insert "\n")
      (indent-to indentation))
    (insert TeX-esc "opening"
            TeX-grop
            (if (zerop (length opening))
                (concat TeX-esc " ")
              opening)
            TeX-grcl "\n")

    (funcall func)
    (save-excursion
      (insert "\n" TeX-esc "closing"
              TeX-grop
              (if (zerop (length closing))
                  (concat TeX-esc " ")
                closing)
              TeX-grcl "\n")
      (funcall func))))

(defun LaTeX-today nil
  "Return a string representing todays date according to flavor."
  (interactive)
  (let ((ctime-string (current-time-string))
        (month-alist '(("Jan". "01")
                       ("Feb" . "02")
                       ("Mar" . "03")
                       ("Apr" . "04")
                       ("May" . "05")
                       ("Jun" . "06")
                       ("Jul" . "07")
                       ("Aug" . "08")
                       ("Sep" . "09")
                       ("Oct" . "10")
                       ("Nov" . "11")
                       ("Dec" . "12"))))
    (string-match
     "^\\S-+\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-+\\S-+\\s-+\\(\\S-+\\)"
     ctime-string)
    (let ((year (substring ctime-string (match-beginning 3) (match-end 3)))
          (month (substring ctime-string (match-beginning 1) (match-end 1)))
          (day (substring ctime-string (match-beginning 2) (match-end 2))))
      (if (assoc month month-alist)
          (progn
            (setq month (cdr (assoc month month-alist)))
            (if (> 2 (length day))
                (setq day (concat "0" day)))))
      (format "%s-%s-%s" year month day))))

;;; letter.el ends here