Обработка ошибок внешних библиотек

Возможно, что вам приходилось когда-нибудь писать код создания окна на чистом WinApi. Наверно, он выглядел примерно так:


function CreateWindow(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer) : Boolean;
  // ...
begin
  // ...
  if (RegisterClass(wndClass) = 0) then  // Attemp to register the window class
  begin
    MessageBox(0, 'Failed to register the window class!', 'Error', MB_OK or MB_ICONERROR);
    Exit
  end;

  // ...
  h_Wnd := CreateWindowEx(dwExStyle,      // Extended window styles
                          'OpenGL',       // Class name
                          WND_TITLE,      // Window title (caption)
                          dwStyle,        // Window styles
                          0, 0,           // Window position
                          Width, Height,  // Size of window
                          0,              // No parent window
                          0,              // No menu
                          h_Instance,     // Instance
                          nil);           // Pass nothing to WM_CREATE
  if h_Wnd = 0 then
  begin
    MessageBox(0, 'Unable to create window!', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

  // Try to get a device context
  h_DC := GetDC(h_Wnd);
  if (h_DC = 0) then
  begin
    MessageBox(0, 'Unable to get a device context!', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

  // ...

  PixelFormat := ChoosePixelFormat(h_DC, @pfd);
  if (PixelFormat = 0) then
  begin
    MessageBox(0, 'Unable to find a suitable pixel format', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

  if (not SetPixelFormat(h_DC, PixelFormat, @pfd)) then
  begin
    MessageBox(0, 'Unable to set the pixel format', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

  // Create a OpenGL rendering context
  h_RC := wglCreateContext(h_DC);
  if (h_RC = 0) then
  begin
    MessageBox(0, 'Unable to create an OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

  if not wglMakeCurrent(h_DC, h_RC) then
  begin
    MessageBox(0, 'Unable to activate OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

  // ...
  Result := True;
end;

Можно заметить, что тут очень много копипастится код

MessageBox(0, 'Unable to «что не получилось»!', 'Error', MB_OK or MB_ICONERROR);
Exit;

Кроме копипаста этих двух строк, есть и второй копипаст: вместо «что не получилось» нужно везде прописывать название функции, в которой это не получилось. Как это можно бы было улучшить? Вынести в отдельную функцию нельзя, потому что Exit не умеет прыгать сразу на две функции вверх, а чтобы message box отобразил строку, нужно эту строку вбить вручную (не важно где, главное что эта строка должна быть вбита своими руками).

Конечно, в языке есть исключения, но WinApi не бросает никаких исключений специально для Free Pascal в случае штатных ошибок.

Как же быть? А никак — только копипаст. Те же беды с контролем ошибок в WinSock, DirectX и далее по списку.

Как такое обойти на лиспе? Понятно, что в данном случае нужно писать макрос, который принимает последовательность команд и генерирует из них код, который последовательно их выполняет, проверяя возвращаемые значения, и в случае нулевого результата, выдаёт мессадж-бокс с последующим возвращением NIL.


(defmacro block-check-winapi (&body body)
  `(block NIL
      ,@(loop for f in body collect 
            `(if (eql ,f 0) 
                 (progn 
                     (MessageBox 0 
                                 (format NIL "Unable to ~a" ',f)
                                 "Error" 
                                 (or MB_OK MB_ICONERROR)) 
                     (return NIL))))
      T))

Как всегда, для наглядности привожу пример того, во что эта конструкция разворачивается:


(block-check-winapi 
  (RegisterClass wndClass) 
  (CreateWindowEx dwExStyle 
                  "OpenGL" 
                  WND_TITLE 
                  dwStyle 
                  0 0 
                  Width 
                  Height 
                  0 
                  0 
                  h_Instance 
                  NIL))

(BLOCK NIL
  (IF (EQL (REGISTERCLASS WNDCLASS) 0)
      (PROGN
       (MESSAGEBOX 0 (FORMAT NIL "Unable to ~a" '(REGISTERCLASS WNDCLASS))
        "Error" (OR MB_OK MB_ICONERROR))
       (RETURN NIL)))
  (IF (EQL
       (CREATEWINDOWEX DWEXSTYLE "OpenGL" WND_TITLE DWSTYLE 0 0 WIDTH HEIGHT 0
        0 H_INSTANCE NIL)
       0)
      (PROGN
       (MESSAGEBOX 0
        (FORMAT NIL "Unable to ~a"
                '(CREATEWINDOWEX DWEXSTYLE "OpenGL" WND_TITLE DWSTYLE 0 0 WIDTH
                  HEIGHT 0 0 H_INSTANCE NIL))
        "Error" (OR MB_OK MB_ICONERROR))
       (RETURN NIL)))
  T)